]> git.donarmstrong.com Git - debbugs.git/blob - scripts/process.in
* Fix the documentation of clone to indicate that you need at least
[debbugs.git] / scripts / process.in
1 #!/usr/bin/perl
2 # $Id: process.in,v 1.109 2006/02/09 22:02:04 don Exp $
3 #
4 # Usage: process nn
5 # Temps:  incoming/Pnn
6
7 use POSIX qw(strftime tzset);
8 $ENV{"TZ"} = 'UTC';
9 tzset();
10
11 use MIME::Parser;
12 use Debbugs::MIME qw(decode_rfc1522 create_mime_message);
13 use Debbugs::Mail qw(send_mail_message encode_headers);
14
15 $config_path = '/etc/debbugs';
16 $lib_path = '/usr/lib/debbugs';
17
18 require "$config_path/config";
19 require "$lib_path/errorlib";
20 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
21
22 chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
23
24 #open(DEBUG,"> /tmp/debbugs.debug");
25 umask(002);
26 open DEBUG, ">/dev/null";
27
28 defined( $intdate= time ) || &quit( "failed to get time: $!" );
29
30 $_=shift;
31 m/^([BMQFDUL])(\d*)\.\d+$/ || &quit("bad argument");
32 $codeletter= $1;
33 $tryref= length($2) ? $2+0 : -1;
34 $nn= $_;
35
36 if (!rename("incoming/G$nn","incoming/P$nn")) 
37 {
38     $_=$!.'';  m/no such file or directory/i && exit 0;
39     &quit("renaming to lock: $!");
40 }
41
42 $baddress= 'submit' if $codeletter eq 'B';
43 $baddress= 'maintonly' if $codeletter eq 'M';
44 $baddress= 'quiet' if $codeletter eq 'Q';
45 $baddress= 'forwarded' if $codeletter eq 'F';
46 $baddress= 'done' if $codeletter eq 'D';
47 $baddress= 'submitter' if $codeletter eq 'U';
48 bug_list_forward($nn) if $codeletter eq 'L';
49 $baddress || &quit("bad codeletter $codeletter");
50 $baddressroot= $baddress;
51 $baddress= "$tryref-$baddress" if $tryref>=0;
52
53 open(M,"incoming/P$nn");
54 @log=<M>;
55 close(M);
56
57 @msg=@log;
58 chomp @msg;
59
60 print DEBUG "###\n",join("##\n",@msg),"\n###\n";
61
62 $tdate = strftime "%a, %d %h %Y %T UTC", localtime;
63 $fwd= <<END;
64 Received: via spool by $baddress\@$gEmailDomain id=$nn
65           (code $codeletter ref $tryref); $tdate
66 END
67
68 # header and decoded body respectively
69 my (@headerlines, @bodylines);
70
71 my $parser = new MIME::Parser;
72 mkdir "$gSpoolDir/mime.tmp", 0777;
73 $parser->output_under("$gSpoolDir/mime.tmp");
74 my $entity = eval { $parser->parse_data(join('',@log)) };
75
76 if ($entity and $entity->head->tags) {
77     @headerlines = @{$entity->head->header};
78     chomp @headerlines;
79
80     my $entity_body = getmailbody($entity);
81     @bodylines = $entity_body ? $entity_body->as_lines() : ();
82     chomp @bodylines;
83
84     # set $i to beginning of encoded body data, so we can dump it out
85     # verbatim later
86     $i = 0;
87     ++$i while $msg[$i] =~ /./;
88 } else {
89     # Legacy pre-MIME code, kept around in case MIME::Parser fails.
90     for ($i = 0; $i <= $#msg; $i++) {
91         $_ = $msg[$i];
92         last unless length($_);
93         while ($msg[$i+1] =~ m/^\s/) {
94             $i++;
95             $_ .= "\n".$msg[$i];
96         }
97         push @headerlines, $_;
98     }
99
100     @bodylines = @msg[$i..$#msg];
101 }
102
103 my %header;
104
105 for my $hdr (@headerlines) {
106     $hdr = decode_rfc1522($hdr);
107     $_ = $hdr;
108     s/\n\s/ /g;
109     &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
110     my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
111            && !m/^From / && !m/^X-Debbugs-/i;
112     $fwd .= $hdr."\n" if $ins;
113     # print DEBUG ">$_<\n";
114     if (s/^(\S+):\s*//) {
115         my $v = lc $1;
116         print DEBUG ">$v=$_<\n";
117         $header{$v} = $_;
118     } else {
119         print DEBUG "!>$_<\n";
120     }
121 }
122
123 # remove blank lines
124 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
125
126 # Strip off RFC2440-style PGP clearsigning.
127 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
128     shift @bodylines while @bodylines and length $bodylines[0];
129     shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
130     for my $findsig (0 .. $#bodylines) {
131         if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
132             $#bodylines = $findsig - 1;
133             last;
134         }
135     }
136     map { s/^- // } @bodylines;
137 }
138
139 # extract pseudo-headers
140 for my $phline (@bodylines)
141 {
142     last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
143     my ($fn, $fv) = ($1, $2);
144     $fv =~ s/\s*$//;
145     print DEBUG ">$fn|$fv|\n";
146     $fn = lc $fn;
147     $fv = lc $fv;
148     $pheader{$fn} = $fv;
149     print DEBUG ">$fn~$fv<\n";
150 }
151
152 # Allow pseudo headers to set x-debbugs- stuff [#179340]
153 for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
154      $header{$key} = $pheader{$key} if not exists $header{$key};
155 }
156
157 $fwd .= join("\n",@msg[$i..$#msg]);
158
159 print DEBUG "***\n$fwd\n***\n";
160
161 if (defined $header{'resent-from'} && !defined $header{'from'}) {
162     $header{'from'} = $header{'resent-from'};
163 }
164 defined($header{'from'}) || &quit("no From header");
165
166 $replyto = $header{'reply-to'};
167 $replyto = '' unless defined $replyto;
168 $replyto =~ s/^ +//;
169 $replyto =~ s/ +$//;
170 unless (length $replyto) {
171     $replyto = $header{'from'};
172 }
173
174 $_= $replyto;
175 $_= "$2 <$1>" if m/^([^\<\> \t\n\(\)]+) \(([^\(\)\<\>]+)\)$/;
176 $replytocompare= $_;
177 print DEBUG "replytocompare >$replytocompare<\n";
178     
179 if (!defined($header{'subject'})) 
180 {
181         $brokenness.= <<END;
182
183 Your message did not contain a Subject field. They are recommended and
184 useful because the title of a $gBug is determined using this field.
185 Please remember to include a Subject field in your messages in future.
186 END
187
188 # RFC822 actually lists it as an `optional-field'.
189
190     $subject= '(no subject)';
191 } else { 
192     $subject= $header{'subject'}; 
193 }
194
195 $ref=-1;
196 $subject =~ s/^Re:\s*//i; $_= $subject."\n";
197 if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
198     $tryref= $1+0; 
199 }
200
201 if ($tryref >= 0) 
202 {
203     ($bfound, $data)= &lockreadbugmerge($tryref);
204     if ($bfound) { 
205         $ref= $tryref; 
206     } else {
207         &htmllog("Reply","sent", $replyto,"Unknown problem report number <code>$tryref</code>.");
208         my $archivenote = '';
209         if ($gRemoveAge) {
210             $archivenote = <<END;
211 This may be because that $gBug report has been resolved for more than $gRemoveAge
212 days, and the record of it has been archived and made read-only, or
213 because you mistyped the $gBug report number.
214
215 END
216         }
217         &sendmessage(<<END, '');
218 From: $gMaintainerEmail ($gProject $gBug Tracking System)
219 To: $replyto
220 Subject: Unknown problem report $gBug#$tryref ($subject)
221 Message-ID: <handler.x.$nn.unknown\@$gEmailDomain>
222 In-Reply-To: $header{'message-id'}
223 References: $header{'message-id'} $data->{msgid}
224 Precedence: bulk
225 X-$gProject-PR-Message: error
226
227 You sent a message to the $gBug tracking system which gave (in the
228 Subject line or encoded into the recipient at $gEmailDomain),
229 the number of a nonexistent $gBug report (#$tryref).
230
231 ${archivenote}Your message was dated $header{'date'} and was sent to
232 $baddress\@$gEmailDomain.  It had
233 Message-ID $header{'message-id'}
234 and Subject $subject.
235
236 It has been filed (under junk) but otherwise ignored.
237
238 Please consult your records to find the correct $gBug report number, or
239 contact me, the system administrator, for assistance.
240
241 $gMaintainer
242 (administrator, $gProject $gBugs database)
243
244 (NB: If you are a system administrator and have no idea what I am
245 talking about this indicates a serious mail system misconfiguration
246 somewhere.  Please contact me immediately.)
247
248 END
249         &appendlog;
250         &finish;
251     }
252 } else { 
253     &filelock('lock/-1'); 
254 }
255
256 if ($codeletter eq 'D' || $codeletter eq 'F') 
257 {
258     if ($replyto =~ m/$gBounceFroms/o ||
259         $header{'from'} =~ m/$gBounceFroms/o)
260     { 
261         &quit("bounce detected !  Mwaap! Mwaap!"); 
262     }
263     $markedby= $header{'from'} eq $replyto ? $replyto :
264                "$header{'from'} (reply to $replyto)";
265     my @generalcc;
266     if ($codeletter eq 'F') {
267         (&appendlog,&finish) if length($data->{forwarded});
268         $receivedat= "forwarded\@$gEmailDomain";
269         $markaswhat= 'forwarded';
270         $set_forwarded= $header{'to'};
271         if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
272             push @generalcc, "$gForwardList\@$gListDomain";
273             $generalcc= "$gForwardList\@$gListDomain";
274         } else { 
275             $generalcc=''; 
276         }
277     } else {
278         if (length($data->{done}) and
279                 not defined $pheader{'source-version'} and
280                 not defined $pheader{'version'}) {
281             &appendlog;
282             &finish;
283         }
284         $receivedat= "done\@$gEmailDomain";
285         $markaswhat= 'done';
286         $set_done= $header{'from'};
287         if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
288             $generalcc= "$gDoneList\@$gListDomain";
289             push @generalcc, "$gDoneList\@$gListDomain";
290         } else { 
291             $generalcc=''; 
292         }
293     }
294     if (defined $gStrongList and isstrongseverity($data->{severity})) {
295         $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
296         push @generalcc,"$gStrongList\@$gListDomain";
297     }
298     if ($ref<0) {
299         &htmllog("Warning","sent",$replyto,"Message ignored.");
300         &sendmessage(<<END, '');
301 From: $gMaintainerEmail ($gProject $gBug Tracking System)
302 To: $replyto
303 Subject: Message with no $gBug number ignored by $receivedat
304          ($subject)
305 Message-ID: <header.x.$nn.warnignore\@$gEmailDomain>
306 In-Reply-To: $header{'message-id'}
307 References: $header{'message-id'} $data->{msgid}
308 Precedence: bulk
309 X-$gProject-PR-Message: error
310
311 You sent a message to the $gProject $gBug tracking system old-style
312 unified mark as $markaswhat address ($receivedat),
313 without a recognisable $gBug number in the Subject.
314 Your message has been filed under junk but otherwise ignored.
315
316 If you don't know what I'm talking about then probably either:
317
318 (a) you unwittingly sent a message to done\@$gEmailDomain
319 because you replied to all recipients of the message a developer used
320 to mark a $gBug as done and you modified the Subject.  In this case,
321 please do not be alarmed.  To avoid confusion do not do it again, but
322 there is no need to apologise or mail anyone asking for an explanation.
323
324 (b) you are a system administrator, reading this because the $gBug 
325 tracking system is responding to a misdirected bounce message.  In this
326 case there is a serious mail system misconfiguration somewhere - please
327 contact me immediately.
328
329 Your message was dated $header{'date'} and had
330 message-id $header{'message-id'}
331 and subject $subject.
332
333 If you need any assistance or explanation please contact me.
334
335 $gMaintainer
336 (administrator, $gProject $gBugs database)
337
338 END
339         &appendlog;
340         &finish;
341     }
342
343     &checkmaintainers;
344
345     my @noticecc = grep($_ ne $replyto,@maintaddrs);
346     $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
347     $noticeccval =~ s/\s+\n\s+/ /g; 
348     $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
349     if (length($noticeccval)) { $noticecc= "Cc: $noticeccval\n"; }
350
351     @process= ($ref,split(/ /,$data->{mergedwith}));
352     $orgref= $ref;
353
354     for $ref (@process) {
355         if ($ref != $orgref) {
356             &unfilelock;
357             $data = &lockreadbug($ref)
358                 || die "huh ? $ref from $orgref out of @process";
359         }
360         $data->{done}= $set_done if defined($set_done);
361         $data->{forwarded}= $set_forwarded if defined($set_forwarded);
362         if ($codeletter eq 'D') {
363             $data->{keywords} = join ' ', grep $_ ne 'pending',
364                                      split ' ', $data->{keywords};
365             if (defined $pheader{'source-version'}) {
366                 addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
367             } elsif (defined $pheader{version}) {
368                 addfixedversions($data, $pheader{package}, $pheader{version}, 'binary');
369             }
370         }
371
372         # Add bug mailing list to $generalbcc as appropriate
373         # This array is used to specify bcc in the cases where we're using create_mime_message.
374         my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
375         my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
376         $generalbcc =~ s/\s+\n\s+/ /g;
377         $generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
378         if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
379
380         writebug($ref, $data);
381
382         my $hash = get_hashname($ref);
383         open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
384         $x= join('',<O>); close(O);
385         if ($codeletter eq 'F') {
386             &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
387             &sendmessage(create_mime_message(
388              ["X-Loop"      => "$gMaintainerEmail",
389               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
390               To            => "$replyto",
391               Subject       => "$gBug#$ref: marked as forwarded ($data->{subject})",
392               "Message-ID"  => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
393               "In-Reply-To" => $header{'message-id'},
394               References    => "$header{'message-id'} $data->{msgid}",
395               Precedence    => 'bulk',
396               "X-$gProject-PR-Message"  => "forwarded $ref",
397               "X-$gProject-PR-Package"  => $data->{package},
398               "X-$gProject-PR-Keywords" => $data->{keywords}
399              ],<<END ,[join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
400 Your message dated $header{'date'}
401 with message-id $header{'message-id'}
402 has caused the $gProject $gBug report #$ref,
403 regarding $data->{subject}
404 to be marked as having been forwarded to the upstream software
405 author(s) $data->{forwarded}.
406
407 (NB: If you are a system administrator and have no idea what I am
408 talking about this indicates a serious mail system misconfiguration
409 somewhere.  Please contact me immediately.)
410
411 $gMaintainer
412 (administrator, $gProject $gBugs database)
413
414 END
415
416         } else {
417             &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
418             &sendmessage(create_mime_message(
419              ["X-Loop"      => "$gMaintainerEmail",
420               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
421               To            => $replyto,
422               Subject       => "$gBug#$ref: marked as done ($data->{subject})",
423               "Message-ID"  => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
424               "In-Reply-To" => $header{'message-id'},
425               References    => "$header{'message-id'} $data->{msgid}",
426               Precedence    => 'bulk',
427               "X-$gProject-PR-Message"  => "closed $ref",
428               "X-$gProject-PR-Package"  => $data->{package},
429               "X-$gProject-PR-Keywords" => $data->{keywords}
430              ],<<END ,[$x,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
431 Your message dated $header{'date'}
432 with message-id $header{'message-id'}
433 and subject line $subject
434 has caused the attached $gBug report to be marked as done.
435
436 This means that you claim that the problem has been dealt with.
437 If this is not the case it is now your responsibility to reopen the
438 $gBug report if necessary, and/or fix the problem forthwith.
439
440 (NB: If you are a system administrator and have no idea what I am
441 talking about this indicates a serious mail system misconfiguration
442 somewhere.  Please contact me immediately.)
443
444 $gMaintainer
445 (administrator, $gProject $gBugs database)
446
447 END
448             &htmllog("Notification","sent",$data->{originator}, 
449                 "$gBug acknowledged by developer.");
450             &sendmessage(create_mime_message(
451              ["X-Loop"      => "$gMaintainerEmail",
452               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
453               To            => "$data->{originator}",
454               Subject       => "$gBug#$ref closed by $markedby ($header{'subject'})",
455               "Message-ID"  => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
456               "In-Reply-To" => "$data->{msgid}",
457               References    => "$header{'message-id'} $data->{msgid}",
458               "X-$gProject-PR-Message"  => "they-closed $ref",
459               "X-$gProject-PR-Package"  => "$data->{package}",
460               "X-$gProject-PR-Keywords" => "$data->{keywords}",
461               "Reply-To"                => "$ref\@$gEmailDomain",
462               "Content-Type"            => 'text/plain; charset="utf-8"',
463              ],<<END ,[join("\n",@msg)]),'',undef,1);
464 This is an automatic notification regarding your $gBug report
465 #$ref: $data->{subject},
466 which was filed against the $data->{package} package.
467
468 It has been closed by $markedby.
469
470 Their explanation is attached below.  If this explanation is
471 unsatisfactory and you have not received a better one in a separate
472 message then please contact $markedby by replying
473 to this email.
474
475 $gMaintainer
476 (administrator, $gProject $gBugs database)
477
478 END
479         }
480         &appendlog;
481     }
482     &finish;
483 }
484
485 if ($ref<0) {
486     if ($codeletter eq 'U') {
487         &htmllog("Warning","sent",$replyto,"Message not forwarded.");
488         &sendmessage(<<END, '');
489 From: $gMaintainerEmail ($gProject $gBug Tracking System)
490 To: $replyto
491 Subject: Message with no $gBug number cannot be sent to submitter !
492          ($subject)
493 Message-ID: <handler.x.$nn.nonumnosub\@$gEmailDomain>
494 In-Reply-To: $header{'message-id'}
495 References: $header{'message-id'} $data->{msgid}
496 Precedence: bulk
497 X-$gProject-PR-Message: error
498
499 You sent a message to the $gProject $gBug tracking system's $gBug 
500 report submitter address $baddress\@$gEmailDomain, without a
501 recognisable $gBug number in the Subject.  Your message has been filed
502 under junk but otherwise ignored.
503
504 If you don't know what I'm talking about then probably either:
505
506 (a) you unwittingly sent a message to $baddress\@$gEmailDomain
507 because you replied to all recipients of the message a developer sent
508 to a $gBug\'s submitter and you modified the Subject.  In this case,
509 please do not be alarmed.  To avoid confusion do not do it again, but
510 there is no need to apologise or mail anyone asking for an
511 explanation.
512
513 (b) you are a system administrator, reading this because the $gBug 
514 tracking system is responding to a misdirected bounce message.  In this
515 case there is a serious mail system misconfiguration somewhere - please
516 contact me immediately.
517
518 Your message was dated $header{'date'} and had
519 message-id $header{'message-id'}
520 and subject $subject.
521
522 If you need any assistance or explanation please contact me.
523
524 $gMaintainer
525 (administrator, $gProject $gBugs database)
526
527 END
528         &appendlog;
529         &finish;
530     }
531
532     $data->{found_versions} = [];
533     $data->{fixed_versions} = [];
534
535     if (defined $pheader{source}) {
536         $data->{package} = $pheader{source};
537     } elsif (defined $pheader{package}) {
538         $data->{package} = $pheader{package};
539     } else {
540         &htmllog("Warning","sent",$replyto,"Message not forwarded.");
541         &sendmessage(create_mime_message(
542                        ["X-Loop"      => "$gMaintainerEmail",
543                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
544                         To            => $replyto,
545                         Subject       => "Message with no Package: tag cannot be processed! ($subject)",
546                         "Message-ID"  => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
547                         "In-Reply-To" => $header{'message-id'},
548                         References    => "$header{'message-id'} $data->{msgid}",
549                         Precedence    => 'bulk',
550                         "X-$gProject-PR-Message" => 'error'
551                        ],<<END,[join("\n", @msg)]), '',undef,1);
552
553 Your message didn't have a Package: line at the start (in the
554 pseudo-header following the real mail header), or didn't have a
555 pseudo-header at all.  Your message has been filed under junk but
556 otherwise ignored.
557
558 This makes it much harder for us to categorise and deal with your
559 problem report. Please _resubmit_ your report to $baddress\@$gEmailDomain
560 and tell us which package the report is on. For help, check out
561 http://$gWebDomain/Reporting$gHTMLSuffix.
562
563 Your message was dated $header{'date'} and had
564 message-id $header{'message-id'}
565 and subject $subject.
566 The complete text of it is attached to this message.
567
568 If you need any assistance or explanation please contact me.
569
570 $gMaintainer
571 (administrator, $gProject $gBugs database)
572
573 END
574         &appendlog;
575         &finish;
576     }
577
578     $data->{keywords}= '';
579     if (defined($pheader{'keywords'})) {
580         $data->{keywords}= $pheader{'keywords'};
581     } elsif (defined($pheader{'tags'})) {
582         $data->{keywords}= $pheader{'tags'};
583     }
584     if (length($data->{keywords})) {
585         my @kws;
586         my %gkws = map { ($_, 1) } @gTags;
587         foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
588             push @kws, $kw if (defined $gkws{$kw});
589         }
590         $data->{keywords} = join(" ", @kws);
591     }
592     $data->{severity}= '';
593     if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
594         $data->{severity}= $pheader{'severity'};
595         $data->{severity}= $pheader{'priority'} unless ($data->{severity});
596         $data->{severity} =~ s/^\s*(.+)\s*$/$1/;
597
598         if (!grep($_ eq $data->{severity}, @severities, "$gDefaultSeverity")) {
599             $brokenness.= <<END;
600
601 Your message specified a Severity: in the pseudo-header, but
602 the severity value $data->{severity} was not recognised.
603 The default severity $gDefaultSeverity is being used instead.
604 The recognised values are: $gShowSeverities.
605 END
606 # if we use @gSeverityList array in the above line, perl -c gives:
607 # In string, @gSeverityList now must be written as \@gSeverityList at
608 #          process line 452, near "$gDefaultSeverity is being used instead.
609             $data->{severity}= '';
610         }
611     }
612     if (defined($pheader{owner})) {
613         $data->{owner}= $pheader{owner};
614     }
615     if (defined($pheader{forwarded})) {
616         $data->{'forwarded-to'} = $pheader{forwarded};
617     }
618     &filelock("nextnumber.lock");
619     open(N,"nextnumber") || &quit("nextnumber: read: $!");
620     $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
621     $ref= $v+0;  $v += 1;  $newref=1;
622     &overwrite('nextnumber', "$v\n");
623     &unfilelock;
624     my $hash = get_hashname($ref);
625     &overwrite("db-h/$hash/$ref.log",'');
626     $data->{originator} = $replyto;
627     $data->{date} = $intdate;
628     $data->{subject} = $subject;
629     $data->{msgid} = $header{'message-id'};
630     writebug($ref, $data);
631     &overwrite("db-h/$hash/$ref.report",
632                join("\n",@msg)."\n");
633 }
634
635 &checkmaintainers;
636
637 print DEBUG "maintainers >@maintaddrs<\n";
638
639 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
640 $newsubject= $subject;  $newsubject =~ s/^$gBug#$ref:*\s*//;
641
642 $xcchdr= $header{ 'x-debbugs-cc' };
643 if ($xcchdr =~ m/\S/) {
644     push(@resentccs,$xcchdr);
645     $resentccexplain.= <<END;
646
647 As you requested using X-Debbugs-CC, your message was also forwarded to
648    $xcchdr
649 (after having been given a $gBug report number, if it did not have one).
650 END
651 }
652
653 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
654     push(@resentccs,@maintaddrs);
655     $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
656
657 Your message has been sent to the package maintainer(s):
658 END
659 }
660
661 @bccs = @addsrcaddrs;
662 if (defined $gStrongList and isstrongseverity($data->{severity})) {
663     push @bccs, "$gStrongList\@$gListDomain";
664 }
665
666 # Send mail to the per bug list subscription too
667 push @bccs, "bugs=$ref\@$gListDomain";
668
669 if (defined $pheader{source}) {
670     # Prefix source versions with the name of the source package. They
671     # appear that way in version trees so that we can deal with binary
672     # packages moving from one source package to another.
673     if (defined $pheader{'source-version'}) {
674         addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
675     } elsif (defined $pheader{version}) {
676         addfoundversions($data, $pheader{source}, $pheader{version}, '');
677     }
678     writebug($ref, $data);
679 } elsif (defined $pheader{package}) {
680     # TODO: could handle Source-Version: by looking up the source package?
681     addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
682     writebug($ref, $data);
683 }
684
685 $veryquiet= $codeletter eq 'Q';
686 if ($codeletter eq 'M' && !@maintaddrs) {
687     $veryquiet= 1;
688     $brokenness.= <<END;
689
690 You requested that the message be sent to the package maintainer(s)
691 but either the $gBug report is not associated with any package (probably
692 because of a missing Package pseudo-header field in the original $gBug
693 report), or the package(s) specified do not have any maintainer(s).
694
695 Your message has *not* been sent to any package maintainers; it has
696 merely been filed in the $gBug tracking system.  If you require assistance
697 please contact $gMaintainerEmail quoting the $gBug number $ref.
698 END
699 }
700
701 $resentccval.= join(', ',@resentccs);
702 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
703 if (length($resentccval)) { 
704     $resentcc= "Resent-CC: $resentccval\n"; 
705 }
706
707 if ($codeletter eq 'U') {
708     &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
709     &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
710 Subject: $gBug#$ref: $newsubject
711 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
712 ${orgsender}Resent-To: $data->{originator}
713 ${resentcc}Resent-Date: $tdate
714 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
715 Resent-Sender: $gMaintainerEmail
716 X-$gProject-PR-Message: report $ref
717 X-$gProject-PR-Package: $data->{package}
718 X-$gProject-PR-Keywords: $data->{keywords}
719 $fwd
720 END
721 } elsif ($codeletter eq 'B') {
722     &htmllog($newref ? "Report" : "Information", "forwarded",
723              join(', ',"$gSubmitList\@$gListDomain",@resentccs),
724              "<code>$gBug#$ref</code>".
725              (length($data->{package})? "; Package <code>".&sani($data->{package})."</code>" : '').
726              ".");
727     &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
728 Subject: $gBug#$ref: $newsubject
729 Reply-To: $replyto, $ref\@$gEmailDomain
730 Resent-From: $header{'from'}
731 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
732 ${resentcc}Resent-Date: $tdate
733 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
734 Resent-Sender: $gMaintainerEmail
735 X-$gProject-PR-Message: report $ref
736 X-$gProject-PR-Package: $data->{package}
737 X-$gProject-PR-Keywords: $data->{keywords}
738 $fwd
739 END
740 } elsif (@resentccs or @bccs) {
741     # D and F done far earlier; B just done - so this must be M or Q
742     # We preserve whichever it was in the Reply-To (possibly adding
743     # the $gBug#).
744     if (@resentccs) {
745         &htmllog($newref ? "Report" : "Information", "forwarded",
746                  $resentccval,
747                  "<code>$gBug#$ref</code>".
748                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
749                  ".");
750     } else {
751         &htmllog($newref ? "Report" : "Information", "stored",
752                  "",
753                  "<code>$gBug#$ref</code>".
754                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
755                  ".");
756     }
757     &sendmessage(<<END,[@resentccs],[@bccs]);
758 Subject: $gBug#$ref: $newsubject
759 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
760 Resent-From: $header{'from'}
761 ${orgsender}Resent-To: $resentccval
762 Resent-Date: $tdate
763 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
764 Resent-Sender: $gMaintainerEmail
765 X-$gProject-PR-Message: report $ref
766 X-$gProject-PR-Package: $data->{package}
767 X-$gProject-PR-Keywords: $data->{keywords}
768 $fwd
769 END
770 }
771
772 $htmlbreak= length($brokenness) ? "<p>\n".&sani($brokenness)."\n<p>\n" : '';
773 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
774 if (length($resentccval)) {
775     $htmlbreak = "  Copy sent to <code>".&sani($resentccval)."</code>.".
776         $htmlbreak;
777 }
778 unless (exists $header{'x-debbugs-no-ack'}) {
779     if ($newref) {
780         &htmllog("Acknowledgement","sent",$replyto,
781                  ($veryquiet ?
782                   "New $gBug report received and filed, but not forwarded." :
783                   "New $gBug report received and forwarded."). $htmlbreak);
784         if ($veryquiet) {
785              &sendmessage(create_mime_message(
786                        ["X-Loop"      => "$gMaintainerEmail",
787                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
788                         To            => $replyto,
789                         Subject       => "$gBug#$ref: Acknowledgement of QUIET report ($subject)",
790                         "Message-ID"  => "<handler.$ref.$nn.ackquiet\@$gEmailDomain>",
791                         "In-Reply-To" => $header{'message-id'},
792                         References    => $header{'message-id'},
793                         Precedence    => 'bulk',
794                         "X-$gProject-PR-Message"  => "ack-quiet $ref",
795                         "X-$gProject-PR-Package"  => $data->{package},
796                         "X-$gProject-PR-Keywords" => $data->{keywords},
797                         "Reply-To"                => "$ref-quiet\@$gEmailDomain",
798                        ],<<END,[join("\n", @msg)]), '',undef,1);
799 Thank you for the problem report you have sent regarding $gProject.
800 This is an automatically generated reply, to let you know your message
801 has been received.  It has not been forwarded to the package maintainers
802 or other interested parties; you should ensure that the developers are
803 aware of the problem you have entered into the system - preferably
804 quoting the $gBug reference number, #$ref.
805 $resentccexplain
806 If you wish to submit further information on your problem, please send it
807 to $ref-$baddressroot\@$gEmailDomain (and *not*
808 to $baddress\@$gEmailDomain).
809
810 Please do not reply to the address at the top of this message,
811 unless you wish to report a problem with the $gBug-tracking system.
812 $brokenness
813 $gMaintainer
814 (administrator, $gProject $gBugs database)
815 END
816         }
817         elsif ($codeletter eq 'M') {
818              &sendmessage(create_mime_message(
819                        ["X-Loop"      => "$gMaintainerEmail",
820                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
821                         To            => $replyto,
822                         Subject       => "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)",
823                         "Message-ID"  => "<handler.$ref.$nn.ackmaint\@$gEmailDomain>",
824                         "In-Reply-To" => $header{'message-id'},
825                         References    => $header{'message-id'},
826                         Precedence    => 'bulk',
827                         "X-$gProject-PR-Message" => "ack-maintonly $ref",
828                         "X-$gProject-PR-Package"  => $data->{package},
829                         "X-$gProject-PR-Keywords" => $data->{keywords},
830                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
831                        ],<<END,[]), '',undef,1);
832 Thank you for the problem report you have sent regarding $gProject.
833 This is an automatically generated reply, to let you know your message has
834 been received.  It is being forwarded to the package maintainers (but not
835 other interested parties, as you requested) for their attention; they will
836 reply in due course.
837 $resentccexplain
838 If you wish to submit further information on your problem, please send
839 it to $ref-$baddressroot\@$gEmailDomain (and *not*
840 to $baddress\@$gEmailDomain).
841
842 Please do not reply to the address at the top of this message,
843 unless you wish to report a problem with the $gBug-tracking system.
844 $brokenness
845 $gMaintainer
846 (administrator, $gProject $gBugs database)
847 END
848                    }
849         else {
850              &sendmessage(create_mime_message(
851                        ["X-Loop"      => "$gMaintainerEmail",
852                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
853                         To            => $replyto,
854                         Subject       => "$gBug#$ref: Acknowledgement ($subject)",
855                         "Message-ID"  => "<handler.$ref.$nn.ack\@$gEmailDomain>",
856                         "In-Reply-To" => $header{'message-id'},
857                         References    => $header{'message-id'},
858                         Precedence    => 'bulk',
859                         "X-$gProject-PR-Message"  => "ack $ref",
860                         "X-$gProject-PR-Package"  => $data->{package},
861                         "X-$gProject-PR-Keywords" => $data->{keywords},
862                         "Reply-To"                => "$ref\@$gEmailDomain",
863                        ],<<END,[]), '',undef,1);
864 Thank you for the problem report you have sent regarding $gProject.
865 This is an automatically generated reply, to let you know your message has
866 been received.  It is being forwarded to the package maintainers and other
867 interested parties for their attention; they will reply in due course.
868 $resentccexplain
869 If you wish to submit further information on your problem, please send
870 it to $ref\@$gEmailDomain (and *not* to
871 $baddress\@$gEmailDomain).
872
873 Please do not reply to the address at the top of this message,
874 unless you wish to report a problem with the $gBug-tracking system.
875 $brokenness
876 $gMaintainer
877 (administrator, $gProject $gBugs database)
878 END
879                    }
880     } elsif ($codeletter ne 'U' and
881              $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/) {
882         &htmllog("Acknowledgement","sent",$replyto,
883                  ($veryquiet ? "Extra info received and filed, but not forwarded." :
884                   $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
885                   "Extra info received and forwarded to list."). $htmlbreak);
886         if ($veryquiet) {
887              &sendmessage(create_mime_message(
888                        ["X-Loop"      => "$gMaintainerEmail",
889                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
890                         To            => $replyto,
891                         Subject       => "$gBug#$ref: Info received and FILED only (was $subject)",
892                         "Message-ID"  => "<handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>",
893                         "In-Reply-To" => $header{'message-id'},
894                         References    => $header{'message-id'},
895                         Precedence    => 'bulk',
896                         "X-$gProject-PR-Message" => "ack-info-quiet $ref",
897                         "X-$gProject-PR-Package"  => $data->{package},
898                         "X-$gProject-PR-Keywords" => $data->{keywords},
899                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
900                        ],<<END,[]), '',undef,1);
901 Thank you for the additional information you have supplied regarding
902 this problem report.  It has NOT been forwarded to the package
903 maintainers, but will accompany the original report in the $gBug
904 tracking system.  Please ensure that you yourself have sent a copy of
905 the additional information to any relevant developers or mailing lists.
906 $resentccexplain
907 If you wish to continue to submit further information on your problem,
908 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
909
910 Please do not reply to the address at the top of this message,
911 unless you wish to report a problem with the $gBug-tracking system.
912 $brokenness
913 $gMaintainer
914 (administrator, $gProject $gBugs database)
915 END
916                  }
917         elsif ($codeletter eq 'M') {
918              &sendmessage(create_mime_message(
919                        ["X-Loop"      => "$gMaintainerEmail",
920                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
921                         To            => $replyto,
922                         Subject       => "$gBug#$ref: Info received for maintainer only (was $subject)",
923                         "Message-ID"  => "<handler.$ref.$nn.ackinfomaint\@$gEmailDomain>",
924                         "In-Reply-To" => $header{'message-id'},
925                         References    => "$header{'message-id'} $data->{msgid}",
926                         Precedence    => 'bulk',
927                         "X-$gProject-PR-Message" => "ack-info-maintonly $ref",
928                         "X-$gProject-PR-Package"  => $data->{package},
929                         "X-$gProject-PR-Keywords" => $data->{keywords},
930                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
931                        ],<<END,[]), '',undef,1);
932 Thank you for the additional information you have supplied regarding
933 this problem report.  It has been forwarded to the package maintainer(s)
934 (but not to other interested parties) to accompany the original report.
935 $resentccexplain
936 If you wish to continue to submit further information on your problem,
937 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
938
939 Please do not reply to the address at the top of this message,
940 unless you wish to report a problem with the $gBug-tracking system.
941 $brokenness
942 $gMaintainer
943 (administrator, $gProject $gBugs database)
944 END
945                    }
946         else {
947              &sendmessage(create_mime_message(
948                        ["X-Loop"      => "$gMaintainerEmail",
949                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
950                         To            => $replyto,
951                         Subject       => "$gBug#$ref: Info received ($subject)",
952                         "Message-ID"  => "<handler.$ref.$nn.ackinfo\@$gEmailDomain>",
953                         "In-Reply-To" => $header{'message-id'},
954                         References    => "$header{'message-id'} $data->{msgid}",
955                         Precedence    => 'bulk',
956                         "X-$gProject-PR-Message"  => "ack-info $ref",
957                         "X-$gProject-PR-Package"  => $data->{package},
958                         "X-$gProject-PR-Keywords" => $data->{keywords},
959                         "Reply-To"                => "$ref\@$gEmailDomain",
960                        ],<<END,[]), '',undef,1);
961 Thank you for the additional information you have supplied regarding
962 this problem report.  It has been forwarded to the package maintainer(s)
963 and to other interested parties to accompany the original report.
964 $resentccexplain
965 If you wish to continue to submit further information on your problem,
966 please send it to $ref\@$gEmailDomain, as before.
967
968 Please do not reply to the address at the top of this message,
969 unless you wish to report a problem with the $gBug-tracking system.
970 $brokenness
971 $gMaintainer
972 (administrator, $gProject $gBugs database)
973 END
974
975                    }
976    }
977 }
978
979 &appendlog;
980 &finish;
981
982 sub overwrite {
983     local ($f,$v) = @_;
984     open(NEW,">$f.new") || &quit("$f.new: create: $!");
985     print(NEW "$v") || &quit("$f.new: write: $!");
986     close(NEW) || &quit("$f.new: close: $!");
987     rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
988 }
989
990 sub appendlog {
991     my $hash = get_hashname($ref);
992     if (!open(AP,">>db-h/$hash/$ref.log")) {
993         print DEBUG "failed open log<\n";
994         print DEBUG "failed open log err $!<\n";
995         &quit("opening db-h/$hash/$ref.log (li): $!");
996     }
997     print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
998     close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
999 }
1000
1001 sub finish {
1002     utime(time,time,"db");
1003     local ($u);
1004     while ($u= $cleanups[$#cleanups]) { &$u; }
1005     unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1006     exit $_[0];
1007 }
1008
1009 &quit("wot no exit");
1010
1011 sub chldhandle { $chldexit = 'yes'; }
1012
1013 sub htmllog {
1014     local ($whatobj,$whatverb,$where,$desc) = @_;
1015     my $hash = get_hashname($ref);
1016     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
1017     print(AP
1018           "\6\n".
1019           "<strong>$whatobj $whatverb</strong>".
1020           ($where eq '' ? "" : " to <code>".&sani($where)."</code>").
1021           ":<br>\n". $desc.
1022           "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
1023     close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
1024 }    
1025
1026 sub stripbccs {
1027     my $msg = shift;
1028     my $ret = '';
1029     my $bcc = 0;
1030     while ($msg =~ s/(.*\n)//) {
1031         local $_ = $1;
1032         if (/^$/) {
1033             $ret .= $_;
1034             last;
1035         }
1036         if ($bcc) {
1037             # strip continuation lines too
1038             next if /^\s/;
1039             $bcc = 0;
1040         }
1041         if (/^Bcc:/i) {
1042             $bcc = 1;
1043         } else {
1044             $ret .= $_;
1045         }
1046     }
1047     return $ret . $msg;
1048 }
1049
1050 =head2 send_message
1051
1052      send_message($the_message,\@recipients,\@bcc,$do_not_encode)
1053
1054 The first argument is the scalar message, the second argument is the
1055 arrayref of recipients, the third is the arrayref of Bcc:'ed
1056 recipients.
1057
1058 The final argument turns off header encoding and the addition of the
1059 X-Loop header if true, defaults to false.
1060
1061 =cut
1062
1063
1064 sub sendmessage {
1065     my ($msg,$recips,$bcc,$no_encode) = @_;
1066     if (not defined $recips or (!ref($recips) && $recips eq '')
1067         or @$recips == 0) {
1068         $recips = ['-t'];
1069     }
1070     # This is suboptimal. The right solution is to send headers
1071     # separately from the rest of the message and encode them rather
1072     # than doing this.
1073     $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
1074     # The original message received is written out in appendlog, so
1075     # before writing out the other messages we've sent out, we need to
1076     # RFC1522 encode the header.
1077     $msg = encode_headers($msg) unless $no_encode;
1078
1079     my $hash = get_hashname($ref);
1080     #save email to the log
1081     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
1082     print(AP "\2\n",join("\4",@$recips),"\n\5\n",
1083           @{escapelog(stripbccs($msg))},"\n\3\n") ||
1084         &quit("writing db-h/$hash/$ref.log (lo): $!");
1085     close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1086
1087     if (ref($bcc)) {
1088         shift @$recips if $recips->[0] eq '-t';
1089         push @$recips, @$bcc;
1090     }
1091
1092     send_mail_message(message        => $msg,
1093                       # Because we encode the headers above, we do not want to encode them here
1094                       encode_headers => 0,
1095                       recipients     => $recips);
1096 }
1097
1098 sub checkmaintainers {
1099     return if $maintainerschecked++;
1100     return if !length($data->{package});
1101     open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1102     while (<MAINT>) {
1103         m/^\n$/ && next;
1104         m/^\s*$/ && next;
1105         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1106         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1107         # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1108         $maintainerof{$a}= $2;
1109     }
1110     close(MAINT);
1111     open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1112     while (<MAINT>) {
1113         m/^\n$/ && next;
1114         m/^\s*$/ && next;
1115         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1116         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1117         # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1118         $maintainerof{$a}= $2;
1119     }
1120     close(MAINT);
1121     open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1122     while (<SOURCES>) {
1123         next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1124         ($a,$b)=($1,$2);
1125         $a =~ y/A-Z/a-z/;
1126         $pkgsrc{$a} = $b;
1127     }
1128     close(SOURCES);
1129     $anymaintfound=0; $anymaintnotfound=0;
1130     for $p (split(m/[ \t?,():]+/,$data->{package})) {
1131         $p =~ y/A-Z/a-z/;
1132         $p =~ /([a-z0-9.+-]+)/;
1133         $p = $1;
1134         next unless defined $p;
1135         if (defined $gSubscriptionDomain) {
1136             if (defined($pkgsrc{$p})) {
1137                 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1138             } else {
1139                 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1140             }
1141         }
1142         if (defined($maintainerof{$p})) {
1143             print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1144             $addmaint= $maintainerof{$p};
1145             push(@maintaddrs,$addmaint) unless
1146                 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
1147             $anymaintfound++;
1148         } else {
1149             print DEBUG "maintainer none >$p<\n";
1150             push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1151             $anymaintnotfound++;
1152             last;
1153         }
1154     }
1155
1156     if (length $data->{owner}) {
1157         print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1158         $addmaint = $data->{owner};
1159         push(@maintaddrs, $addmaint) unless
1160             $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1161     }
1162 }
1163
1164 =head2 bug_list_forward
1165
1166      bug_list_forward($spool_filename) if $codeletter eq 'L';
1167
1168
1169 Given the spool file, will forward a bug to the per bug mailing list
1170 subscription system.
1171
1172 =cut
1173
1174 sub bug_list_forward{
1175      my ($bug_fn) = @_;
1176      # Read the bug information and package information for passing to
1177      # the mailing list
1178      my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1179      my ($bfound, $data)= lockreadbugmerge($bug_number);
1180      my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
1181
1182      local $/ = undef;
1183      my $bug_message = <$bug_fh>;
1184      my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1185      my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1186      if (not defined $envelope_from) {
1187           # Try to use the From: header or something to set it 
1188           ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1189           # Kludgy, and should really be using a full scale header
1190           # parser to do this.
1191           $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1192      }
1193      my ($header,$body) = split /\n\n/, $bug_message, 2;
1194      # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
1195      $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1196           qq(X-$gProject-PR-Package: $data->{package}\n).
1197                qq(X-$gProject-PR-Title: $data->{subject})
1198                if defined $data;
1199      print STDERR "Tried to loop me with $envelope_from\n"
1200           and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1201      print DEBUG $envelope_from,qq(\n);
1202      # If we don't have a bug address, something has gone horribly wrong.
1203      print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1204      $bug_address =~ s/\@.+//;
1205      print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
1206      print DEBUG $header.qq(\n\n).$body;
1207      send_mail_message(message        => $header.qq(\n\n).$body,
1208                        recipients     => ["bugs=$bug_address\@$gListDomain"],
1209                        envelope_from  => $envelope_from,
1210                        encode_headers => 0,
1211                       );
1212      unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");
1213      exit 0;
1214 }