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 $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 (?, ?, ?, ?, ?)" );
41 sub submitItem( $$$$$ ) {
42 my( $id, $name, $description, $text, $author ) = @_;
44 $id =~ s/(.{8})(.+)/$1\/$2/;
45 $id =~ s/(.{4})(.+)/$1\/$2/;
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 );
53 $hasItem->execute( $id );
54 unless( $hasItem->fetchrow_array ) {
55 tlog( "mailbot: Item created (empty) $id" );
57 $parent =~ s/\/[^\/]*$//;
58 $addItem->execute( $id, $parent );
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 } );
71 $hdr = new Mail::Header;
73 $hdr->mail_from(COERCE);
74 $hdr->read(*STDIN{IO});
76 $mfrom = $hdr->get('Mail-From');
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");
83 if ($reply =~ /<(\S*)>/) {
85 } elsif ($reply =~ /^\S+$/) {
86 $reply_plain = $reply;
88 $reply_plain = $mfrom;
90 $reply_plain =~ tr/\n'"\\//d;
91 $msgid = $hdr->get('Message-Id');
93 my $subj = $hdr->get('Subject');
95 if ($subj =~ /^IDS: (.*)/) {
98 $author = $reply_plain;
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" );
110 blackhole("Dropping email from $author, not in database.\n");
113 mkdir("${home}tmp", 0777);
114 mkdir($tprefix, 0777) || error("Cannot create tmpdir");
115 chdir($tprefix) || error("Cannot chdir to tmpdir");
117 open(TEMP, ">patch") || error("Cannot create tmpfile");
118 if ($debug || $reply eq "") {
119 open(LOG, ">&STDOUT") || error ("Cannot create outfile");
121 open(LOG, ">log") || error ("Cannot create outfile");
125 print LOG "Got mail from $reply, will reply to $reply_plain.\n";
126 print LOG "Scanning mail for patch.\n";
128 print LOG "Scanning STDIN for patch.\n";
140 if (/^\s*$/ || !/^[ +\@-]/) {
146 /^@@ -\d+,(\d+) \+\d+,(\d+) @@/ || error("Malformed patch");
149 while ($old || $new) {
152 if (/^ /) { $old--; $new--; }
153 elsif (/^-/) { $old--; }
154 elsif (/^\+/) { $new--; }
155 else { error("Malformed patch"); }
156 if ($old<0 || $new<0) { error("Malformed patch"); }
162 error("No patch found");
167 `rm -rf $tprefix` unless $debug;
173 my $reason = shift @_;
174 print STDERR "Blackholed: $reason\n";
180 my $reason = shift @_;
181 print LOG "$reason\n";
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";
194 print LOG `/usr/bin/patch <patch --no-backup -o pci.ids -r pci.rej $orig`;
196 print LOG "Failed.\n";
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);
217 /^(\+\+\+|---)/ && next;
219 ($tt,$id,$name,$stat,$cmt) = split /\t/;
220 if ($tt =~ /^\+(.*)/) {
221 defined $seen{$id} && next;
223 } elsif ($tt =~ /^-(.*)/) {
225 } else { error("Internal bug #23"); }
226 print LOG "$id\t$name\t$cmt\n";
227 submitItem( $id, $name, $cmt, $subject, $authorId ) if $live;
229 $tables->dbh->commit();
232 `echo >>$home/mailbot.log "## $time $reply"`;
233 `cat result >>$home/mailbot.log`;
239 error("Unable to find any version of pci.ids the patch applies to.");
244 my $reason = shift @_;
245 my $sendmail_opts = "-fvorner+iderr\@ucw.cz '$reply_plain' vorner+idecho\@ucw.cz";
246 if ($debug || $reply eq "") {
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";
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 "";
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.
268 if ($reason eq "OK") {
269 print MAIL "Your submission has been accepted.\n\n";
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.
284 print MAIL "--- Processing Log ---\n\n";
285 if (open L, "<log") {
286 while (<L>) { print MAIL "$_"; }
289 print MAIL "\n--- End ---\n";
296 s/([^a-zA-Z0-9.!*,_-])/'%'.unpack('H2',$1)/ge;