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 my $scripts = "$home/ids/perl/scripts";
 103 $tprefix = "${home}tmp/mbot-$$";
 104 # Little hack to stop spam: ignore everything from people not already in database
 105 $hasAuth->execute( $author );
 106 my( $authorId ) = ( $hasAuth->fetchrow_array );
 107 if( defined $authorId ) {
 108         tlog( "mailbot: Active user ($author) id: $authorId" );
 109 } else {
 110         blackhole("Dropping email from $author, not in database.\n");
 111 }
 112
 113 mkdir("${home}tmp", 0777);
 114 mkdir($tprefix, 0777) || error("Cannot create tmpdir");
 115 chdir($tprefix) || error("Cannot chdir to tmpdir");
 116
 117 open(TEMP, ">patch") || error("Cannot create tmpfile");
 118 if ($debug || $reply eq "") {
 119         open(LOG, ">&STDOUT") || error ("Cannot create outfile");
 120 } else {
 121         open(LOG, ">log") || error ("Cannot create outfile");
 122         LOG->autoflush(1);
 123 }
 124 if ($reply) {
 125         print LOG "Got mail from $reply, will reply to $reply_plain.\n";
 126         print LOG "Scanning mail for patch.\n";
 127 } else {
 128         print LOG "Scanning STDIN for patch.\n";
 129 }
 130 while (<STDIN>) {
 131         while (/^--- /) {
 132                 $l0 = $_;
 133                 $_ = <STDIN>;
 134                 if (/^\+\+\+ /) {
 135                         print TEMP $l0;
 136                         print TEMP $_;
 137                         while (1) {
 138                                 $_ = <STDIN>;
 139                                 chomp;
 140                                 if (/^\s*$/ || !/^[ +\@-]/) {
 141                                         close TEMP;
 142                                         process();
 143                                         exit 0;
 144                                 }
 145                                 print TEMP "$_\n";
 146                                 /^@@ -\d+,(\d+) \+\d+,(\d+) @@/ || error("Malformed patch");
 147                                 $old = $1;
 148                                 $new = $2;
 149                                 while ($old || $new) {
 150                                         $_ = <STDIN>;
 151                                         print TEMP $_;
 152                                         if (/^ /) { $old--; $new--; }
 153                                         elsif (/^-/) { $old--; }
 154                                         elsif (/^\+/) { $new--; }
 155                                         else { error("Malformed patch"); }
 156                                         if ($old<0 || $new<0) { error("Malformed patch"); }
 157                                 }
 158                         }
 159                 }
 160         }
 161 }
 162 error("No patch found");
 163
 164 sub cleanup
 165 {
 166         chdir($home);
 167         `rm -rf $tprefix` unless $debug;
 168         exit 0;
 169 }
 170
 171 sub blackhole
 172 {
 173         my $reason = shift @_;
 174         print STDERR "Blackholed: $reason\n";
 175         cleanup();
 176 }
 177
 178 sub error
 179 {
 180         my $reason = shift @_;
 181         print LOG "$reason\n";
 182         mail_reply($reason);
 183         cleanup();
 184 }
 185
 186 sub process
 187 {
 188         print LOG "Patch found.\n";
 189         print LOG "Searching for original pci.ids version.\n";
 190         foreach $orig (($original eq "") ? glob("$home/origs/*") : ("../../$original")) {
 191                 print LOG "Trying $orig\n";
 192                 unlink "pci.ids";
 193                 unlink "pci.rej";
 194                 print LOG `/usr/bin/patch <patch --no-backup -o pci.ids -r pci.rej $orig`;
 195                 if ($?) {
 196                         print LOG "Failed.\n";
 197                 } else {
 198                         print LOG "Patch succeeded.\n";
 199                         print LOG "Parsing patched file.\n";
 200                         print LOG `$scripts/ids_to_dbdump <$orig 2>&1 >orig.db.unsorted`;
 201                         $? && error("Error parsing original ID database");
 202                         print LOG `sort -k1 <orig.db.unsorted >orig.db`;
 203                         $? && error("Error sorting original ID database");
 204                         print LOG `$scripts/ids_to_dbdump <pci.ids 2>&1 >new.db.unsorted`;
 205                         $? && error("Error parsing the patched pci.ids file");
 206                         print LOG `sort -k1 <new.db.unsorted >new.db`;
 207                         $? && error("Error sorting the patched pci.ids file");
 208                         print LOG "Finding ID differences.\n";
 209                         `diff -U0 -b new.db orig.db >diffs`;
 210                         if ($? > 256) { error("Diff failed. Why?"); }
 211                         elsif (!$?) { error("No ID changes encountered."); }
 212                         open(DIFF, "diffs") || error("Cannot open the diff");
 213                         $subject = undef if $subject eq '';
 214                         my $live = (!$emulate && !$debug);
 215                         while (<DIFF>) {
 216                                 chomp;
 217                                 /^(\+\+\+|---)/ && next;
 218                                 /^[+-]/ || next;
 219                                 ($tt,$id,$name,$stat,$cmt) = split /\t/;
 220                                 if ($tt =~ /^\+(.*)/) {
 221                                         defined $seen{$id} && next;
 222                                         $name = $cmt = "";
 223                                 } elsif ($tt =~ /^-(.*)/) {
 224                                         $seen{$id} = 1;
 225                                 } else { error("Internal bug #23"); }
 226                                 print LOG "$id\t$name\t$cmt\n";
 227                                 submitItem( $id, $name, $cmt, $subject, $authorId ) if $live;
 228                         }
 229                         $tables->dbh->commit();
 230                         close DIFF;
 231                         $time = localtime;
 232                         `echo >>$home/mailbot.log "## $time $reply"`;
 233                         `cat result >>$home/mailbot.log`;
 234                         print LOG "Done.\n";
 235                         mail_reply("OK");
 236                         cleanup();
 237                 }
 238         }
 239         error("Unable to find any version of pci.ids the patch applies to.");
 240 }
 241
 242 sub mail_reply
 243 {
 244         my $reason = shift @_;
 245         my $sendmail_opts = "-fvorner+iderr\@ucw.cz '$reply_plain' vorner+idecho\@ucw.cz";
 246         if ($debug || $reply eq "") {
 247                 print "$reason\n";
 248                 return;
 249         } elsif ($emulate) {
 250                 open(MAIL, ">&STDOUT") || die;
 251                 print MAIL "SENDMAIL $sendmail_opts\n";
 252         } elsif (!open MAIL, "|/usr/sbin/sendmail $sendmail_opts") {
 253                 print STDERR "Unable to ask mailer for replying!!!\n";
 254                 print LOG "Unable to ask mailer for replying!!!\n";
 255                 exit 1;
 256         }
 257         print MAIL "From: The PCI ID Robot <vorner+iderr\@ucw.cz>\n";
 258         print MAIL "To: $reply\n";
 259         print MAIL "Subject: IDbot: $reason\n";
 260         print MAIL "In-Reply-To: $msgid\n" if $msgid ne "";
 261         print MAIL "\n";
 262         print MAIL <<EOF
 263 This is an automatic reply from the PCI ID Mail Robot. If you want to contact
 264 the administrator of the robot, please write to pciids-devel\@lists.sourceforge.net.
 265
 266 EOF
 267 ;
 268         if ($reason eq "OK") {
 269                 print MAIL "Your submission has been accepted.\n\n";
 270         } else {
 271                 print MAIL <<EOF
 272 Your submission has been rejected. Please make sure that the mail you've sent
 273 is a unified diff (output of diff -u) against the latest pci.ids file, that
 274 the diff is not reversed and that your mailer doesn't damage long lines
 275 and doesn't change tabs to spaces or vice versa. Also, we don't accept MIME
 276 attachments in base64 encoding yet. If you are unable to fix your problems,
 277 just use the Web interface at http://pciids.sf.net/ or submit the patch
 278 to pciids-devel\@lists.sourceforge.net where it will be processed manually.
 279 See the log below for additional information.
 280
 281 EOF
 282 ;
 283         }
 284         print MAIL "--- Processing Log ---\n\n";
 285         if (open L, "<log") {
 286                 while (<L>) { print MAIL "$_"; }
 287                 close L;
 288         }
 289         print MAIL "\n--- End ---\n";
 290         close MAIL;
 291 }
 292
 293 sub url_encode
 294 {
 295         $_ = shift @_;
 296         s/([^a-zA-Z0-9.!*,_-])/'%'.unpack('H2',$1)/ge;
 297         s/%20/+/g;
 298         $_;
 299 }