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>
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: $nid" );
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 );
84 $hdr = new Mail::Header;
86 $hdr->mail_from(COERCE);
87 $hdr->read(*STDIN{IO});
89 $mfrom = $hdr->get('Mail-From');
91 ($mfrom =~ /^MAILER-DAEMON@/i) && blackhole("From mailer daemon");
92 $mfrom =~ s/ .*// or blackhole("Malformed envelope sender");
93 ($reply = $hdr->get('Reply-To')) || ($reply = $hdr->get('From')) ||
94 blackhole("Don't know who should I reply to");
96 if ($reply =~ /<(\S*)>/) {
98 } elsif ($reply =~ /^\S+$/) {
99 $reply_plain = $reply;
101 $reply_plain = $mfrom;
103 $reply_plain =~ tr/\n'"\\//d;
104 $msgid = $hdr->get('Message-Id');
106 my $subj = $hdr->get('Subject');
108 if ($subj =~ /^IDS: (.*)/) {
111 $author = $reply_plain;
114 $tprefix = "tmp/mbot-$$";
117 mkdir($tprefix, 0777) || error("Cannot create tmpdir");
118 chdir($tprefix) || error("Cannot chdir to tmpdir");
120 open(TEMP, ">patch") || error("Cannot create tmpfile");
121 if ($debug || $reply eq "") {
122 open(LOG, ">&STDOUT") || error ("Cannot create outfile");
124 open(LOG, ">log") || error ("Cannot create outfile");
128 print LOG "Got mail from $reply, will reply to $reply_plain.\n";
129 print LOG "Scanning mail for patch.\n";
131 print LOG "Scanning STDIN for patch.\n";
143 if (/^\s*$/ || !/^[ +\@-]/) {
149 /^@@ -\d+,(\d+) \+\d+,(\d+) @@/ || error("Malformed patch");
152 while ($old || $new) {
155 if (/^ /) { $old--; $new--; }
156 elsif (/^-/) { $old--; }
157 elsif (/^\+/) { $new--; }
158 else { error("Malformed patch"); }
159 if ($old<0 || $new<0) { error("Malformed patch"); }
165 error("No patch found");
170 `rm -rf $tprefix` unless $debug;
176 my $reason = shift @_;
177 print STDERR "Blackholed: $reason\n";
183 my $reason = shift @_;
184 print LOG "$reason\n";
191 print LOG "Patch found.\n";
192 print LOG "Searching for original pci.ids version.\n";
193 foreach $orig (($original eq "") ? glob("$home/origs/*") : ("../../$original")) {
194 print LOG "Trying $orig\n";
197 print LOG `/usr/bin/patch <patch --no-backup -o pci.ids -r pci.rej $orig`;
199 print LOG "Failed.\n";
201 print LOG "Patch succeeded.\n";
202 print LOG "Parsing patched file.\n";
203 print LOG `$home/bin/ids_to_dbdump <$orig 2>&1 >orig.db.unsorted`;
204 $? && error("Error parsing original ID database");
205 print LOG `sort +1 <orig.db.unsorted >orig.db`;
206 $? && error("Error sorting original ID database");
207 print LOG `$home/bin/ids_to_dbdump <pci.ids 2>&1 >new.db.unsorted`;
208 $? && error("Error parsing the patched pci.ids file");
209 print LOG `sort +1 <new.db.unsorted >new.db`;
210 $? && error("Error sorting the patched pci.ids file");
211 print LOG "Finding ID differences.\n";
212 `diff -U0 new.db orig.db >diffs`;
213 if ($? > 256) { error("Diff failed. Why?"); }
214 elsif (!$?) { error("No ID changes encountered."); }
215 open(DIFF, "diffs") || error("Cannot open the diff");
216 $subject = undef if $subject eq '';
217 my $authorId = getAuthor( $author );
218 my $live = (!$emulate && !$debug);
221 /^(\+\+\+|---)/ && next;
223 ($tt,$id,$name,$stat,$cmt) = split /\t/;
224 if ($tt =~ /^\+(.*)/) {
225 defined $seen{$id} && next;
227 } elsif ($tt =~ /^-(.*)/) {
229 } else { error("Internal bug #23"); }
230 print LOG "$id\t$name\t$cmt\n";
231 submitItem( $id, $name, $cmt, $subject, $authorId ) if $live;
233 $tables->dbh->commit();
236 `echo >>$home/mailbot.log "## $time $reply"`;
237 `cat result >>$home/mailbot.log`;
243 error("Unable to find any version of pci.ids the patch applies to.");
248 my $reason = shift @_;
249 my $sendmail_opts = "-fvorner+iderr\@ucw.cz '$reply_plain' vorner+idecho\@ucw.cz";
250 if ($debug || $reply eq "") {
254 open(MAIL, ">&STDOUT") || die;
255 print MAIL "SENDMAIL $sendmail_opts\n";
256 } elsif (!open MAIL, "|/usr/sbin/sendmail $sendmail_opts") {
257 print STDERR "Unable to ask mailer for replying!!!\n";
258 print LOG "Unable to ask mailer for replying!!!\n";
261 print MAIL "From: The PCI ID Robot <vorner+iderr\@ucw.cz>\n";
262 print MAIL "To: $reply\n";
263 print MAIL "Subject: IDbot: $reason\n";
264 print MAIL "In-Reply-To: $msgid\n" if $msgid ne "";
267 This is an automatic reply from the PCI ID Mail Robot. If you want to contact
268 the administrator of the robot, please write to pciids-devel\@lists.sourceforge.net.
272 if ($reason eq "OK") {
273 print MAIL "Your submission has been accepted.\n\n";
276 Your submission has been rejected. Please make sure that the mail you've sent
277 is a unified diff (output of diff -u) against the latest pci.ids file, that
278 the diff is not reversed and that your mailer doesn't damage long lines
279 and doesn't change tabs to spaces or vice versa. Also, we don't accept MIME
280 attachments in base64 encoding yet. If you are unable to fix your problems,
281 just use the Web interface at http://pciids.sf.net/ or submit the patch
282 to pciids-devel\@lists.sourceforge.net where it will be processed manually.
283 See the log below for additional information.
288 print MAIL "--- Processing Log ---\n\n";
289 if (open L, "<log") {
290 while (<L>) { print MAIL "$_"; }
293 print MAIL "\n--- End ---\n";
300 s/([^a-zA-Z0-9.!*,_-])/'%'.unpack('H2',$1)/ge;