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