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 ) {
48 tlog( "mailbot: Creating user $mail" );
49 $addAuth->execute( $mail );
50 my $nid = $tables->dbh->last_insert_id( undef, undef, undef, undef );
51 tlog( "mailbot: User ($mail) id: $nid" );
56 sub submitItem( $$$$$ ) {
57 my( $id, $name, $description, $text, $author ) = @_;
59 $id =~ s/(.{8})(.+)/$1\/$2/;
60 $id =~ s/(.{4})(.+)/$1\/$2/;
62 if( length $id > 12 ) {
63 my( $vendor ) = ( $id =~ /^PC\/....\/....\/(....)/ );
64 $vendor = "PC/$vendor";
65 $hasItem->execute( $vendor );
66 error( "Missing subsystem vendor" ) unless( $hasItem->fetchrow_array );
68 $hasItem->execute( $id );
69 unless( $hasItem->fetchrow_array ) {
70 tlog( "mailbot: Item created (empty) $id" );
72 $parent =~ s/\/[^\/]*$//;
73 $addItem->execute( $id, $parent );
76 $addComment->execute( $author, $id, $text, $name, $description );
77 my $hid = $tables->last();
78 tlog( "mailbot: History created $hid $id ".logEscape( $name )." ".logEscape( $description )." ".logEscape( $text ) );
79 notify( $tables, $id, $hid, $created ? 2 : 1, $created ? 0 : 1 );
83 $hdr = new Mail::Header;
85 $hdr->mail_from(COERCE);
86 $hdr->read(*STDIN{IO});
88 $mfrom = $hdr->get('Mail-From');
90 ($mfrom =~ /^MAILER-DAEMON@/i) && blackhole("From mailer daemon");
91 $mfrom =~ s/ .*// or blackhole("Malformed envelope sender");
92 ($reply = $hdr->get('Reply-To')) || ($reply = $hdr->get('From')) ||
93 blackhole("Don't know who should I reply to");
95 if ($reply =~ /<(\S*)>/) {
97 } elsif ($reply =~ /^\S+$/) {
98 $reply_plain = $reply;
100 $reply_plain = $mfrom;
102 $reply_plain =~ tr/\n'"\\//d;
103 $msgid = $hdr->get('Message-Id');
105 my $subj = $hdr->get('Subject');
107 if ($subj =~ /^IDS: (.*)/) {
110 $author = $reply_plain;
113 $tprefix = "tmp/mbot-$$";
116 mkdir($tprefix, 0777) || error("Cannot create tmpdir");
117 chdir($tprefix) || error("Cannot chdir to tmpdir");
119 open(TEMP, ">patch") || error("Cannot create tmpfile");
120 if ($debug || $reply eq "") {
121 open(LOG, ">&STDOUT") || error ("Cannot create outfile");
123 open(LOG, ">log") || error ("Cannot create outfile");
127 print LOG "Got mail from $reply, will reply to $reply_plain.\n";
128 print LOG "Scanning mail for patch.\n";
130 print LOG "Scanning STDIN for patch.\n";
142 if (/^\s*$/ || !/^[ +\@-]/) {
148 /^@@ -\d+,(\d+) \+\d+,(\d+) @@/ || error("Malformed patch");
151 while ($old || $new) {
154 if (/^ /) { $old--; $new--; }
155 elsif (/^-/) { $old--; }
156 elsif (/^\+/) { $new--; }
157 else { error("Malformed patch"); }
158 if ($old<0 || $new<0) { error("Malformed patch"); }
164 error("No patch found");
169 `rm -rf $tprefix` unless $debug;
175 my $reason = shift @_;
176 print STDERR "Blackholed: $reason\n";
182 my $reason = shift @_;
183 print LOG "$reason\n";
190 print LOG "Patch found.\n";
191 print LOG "Searching for original pci.ids version.\n";
192 foreach $orig (($original eq "") ? glob("$home/origs/*") : ("../../$original")) {
193 print LOG "Trying $orig\n";
196 print LOG `/usr/bin/patch <patch --no-backup -o pci.ids -r pci.rej $orig`;
198 print LOG "Failed.\n";
200 print LOG "Patch succeeded.\n";
201 print LOG "Parsing patched file.\n";
202 print LOG `$home/bin/ids_to_dbdump <$orig 2>&1 >orig.db.unsorted`;
203 $? && error("Error parsing original ID database");
204 print LOG `sort +1 <orig.db.unsorted >orig.db`;
205 $? && error("Error sorting original ID database");
206 print LOG `$home/bin/ids_to_dbdump <pci.ids 2>&1 >new.db.unsorted`;
207 $? && error("Error parsing the patched pci.ids file");
208 print LOG `sort +1 <new.db.unsorted >new.db`;
209 $? && error("Error sorting the patched pci.ids file");
210 print LOG "Finding ID differences.\n";
211 `diff -U0 new.db orig.db >diffs`;
212 if ($? > 256) { error("Diff failed. Why?"); }
213 elsif (!$?) { error("No ID changes encountered."); }
214 open(DIFF, "diffs") || error("Cannot open the diff");
215 $subject = undef if $subject eq '';
216 my $authorId = getAuthor( $author );
217 my $live = (!$emulate && !$debug);
220 /^(\+\+\+|---)/ && next;
222 ($tt,$id,$name,$stat,$cmt) = split /\t/;
223 if ($tt =~ /^\+(.*)/) {
224 defined $seen{$id} && next;
226 } elsif ($tt =~ /^-(.*)/) {
228 } else { error("Internal bug #23"); }
229 print LOG "$id\t$name\t$cmt\n";
230 submitItem( $id, $name, $cmt, $subject, $authorId ) if $live;
232 $tables->dbh->commit();
235 `echo >>$home/mailbot.log "## $time $reply"`;
236 `cat result >>$home/mailbot.log`;
242 error("Unable to find any version of pci.ids the patch applies to.");
247 my $reason = shift @_;
248 my $sendmail_opts = "-fvorner+iderr\@ucw.cz '$reply_plain' vorner+idecho\@ucw.cz";
249 if ($debug || $reply eq "") {
253 open(MAIL, ">&STDOUT") || die;
254 print MAIL "SENDMAIL $sendmail_opts\n";
255 } elsif (!open MAIL, "|/usr/sbin/sendmail $sendmail_opts") {
256 print STDERR "Unable to ask mailer for replying!!!\n";
257 print LOG "Unable to ask mailer for replying!!!\n";
260 print MAIL "From: The PCI ID Robot <vorner+iderr\@ucw.cz>\n";
261 print MAIL "To: $reply\n";
262 print MAIL "Subject: IDbot: $reason\n";
263 print MAIL "In-Reply-To: $msgid\n" if $msgid ne "";
266 This is an automatic reply from the PCI ID Mail Robot. If you want to contact
267 the administrator of the robot, please write to pciids-devel\@lists.sourceforge.net.
271 if ($reason eq "OK") {
272 print MAIL "Your submission has been accepted.\n\n";
275 Your submission has been rejected. Please make sure that the mail you've sent
276 is a unified diff (output of diff -u) against the latest pci.ids file, that
277 the diff is not reversed and that your mailer doesn't damage long lines
278 and doesn't change tabs to spaces or vice versa. Also, we don't accept MIME
279 attachments in base64 encoding yet. If you are unable to fix your problems,
280 just use the Web interface at http://pciids.sf.net/ or submit the patch
281 to pciids-devel\@lists.sourceforge.net where it will be processed manually.
282 See the log below for additional information.
287 print MAIL "--- Processing Log ---\n\n";
288 if (open L, "<log") {
289 while (<L>) { print MAIL "$_"; }
292 print MAIL "\n--- End ---\n";
299 s/([^a-zA-Z0-9.!*,_-])/'%'.unpack('H2',$1)/ge;