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>
14 use PciIds::Notifications;
24 'emulate!' => \$emulate,
26 'orig=s' => \$original,
27 'author=s' => \$author
28 ) || die "Usage: mailbot [--patch] [--emulate] [--debug] [--orig <name>] [--author <mailaddr>]";
34 my $tables = PciIds::DBQ::new( connectDb() );
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 (?, ?, ?, ?, ?)" );
44 $hasAuth->execute( $mail );
45 if( my( $id ) = $hasAuth->fetchrow_array ) {
46 tlog( "mailbot: Active user ($mail) id: $id" );
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" );
57 sub submitItem( $$$$$ ) {
58 my( $id, $name, $description, $text, $author ) = @_;
60 $id =~ s/(.{8})(.+)/$1\/$2/;
61 $id =~ s/(.{4})(.+)/$1\/$2/;
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 );
69 $hasItem->execute( $id );
70 unless( $hasItem->fetchrow_array ) {
71 tlog( "mailbot: Item created (empty) $id" );
73 $parent =~ s/\/[^\/]*$//;
74 $addItem->execute( $id, $parent );
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' => 0, 'way' => 0 } );
87 $hdr = new Mail::Header;
89 $hdr->mail_from(COERCE);
90 $hdr->read(*STDIN{IO});
92 $mfrom = $hdr->get('Mail-From');
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");
99 if ($reply =~ /<(\S*)>/) {
101 } elsif ($reply =~ /^\S+$/) {
102 $reply_plain = $reply;
104 $reply_plain = $mfrom;
106 $reply_plain =~ tr/\n'"\\//d;
107 $msgid = $hdr->get('Message-Id');
109 my $subj = $hdr->get('Subject');
111 if ($subj =~ /^IDS: (.*)/) {
114 $author = $reply_plain;
117 $home = "$ENV{HOME}/";
118 $tprefix = "${home}tmp/mbot-$$";
119 mkdir("${home}tmp", 0777);
120 mkdir($tprefix, 0777) || error("Cannot create tmpdir");
121 chdir($tprefix) || error("Cannot chdir to tmpdir");
123 open(TEMP, ">patch") || error("Cannot create tmpfile");
124 if ($debug || $reply eq "") {
125 open(LOG, ">&STDOUT") || error ("Cannot create outfile");
127 open(LOG, ">log") || error ("Cannot create outfile");
131 print LOG "Got mail from $reply, will reply to $reply_plain.\n";
132 print LOG "Scanning mail for patch.\n";
134 print LOG "Scanning STDIN for patch.\n";
146 if (/^\s*$/ || !/^[ +\@-]/) {
152 /^@@ -\d+,(\d+) \+\d+,(\d+) @@/ || error("Malformed patch");
155 while ($old || $new) {
158 if (/^ /) { $old--; $new--; }
159 elsif (/^-/) { $old--; }
160 elsif (/^\+/) { $new--; }
161 else { error("Malformed patch"); }
162 if ($old<0 || $new<0) { error("Malformed patch"); }
168 error("No patch found");
173 `rm -rf $tprefix` unless $debug;
179 my $reason = shift @_;
180 print STDERR "Blackholed: $reason\n";
186 my $reason = shift @_;
187 print LOG "$reason\n";
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";
200 print LOG `/usr/bin/patch <patch --no-backup -o pci.ids -r pci.rej $orig`;
202 print LOG "Failed.\n";
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);
224 /^(\+\+\+|---)/ && next;
226 ($tt,$id,$name,$stat,$cmt) = split /\t/;
227 if ($tt =~ /^\+(.*)/) {
228 defined $seen{$id} && next;
230 } elsif ($tt =~ /^-(.*)/) {
232 } else { error("Internal bug #23"); }
233 print LOG "$id\t$name\t$cmt\n";
234 submitItem( $id, $name, $cmt, $subject, $authorId ) if $live;
236 $tables->dbh->commit();
239 `echo >>$home/mailbot.log "## $time $reply"`;
240 `cat result >>$home/mailbot.log`;
246 error("Unable to find any version of pci.ids the patch applies to.");
251 my $reason = shift @_;
252 my $sendmail_opts = "-fvorner+iderr\@ucw.cz '$reply_plain' vorner+idecho\@ucw.cz";
253 if ($debug || $reply eq "") {
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";
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 "";
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.
275 if ($reason eq "OK") {
276 print MAIL "Your submission has been accepted.\n\n";
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.
291 print MAIL "--- Processing Log ---\n\n";
292 if (open L, "<log") {
293 while (<L>) { print MAIL "$_"; }
296 print MAIL "\n--- End ---\n";
303 s/([^a-zA-Z0-9.!*,_-])/'%'.unpack('H2',$1)/ge;