scripts/mailbot

   1 #!/usr/bin/perl
   2 # Mail robot for processing of PCI ID submissions
   3 # (c) 2001--2002 Martin Mares <mj@ucw.cz>
   4 # 2008 Michal Vaner <vorner@ucw.cz>
   5
   6 use Mail::Header;
   7 use Getopt::Long;
   8 use IO::Handle;
   9 BEGIN {
  10         unshift @INC, ".";
  11 }
  12 use PciIds::Db;
  13 use PciIds::Log;
  14 use PciIds::Notifications;
  15 use PciIds::DBQ;
  16
  17 my $patch = 0;
  18 my $emulate = 0;
  19 my $debug = 0;
  20 my $original = "";
  21 my $author = "";
  22 GetOptions(
  23         'patch!' => \$patch,
  24         'emulate!' => \$emulate,
  25         'debug!' => \$debug,
  26         'orig=s' => \$original,
  27         'author=s' => \$author
  28 ) || die "Usage: mailbot [--patch] [--emulate] [--debug] [--orig <name>] [--author <mailaddr>]";
  29
  30 my $reply = "";
  31 my $reply_plain = "";
  32 my $msgid = "";
  33 my $subject = "";
  34 my $tables = PciIds::DBQ::new( connectDb() );
  35
  36 my $hasAuth = $tables->dbh()->prepare( 'SELECT id FROM users WHERE email = ?' );
  37 my $addAuth = $tables->dbh()->prepare( "INSERT INTO users (email, passwd) VALUES(?, '')" );
  38 my $hasItem = $tables->dbh()->prepare( "SELECT 1 FROM locations WHERE id = ?" );
  39 my $addItem = $tables->dbh()->prepare( "INSERT INTO locations (id, parent) VALUES (?, ?)" );
  40 my $addComment = $tables->dbh()->prepare( "INSERT INTO history (owner, location, discussion, nodename, nodenote) VALUES (?, ?, ?, ?, ?)" );
  41
  42 sub getAuthor( $ ) {
  43         my( $mail ) = @_;
  44         $hasAuth->execute( $mail );
  45         if( my( $id ) = $hasAuth->fetchrow_array ) {
  46                 return $id;
  47         } else {
  48                 tlog( "mailbot: Creating user $mail" );
  49                 $addAuth->execute( $mail );
  50                 my $nid = $tables->dbh->last_insert_id( undef, undef, undef, undef );
  51                 tlog( "mailbot: User ($mail) id: $nid" );
  52                 return $nid;
  53         }
  54 }
  55
  56 sub submitItem( $$$$$ ) {
  57         my( $id, $name, $description, $text, $author ) = @_;
  58         my $created;
  59         $id =~ s/(.{8})(.+)/$1\/$2/;
  60         $id =~ s/(.{4})(.+)/$1\/$2/;
  61         $id = "PC/$id";
  62         if( length $id > 12 ) {
  63                 my( $vendor ) = ( $id =~ /^PC\/....\/....\/(....)/ );
  64                 $vendor = "PC/$vendor";
  65                 $hasItem->execute( $vendor );
  66                 error( "Missing subsystem vendor" ) unless( $hasItem->fetchrow_array );
  67         }
  68         $hasItem->execute( $id );
  69         unless( $hasItem->fetchrow_array ) {
  70                 tlog( "mailbot: Item created (empty) $id" );
  71                 my $parent = $id;
  72                 $parent =~ s/\/[^\/]*$//;
  73                 $addItem->execute( $id, $parent );
  74                 $created = 1;
  75         }
  76         $addComment->execute( $author, $id, $text, $name, $description );
  77         my $hid = $tables->last();
  78         tlog( "mailbot: History created $hid $id ".logEscape( $name )." ".logEscape( $description )." ".logEscape( $text ) );
  79         notify( $tables, $id, $hid, $created ? 2 : 1, $created ? 0 : 1 );
  80 }
  81
  82 if (!$patch) {
  83         $hdr = new Mail::Header;
  84         $hdr->modify(1);
  85         $hdr->mail_from(COERCE);
  86         $hdr->read(*STDIN{IO});
  87         $hdr->unfold();
  88         $mfrom = $hdr->get('Mail-From');
  89         chomp $mfrom;
  90         ($mfrom =~ /^MAILER-DAEMON@/i) && blackhole("From mailer daemon");
  91         $mfrom =~ s/  .*// or blackhole("Malformed envelope sender");
  92         ($reply = $hdr->get('Reply-To')) || ($reply = $hdr->get('From')) ||
  93                 blackhole("Don't know who should I reply to");
  94         chomp $reply;
  95         if ($reply =~ /<(\S*)>/) {
  96                 $reply_plain = $1;
  97         } elsif ($reply =~ /^\S+$/) {
  98                 $reply_plain = $reply;
  99         } else {
 100                 $reply_plain = $mfrom;
 101         }
 102         $reply_plain =~ tr/\n'"\\//d;
 103         $msgid = $hdr->get('Message-Id');
 104         chomp $msgid;
 105         my $subj = $hdr->get('Subject');
 106         chomp $subj;
 107         if ($subj =~ /^IDS: (.*)/) {
 108                 $subject = $1;
 109         }
 110         $author = $reply_plain;
 111 }
 112
 113 $tprefix = "tmp/mbot-$$";
 114 $home = "~/";
 115 mkdir("tmp", 0777);
 116 mkdir($tprefix, 0777) || error("Cannot create tmpdir");
 117 chdir($tprefix) || error("Cannot chdir to tmpdir");
 118
 119 open(TEMP, ">patch") || error("Cannot create tmpfile");
 120 if ($debug || $reply eq "") {
 121         open(LOG, ">&STDOUT") || error ("Cannot create outfile");
 122 } else {
 123         open(LOG, ">log") || error ("Cannot create outfile");
 124         LOG->autoflush(1);
 125 }
 126 if ($reply) {
 127         print LOG "Got mail from $reply, will reply to $reply_plain.\n";
 128         print LOG "Scanning mail for patch.\n";
 129 } else {
 130         print LOG "Scanning STDIN for patch.\n";
 131 }
 132 while (<STDIN>) {
 133         while (/^--- /) {
 134                 $l0 = $_;
 135                 $_ = <STDIN>;
 136                 if (/^\+\+\+ /) {
 137                         print TEMP $l0;
 138                         print TEMP $_;
 139                         while (1) {
 140                                 $_ = <STDIN>;
 141                                 chomp;
 142                                 if (/^\s*$/ || !/^[ +\@-]/) {
 143                                         close TEMP;
 144                                         process();
 145                                         exit 0;
 146                                 }
 147                                 print TEMP "$_\n";
 148                                 /^@@ -\d+,(\d+) \+\d+,(\d+) @@/ || error("Malformed patch");
 149                                 $old = $1;
 150                                 $new = $2;
 151                                 while ($old || $new) {
 152                                         $_ = <STDIN>;
 153                                         print TEMP $_;
 154                                         if (/^ /) { $old--; $new--; }
 155                                         elsif (/^-/) { $old--; }
 156                                         elsif (/^\+/) { $new--; }
 157                                         else { error("Malformed patch"); }
 158                                         if ($old<0 || $new<0) { error("Malformed patch"); }
 159                                 }
 160                         }
 161                 }
 162         }
 163 }
 164 error("No patch found");
 165
 166 sub cleanup
 167 {
 168         chdir($home);
 169         `rm -rf $tprefix` unless $debug;
 170         exit 0;
 171 }
 172
 173 sub blackhole
 174 {
 175         my $reason = shift @_;
 176         print STDERR "Blackholed: $reason\n";
 177         cleanup();
 178 }
 179
 180 sub error
 181 {
 182         my $reason = shift @_;
 183         print LOG "$reason\n";
 184         mail_reply($reason);
 185         cleanup();
 186 }
 187
 188 sub process
 189 {
 190         print LOG "Patch found.\n";
 191         print LOG "Searching for original pci.ids version.\n";
 192         foreach $orig (($original eq "") ? glob("$home/origs/*") : ("../../$original")) {
 193                 print LOG "Trying $orig\n";
 194                 unlink "pci.ids";
 195                 unlink "pci.rej";
 196                 print LOG `/usr/bin/patch <patch --no-backup -o pci.ids -r pci.rej $orig`;
 197                 if ($?) {
 198                         print LOG "Failed.\n";
 199                 } else {
 200                         print LOG "Patch succeeded.\n";
 201                         print LOG "Parsing patched file.\n";
 202                         print LOG `$home/bin/ids_to_dbdump <$orig 2>&1 >orig.db.unsorted`;
 203                         $? && error("Error parsing original ID database");
 204                         print LOG `sort +1 <orig.db.unsorted >orig.db`;
 205                         $? && error("Error sorting original ID database");
 206                         print LOG `$home/bin/ids_to_dbdump <pci.ids 2>&1 >new.db.unsorted`;
 207                         $? && error("Error parsing the patched pci.ids file");
 208                         print LOG `sort +1 <new.db.unsorted >new.db`;
 209                         $? && error("Error sorting the patched pci.ids file");
 210                         print LOG "Finding ID differences.\n";
 211                         `diff -U0 new.db orig.db >diffs`;
 212                         if ($? > 256) { error("Diff failed. Why?"); }
 213                         elsif (!$?) { error("No ID changes encountered."); }
 214                         open(DIFF, "diffs") || error("Cannot open the diff");
 215                         $subject = undef if $subject eq '';
 216                         my $authorId = getAuthor( $author );
 217                         my $live = (!$emulate && !$debug);
 218                         while (<DIFF>) {
 219                                 chomp;
 220                                 /^(\+\+\+|---)/ && next;
 221                                 /^[+-]/ || next;
 222                                 ($tt,$id,$name,$stat,$cmt) = split /\t/;
 223                                 if ($tt =~ /^\+(.*)/) {
 224                                         defined $seen{$id} && next;
 225                                         $name = $cmt = "";
 226                                 } elsif ($tt =~ /^-(.*)/) {
 227                                         $seen{$id} = 1;
 228                                 } else { error("Internal bug #23"); }
 229                                 print LOG "$id\t$name\t$cmt\n";
 230                                 submitItem( $id, $name, $cmt, $subject, $authorId ) if $live;
 231                         }
 232                         $tables->dbh->commit();
 233                         close DIFF;
 234                         $time = localtime;
 235                         `echo >>$home/mailbot.log "## $time $reply"`;
 236                         `cat result >>$home/mailbot.log`;
 237                         print LOG "Done.\n";
 238                         mail_reply("OK");
 239                         cleanup();
 240                 }
 241         }
 242         error("Unable to find any version of pci.ids the patch applies to.");
 243 }
 244
 245 sub mail_reply
 246 {
 247         my $reason = shift @_;
 248         my $sendmail_opts = "-fvorner+iderr\@ucw.cz '$reply_plain' vorner+idecho\@ucw.cz";
 249         if ($debug || $reply eq "") {
 250                 print "$reason\n";
 251                 return;
 252         } elsif ($emulate) {
 253                 open(MAIL, ">&STDOUT") || die;
 254                 print MAIL "SENDMAIL $sendmail_opts\n";
 255         } elsif (!open MAIL, "|/usr/sbin/sendmail $sendmail_opts") {
 256                 print STDERR "Unable to ask mailer for replying!!!\n";
 257                 print LOG "Unable to ask mailer for replying!!!\n";
 258                 exit 1;
 259         }
 260         print MAIL "From: The PCI ID Robot <vorner+iderr\@ucw.cz>\n";
 261         print MAIL "To: $reply\n";
 262         print MAIL "Subject: IDbot: $reason\n";
 263         print MAIL "In-Reply-To: $msgid\n" if $msgid ne "";
 264         print MAIL "\n";
 265         print MAIL <<EOF
 266 This is an automatic reply from the PCI ID Mail Robot. If you want to contact
 267 the administrator of the robot, please write to pciids-devel\@lists.sourceforge.net.
 268
 269 EOF
 270 ;
 271         if ($reason eq "OK") {
 272                 print MAIL "Your submission has been accepted.\n\n";
 273         } else {
 274                 print MAIL <<EOF
 275 Your submission has been rejected. Please make sure that the mail you've sent
 276 is a unified diff (output of diff -u) against the latest pci.ids file, that
 277 the diff is not reversed and that your mailer doesn't damage long lines
 278 and doesn't change tabs to spaces or vice versa. Also, we don't accept MIME
 279 attachments in base64 encoding yet. If you are unable to fix your problems,
 280 just use the Web interface at http://pciids.sf.net/ or submit the patch
 281 to pciids-devel\@lists.sourceforge.net where it will be processed manually.
 282 See the log below for additional information.
 283
 284 EOF
 285 ;
 286         }
 287         print MAIL "--- Processing Log ---\n\n";
 288         if (open L, "<log") {
 289                 while (<L>) { print MAIL "$_"; }
 290                 close L;
 291         }
 292         print MAIL "\n--- End ---\n";
 293         close MAIL;
 294 }
 295
 296 sub url_encode
 297 {
 298         $_ = shift @_;
 299         s/([^a-zA-Z0-9.!*,_-])/'%'.unpack('H2',$1)/ge;
 300         s/%20/+/g;
 301         $_;
 302 }