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