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