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