From: Don Armstrong Date: Mon, 9 Jun 2008 16:14:09 +0000 (-0700) Subject: * Use warnings and strict X-Git-Tag: release/2.6.0~488^2~42 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=058e14633f72c9e83358ef38b61e51326808a377;p=debbugs.git * Use warnings and strict * Stop using errorlib * Switch from quit to die * Localize a ton of variables * Switch to using a glob transcript * Use the new archive_unarchived option to bug_archive * Switch to a generic add_recipient function from the multiple cc lists --- diff --git a/scripts/service b/scripts/service index 05925d2..d4b3e06 100755 --- a/scripts/service +++ b/scripts/service @@ -4,14 +4,24 @@ # Usage: service .nn # Temps: incoming/P.nn +use warnings; +use strict; + use File::Copy; use MIME::Parser; + +use Params::Validate qw(:types validate_with); + +use Debbugs::Common qw(:util :quit :misc :lock) + use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522); use Debbugs::Mail qw(send_mail_message); use Debbugs::User; use HTML::Entities qw(encode_entities); use Debbugs::Versions::Dpkg; +use Debbugs::Status qw(splitpackages); + use Debbugs::Config qw(:globals :config); use Debbugs::CGI qw(html_escape); use Debbugs::Control qw(:archive :log); @@ -20,69 +30,38 @@ use Debbugs::Text qw(:templates); use Mail::RFC822::Address; -$lib_path = $gLibPath; -require "$lib_path/errorlib"; -$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'}; +chdir($config{spoool_dir}) or + die "Unable to chdir to spool_dir '$config{spool_dir}': $!"; -chdir("$gSpoolDir") || die "chdir spool: $!\n"; - -# open(DEBUG,">&4"); -open DEBUG, ">/dev/null"; -$debug = 0; +my $debug = 0; umask(002); -$_=shift; -m/^[RC]\.\d+$/ || &quit("bad argument"); -$control= m/C/; -$nn= $_; +my ($control, $nn) = $ARGV[0] =~ m/^([RC])\.(\d+)$/ || die "bad argument"; if (!rename("incoming/G$nn","incoming/P$nn")) { - $_=$!.''; m/no such file or directory/i && exit 0; - &quit("renaming to lock: $!"); -} + defined $! and $! =~ m/no such file or directory/i and exit 0; + die "Failed to rename incoming/G$nn to incoming/P$nn: $!"; +} -open(M,"incoming/P$nn"); -@log=; -@msg=@log; -close(M); +my $log_fh = IO::File->new("incoming/P$nn",'r') or + die "Unable to open incoming/P$nn for reading: $!"; +my @log=<$log_fh>; +my @msg=@log; +close($log_fh); chomp @msg; print "###\n",join("##\n",@msg),"\n###\n" if $debug; -my $parser = new MIME::Parser; -mkdir "$gSpoolDir/mime.tmp", 0777; -$parser->output_under("$gSpoolDir/mime.tmp"); -my $entity = eval { $parser->parse_data(join('',@log)) }; - -# header and decoded body respectively -my (@headerlines, @bodylines); # Bug numbers to send e-mail to, hash so that we don't send to the # same bug twice. my (%bug_affected); -if ($entity and $entity->head->tags) { - # Use map instead of chomp to also kill \r. - @headerlines = map {s/\r?\n?$//; $_;} - @{$entity->head->header}; +my (@headerlines,@bodylines); - my $entity_body = getmailbody($entity); - @bodylines = map {s/\r?\n$//; $_;} - $entity_body ? $entity_body->as_lines() : (); -} else { - # Legacy pre-MIME code, kept around in case MIME::Parser fails. - my $i; - for ($i = 0; $i <= $#msg; $i++) { - $_ = $msg[$i]; - last unless length($_); - while ($msg[$i+1] =~ m/^\s/) { - $i++; - $_ .= "\n".$msg[$i]; - } - push @headerlines, $_; - } +my $parse_output = Debbugs::MIME::parse(join('',@log)); +@headerlines = @{$parse_output->{header}}; +@bodylines = @{$parse_output->{body}}; - @bodylines = @msg[$i..$#msg]; -} for (@headerlines) { $_ = decode_rfc1522($_); @@ -97,19 +76,6 @@ for (@headerlines) { } } -# Strip off RFC2440-style PGP clearsigning. -if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) { - shift @bodylines while @bodylines and length $bodylines[0]; - shift @bodylines while @bodylines and $bodylines[0] !~ /\S/; - for my $findsig (0 .. $#bodylines) { - if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) { - $#bodylines = $findsig - 1; - last; - } - } - map { s/^- // } @bodylines; -} - grep(s/\s+$//,@bodylines); print "***\n",join("\n",@bodylines),"\n***\n" if $debug; @@ -118,11 +84,12 @@ if (defined $header{'resent-from'} && !defined $header{'from'}) { $header{'from'} = $header{'resent-from'}; } -defined($header{'from'}) || &quit("no From header"); +defined($header{'from'}) || die "no From header"; delete $header{'reply-to'} if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ ); +my $replyto; if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) { $replyto = $header{'reply-to'}; } else { @@ -131,16 +98,19 @@ if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) { # This is an error counter which should be incremented every time there is an error. my $errors = 0; -$controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain"; -$transcript=''; -&transcript("Processing commands for $controlrequestaddr:\n\n"); - -$dl= 0; -$state= 'idle'; -$lowstate= 'idle'; -$mergelowstate= 'idle'; -$midix=0; -$extras=""; +my $controlrequestaddr= ($control ? 'control' : 'request').$config{email_domain}; +my $transcript_scalar = ''; +my $transcript = IO::Scalar->new(\$transcript_scalar) or + die "Unable to create new IO::Scalar"; +print {$stranscript} "Processing commands for $controlrequestaddr:\n\n"; + +# debug level +my $dl= 0; +my $state= 'idle'; +my $lowstate= 'idle'; +my $mergelowstate= 'idle'; +my $midix=0; +my $extras=""; my $user = $replyto; $user =~ s/,.*//; @@ -152,39 +122,39 @@ my $indicated_user = 0; my $quickabort = 0; -my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")"; -if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) { - &transcript(fill_template('mail/excluded_from_control')); + +if (@gExcludeFromControl and grep {$replyto =~ m/\Q$_\E/} @gExcludeFromControl) { + print {$transcript} fill_template('mail/excluded_from_control'); $quickabort = 1; } my %limit_pkgs = (); my %clonebugs = (); -my @bcc = (); +my %bcc = (); sub addbcc { push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc; } for ($procline=0; $procline<=$#bodylines; $procline++) { - $state eq 'idle' || print "$state ?\n"; - $lowstate eq 'idle' || print "$lowstate ?\n"; - $mergelowstate eq 'idle' || print "$mergelowstate ?\n"; + $state eq 'idle' || print "state: $state ?\n"; + $lowstate eq 'idle' || print "lowstate: $lowstate ?\n"; + $mergelowstate eq 'idle' || print "mergelowstate: $mergelowstate ?\n"; if ($quickabort) { - &transcript("Stopping processing here.\n\n"); + print {$transcript} "Stopping processing here.\n\n"; last; } $_= $bodylines[$procline]; s/\s+$//; next unless m/\S/; - &transcript("> $_\n"); + print {$transcript} "> $_\n"; next if m/^\s*\#/; $action= ''; if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) { - &transcript("Stopping processing here.\n\n"); + print {$transcript} "Stopping processing here.\n\n"; last; } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) { $dl= $1+0; - &transcript("Debug level $dl.\n\n"); + print {$transcript} "Debug level $dl.\n\n"; } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) { $ref= $2+0; &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref"); @@ -193,15 +163,15 @@ for ($procline=0; $procline<=$#bodylines; $procline++) { &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes", "detailed logs for $gBug#$ref"); } elsif (m/^index(\s+full)?$/i) { - &transcript("This BTS function is currently disabled, sorry.\n\n"); + print {$transcript} "This BTS function is currently disabled, sorry.\n\n"; $errors++; $ok++; # well, it's not really ok, but it fixes #81224 :) } elsif (m/^index-summary\s+by-package$/i) { - &transcript("This BTS function is currently disabled, sorry.\n\n"); + print {$transcript} "This BTS function is currently disabled, sorry.\n\n"; $errors++; $ok++; # well, it's not really ok, but it fixes #81224 :) } elsif (m/^index-summary(\s+by-number)?$/i) { - &transcript("This BTS function is currently disabled, sorry.\n\n"); + print {$transcript} "This BTS function is currently disabled, sorry.\n\n"; $errors++; $ok++; # well, it's not really ok, but it fixes #81224 :) } elsif (m/^index(\s+|-)pack(age)?s?$/i) { @@ -219,15 +189,15 @@ for ($procline=0; $procline<=$#bodylines; $procline++) { "$gBug list for package $package"); $ok++; } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) { - &transcript("This BTS function is currently disabled, sorry.\n\n"); + print {$transcript} "This BTS function is currently disabled, sorry.\n\n"; $errors++; $ok++; # well, it's not really ok, but it fixes #81224 :) } elsif (m/^send-unmatched\s+(last|-1)$/i) { - &transcript("This BTS function is currently disabled, sorry.\n\n"); + print {$transcript} "This BTS function is currently disabled, sorry.\n\n"; $errors++; $ok++; # well, it's not really ok, but it fixes #81224 :) } elsif (m/^send-unmatched\s+(old|-2)$/i) { - &transcript("This BTS function is currently disabled, sorry.\n\n"); + print {$transcript} "This BTS function is currently disabled, sorry.\n\n"; $errors++; $ok++; # well, it's not really ok, but it fixes #81224 :) } elsif (m/^getinfo\s+([\w-.]+)$/i) { @@ -241,23 +211,23 @@ for ($procline=0; $procline<=$#bodylines; $procline++) { } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") { &sendinfo("local", "$gConfigDir/$req", "$req file"); } else { - &transcript("Info file $req does not exist.\n\n"); + print {$transcript} "Info file $req does not exist.\n\n"; } } elsif (m/^help/i) { &sendhelp; - &transcript("\n"); + print {$transcript} "\n"; $ok++; } elsif (m/^refcard/i) { &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card"); } elsif (m/^subscribe/i) { - &transcript(< $bodylines[$procline]\n"); + print {$transcript} "> $bodylines[$procline]\n"; next if $bad; my ($o, $txt) = ($1, $2); if ($#cats == -1 && $o eq "+") { - &transcript("User defined category specification must start with a category name. Skipping.\n\n"); + print {$transcript} "User defined category specification must start with a category name. Skipping.\n\n"; $errors++; $bad = 1; next; @@ -320,7 +290,7 @@ END } elsif ($txt =~ m/^([^[\s]+)\s*$/) { $desc = ""; $op = $1; } else { - &transcript("Unrecognised syntax for category section. Skipping.\n\n"); + print {$transcript} "Unrecognised syntax for category section. Skipping.\n\n"; $errors++; $bad = 1; next; @@ -353,13 +323,13 @@ END # XXX: got @cats, now do something with it my $u = Debbugs::User::get_user($user); if (@cats) { - &transcript("Added usercategory $catname.\n\n"); + print {$transcript} "Added usercategory $catname.\n\n"; $u->{"categories"}->{$catname} = [ @cats ]; if (not $hidden) { push @{$u->{visible_cats}},$catname; } } else { - &transcript("Removed usercategory $catname.\n\n"); + print {$transcript} "Removed usercategory $catname.\n\n"; delete $u->{"categories"}->{$catname}; @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}}; } @@ -371,12 +341,12 @@ END $ref = $clonebugs{$ref}; } if ($user eq "") { - &transcript("No valid user selected\n"); + print {$transcript} "No valid user selected\n"; $errors++; $indicated_user = 1; } elsif (&setbug) { if (not $indicated_user and defined $user) { - &transcript("User is $user\n"); + print {$transcript} "User is $user\n"; $indicated_user = 1; } &nochangebug; @@ -392,7 +362,7 @@ END } } if (@badtags) { - &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n"); + print {$transcript} "Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n"; $errors++; } for my $t (keys %chtags) { @@ -410,22 +380,22 @@ END $ut{$t} = [ sort { $a <=> $b } (keys %res) ]; } if (@oldtags == 0) { - &transcript("There were no usertags set.\n"); + print {$transcript} "There were no usertags set.\n"; } else { - &transcript("Usertags were: " . join(" ", @oldtags) . ".\n"); + print {$transcript} "Usertags were: " . join(" ", @oldtags) . ".\n"; } - &transcript("Usertags are now: " . join(" ", @newtags) . ".\n"); + print {$transcript} "Usertags are now: " . join(" ", @newtags) . ".\n"; Debbugs::User::write_usertags(\%ut, $user); } } elsif (!$control) { - &transcript(<= 3) { - &transcript("Too many unknown commands, stopping here.\n\n"); + print {$transcript} "Too many unknown commands, stopping here.\n\n"; last; } #### "developer only" ones start here @@ -435,9 +405,9 @@ END $bug_affected{$ref}=1; $version= $2; if (&setbug) { - &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n"); + print {$transcript} "'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n"; if (length($data->{done}) and not defined($version)) { - &transcript("$gBug is already closed, cannot re-close.\n\n"); + print {$transcript} "$gBug is already closed, cannot re-close.\n\n"; &nochangebug; } else { $action= "$gBug " . @@ -519,10 +489,10 @@ END $bug_affected{$ref}=1; if (&setbug) { if (@{$data->{fixed_versions}}) { - &transcript("'reopen' may be inappropriate when a bug has been closed with a version;\nyou may need to use 'found' to remove fixed versions.\n"); + print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\nyou may need to use 'found' to remove fixed versions.\n"; } if (!length($data->{done})) { - &transcript("$gBug is already open, cannot reopen.\n\n"); + print {$transcript} "$gBug is already open, cannot reopen.\n\n"; &nochangebug; } else { $action= @@ -544,7 +514,7 @@ END $version= $2; if (&setbug) { if (!length($data->{done}) and not defined($version)) { - &transcript("$gBug is already open, cannot reopen.\n\n"); + print {$transcript} "$gBug is already open, cannot reopen.\n\n"; $errors++; &nochangebug; } else { @@ -651,11 +621,11 @@ END $data->{originator}= $newsubmitter; $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter."; &savebug; - &transcript("$action\n"); + print {$transcript} "$action\n"; if (length($data->{done})) { - &transcript("(By the way, that $gBug is currently marked as done.)\n"); + print {$transcript} "(By the way, that $gBug is currently marked as done.)\n"; } - &transcript("\n"); + print {$transcript} "\n"; $message= <{forwarded})) { - &transcript("$gBug is not marked as having been forwarded.\n\n"); + print {$transcript} "$gBug is not marked as having been forwarded.\n\n"; &nochangebug; } else { $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}."; @@ -780,9 +750,9 @@ END } if (&setbug) { if ($data->{keywords} eq '') { - &transcript("There were no tags set.\n"); + print {$transcript} "There were no tags set.\n"; } else { - &transcript("Tags were: $data->{keywords}\n"); + print {$transcript} "Tags were: $data->{keywords}\n"; } if ($addsub eq "set") { $action= "Tags set to: " . join(", ", @okaytags); @@ -854,16 +824,16 @@ END } } if (@badblockers) { - &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n"); + print {$transcript} "Unknown blocking bug/s: ".join(', ', @badblockers).".\n"; $errors++; } $ref=$bugnum; if (&setbug) { if ($data->{blockedby} eq '') { - &transcript("Was not blocked by any bugs.\n"); + print {$transcript} "Was not blocked by any bugs.\n"; } else { - &transcript("Was blocked by: $data->{blockedby}\n"); + print {$transcript} "Was blocked by: $data->{blockedby}\n"; } if ($addsub eq "set") { $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers); @@ -929,11 +899,11 @@ END $data->{subject}= $newtitle; $action= "Changed $gBug title to `$newtitle' from `$oldtitle'."; &savebug; - &transcript("$action\n"); + print {$transcript} "$action\n"; if (length($data->{done})) { - &transcript("(By the way, that $gBug is currently marked as done.)\n"); + print {$transcript} "(By the way, that $gBug is currently marked as done.)\n"; } - &transcript("\n"); + print {$transcript} "\n"; } else { &cancelbug; } @@ -946,7 +916,7 @@ END $bug_affected{$ref} = 1; if (&setbug) { if (!length($data->{mergedwith})) { - &transcript("$gBug is not marked as being merged with any others.\n\n"); + print {$transcript} "$gBug is not marked as being merged with any others.\n\n"; &nochangebug; } else { $mergelowstate eq 'locked' || die "$mergelowstate ?"; @@ -1016,7 +986,7 @@ END $data->{fixed_versions}= [sort keys %fixed]; &savebug; } - &transcript("$action\n\n"); + print {$transcript} "$action\n\n"; } &endmerge; } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) { @@ -1079,7 +1049,7 @@ END @{$data}{@field_list} = @{$master_bug_data}{@field_list}; &savebug; } - &transcript("$action\n\n"); + print {$transcript} "$action\n\n"; } &endmerge; } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) { @@ -1093,13 +1063,13 @@ END $bug_affected{$ref} = 1; if (&setbug) { if (length($data->{mergedwith})) { - &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n"); + print {$transcript} "$gBug is marked as being merged with others. Use an existing clone.\n\n"; $errors++; &nochangebug; } else { &filelock("nextnumber.lock"); - open(N,"nextnumber") || &quit("nextnumber: read: $!"); - $v=; $v =~ s/\n$// || &quit("nextnumber bad format"); + open(N,"nextnumber") || die "nextnumber: read: $!"; + $v=; $v =~ s/\n$// || die "nextnumber bad format"; $firstref= $v+0; $v += $newbugsneeded; open(NN,">nextnumber"); print NN "$v\n"; close(NN); &unfilelock; @@ -1155,7 +1125,7 @@ END join(" ", keys(%limit_pkgs)) . "\n\n"); } else { %limit_pkgs = (); - &transcript("Not ignoring any bugs.\n\n"); + print {$transcript} "Not ignoring any bugs.\n\n"; } } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) : m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) { @@ -1190,7 +1160,7 @@ END $data->{owner} = ''; } while (&getnextbug); } else { - &transcript("$gBug is not marked as having an owner.\n\n"); + print {$transcript} "$gBug is not marked as having an owner.\n\n"; &nochangebug; } } @@ -1198,10 +1168,9 @@ END $ok++; $ref = $1; $bug_affected{$ref} = 1; - my $transcript; eval { bug_unarchive(bug => $ref, - transcript => \$transcript, + transcript => $transcript, affected_bugs => \%bug_affected, requester => $header{from}, request_addr => $controlrequestaddr, @@ -1211,53 +1180,41 @@ END if ($@) { $errors++; } - transcript($transcript."\n"); } elsif (m/^archive\s+#?(\d+)$/i) { $ok++; $ref = $1; $bug_affected{$ref} = 1; - if (&setbug) { - if (exists $data->{unarchived}) { - my $transcript; - nochangebug(); - eval { - bug_archive(bug => $ref, - transcript => \$transcript, - ignore_time => 1, - affected_bugs => \%bug_affected, - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - ); - }; - if ($@) { - $errors++; - } - transcript($transcript."\n"); - } - else { - transcript("$gBug $ref has not been archived previously\n\n"); - nochangebug(); - $errors++; - } + eval { + bug_archive(bug => $ref, + transcript => \$transcript, + ignore_time => 1, + archive_unarchived => 0, + affected_bugs => \%bug_affected, + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + ); + }; + if ($@) { + $errors++; } } else { - &transcript("Unknown command or malformed arguments to command.\n\n"); + print {$transcript} "Unknown command or malformed arguments to command.\n\n"; $errors++; if (++$unknowns >= 5) { - &transcript("Too many unknown commands, stopping here.\n\n"); + print {$transcript} "Too many unknown commands, stopping here.\n\n"; last; } } } if ($procline>$#bodylines) { - &transcript(">\nEnd of message, stopping processing here.\n\n"); + print {$transcript} ">\nEnd of message, stopping processing here.\n\n"; } if (!$ok && !quickabort) { $errors++; - &transcript("No commands successfully parsed; sending the help text(s).\n"); + print {$transcript} "No commands successfully parsed; sending the help text(s).\n"; &sendhelp; - &transcript("\n"); + print {$transcript} "\n"; } &transcript("MC\n") if $dl>1; @@ -1328,7 +1285,7 @@ END $repliedshow= join(', ',$replyto,@maintccaddrs); # -1 is the service.in log &filelock("lock/-1"); -open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!"); +open(AP,">>db-h/-1.log") || die "open db-h/-1.log: $!"; print(AP "\2\n$repliedshow\n\5\n$reply\n\3\n". "\6\n". @@ -1336,14 +1293,14 @@ print(AP html_escape($header{'from'})."\n". "to ".html_escape($controlrequestaddr)."\n". "\3\n". - "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/-1.log: $!"); -close(AP) || &quit("open db-h/-1.log: $!"); + "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/-1.log: $!"; +close(AP) || die "open db-h/-1.log: $!"; &unfilelock; utime(time,time,"db-h"); &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc); -unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!"); +unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!"; sub sendmailmessage { local ($message,@recips) = @_; @@ -1400,7 +1357,7 @@ sub sendhelp { } #sub unimplemented { -# &transcript("Sorry, command $_[0] not yet implemented.\n\n"); +# print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n"; #} sub checkmatch { @@ -1424,7 +1381,7 @@ sub checkmatch { sub checkpkglimit { if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) { - &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n"); + print {$transcript} "$gBug number $ref belongs to package $data->{package}, skipping.\n\n"; $errors++; return 0; } @@ -1523,7 +1480,7 @@ sub getnextbug { &savebug; if (!$manybugs || !@thisbugmergelist) { length($action) || die; - &transcript("$action\n$extramessage\n"); + print {$transcript} "$action\n$extramessage\n"; &endmerge if $manybugs; $state= 'idle'; &dlex("getnextbug => 0"); @@ -1616,17 +1573,12 @@ sub savebug { sub dlen { return if !$dl; - &transcript("C> @_ ($state $lowstate $mergelowstate)\n"); + print {$transcript} "C> @_ ($state $lowstate $mergelowstate)\n"; } sub dlex { return if !$dl; - &transcript("R> @_ ($state $lowstate $mergelowstate)\n"); -} - -sub transcript { - print $_[0] if $debug; - $transcript.= $_[0]; + print {$transcript} "R> @_ ($state $lowstate $mergelowstate)\n"; } sub urlsanit { @@ -1640,23 +1592,23 @@ sub urlsanit { sub sendlynxdoc { &sendlynxdocraw; - &transcript("\n"); + print {$transcript} "\n"; $ok++; } sub sendtxthelp { &sendtxthelpraw; - &transcript("\n"); + print {$transcript} "\n"; $ok++; } sub sendtxthelpraw { local ($relpath,$description) = @_; $doc=''; - open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!"); + open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!"; while() { $doc.=$_; } close(D); - &transcript("Sending $description in separate message.\n"); + print {$transcript} "Sending $description in separate message.\n"; &sendmailmessage(<&1 |") || &quit("fork for lynx: $!"); + open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || die "fork for lynx: $!"; while() { $doc.=$_; } $!=0; close(L); if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) { @@ -1682,9 +1634,9 @@ sub sendlynxdocraw { "perhaps the $gBug does not exist or is not on the WWW yet.\n"); $ok++; } elsif ($?) { - &transcript("Error getting $description (code $? $!):\n$doc\n"); + print {$transcript} "Error getting $description (code $? $!):\n$doc\n"; } else { - &transcript("Sending $description.\n"); + print {$transcript} "Sending $description.\n"; &sendmailmessage(< \@_, + spec => {recipients => {type => HASHREF, + }, + bug_num => {type => SCALAR, + regex => qr/^\d*$/, + default => '', + }, + reason => {type => SCALAR, + default => '', + }, + address => {type => SCALAR|ARRAYREF, + }, + type => {type => SCALAR, + default => 'cc', + regex => qr/^b?cc/i, + }, + }, + ) + for my $addr (make_list($param{address})) { + if (lc($param{type}) eq 'bcc' and + exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} + ) { + next; + } + $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} = $param{type}; + } } sub addmaintainers { # Data structure is: # maintainer email address &c -> assoc of packages -> assoc of bug#'s - my $data = shift; + my %param = validate_with(params => \@_, + spec => {data => {type => HASHREF, + }, + recipients => {type => HASHREF, + }, + } + ); my ($p, $addmaint); - &ensuremaintainersloaded; - $anymaintfound=0; $anymaintnotfound=0; - for $p (split(m/[ \t?,():]+/, $data->{package})) { + my $anymaintfound=0; my $anymaintnotfound=0; + for my $p (splitpackages($param{data}{package})) { $p =~ y/A-Z/a-z/; $p =~ /([a-z0-9.+-]+)/; $p = $1; next unless defined $p; - if (defined $gSubscriptionDomain) { - if (defined($pkgsrc{$p})) { - addbcc("$pkgsrc{$p}\@$gSubscriptionDomain"); - } else { - addbcc("$p\@$gSubscriptionDomain"); - } + if (defined $config{subscription_domain}) { + my @source_packages = binarytosource($p); + if (@source_packages) { + for my $source (@source_packages) { + add_recipients(recipients => $param{recipients}, + addrs => "$source\@".$config{subscription_domain}, + type => 'bcc', + ); + } + } + else { + add_recipients(recipients => $param{recipients}, + addrs => "$p\@".$config{subscription_domain}, + type => 'bcc', + ); + } } - if (defined $data->{severity} and defined $gStrongList and - isstrongseverity($data->{severity})) { - addbcc("$gStrongList\@$gListDomain"); + if (defined $param{data}{severity} and defined $config{strong_list} and + isstrongseverity($param{data}{severity})) { + add_recipients(recipients => $param{recipients}, + addrs => "$config{strong_list}\@".$config{list_domain}, + type => 'bcc', + ); } - if (defined($maintainerof{$p})) { - $addmaint= $maintainerof{$p}; + if (defined(getmaintainers->{$p})) { + $addmaint= getmaintainers->{$p}; &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2; - $maintccreasons{$addmaint}{$p}{$ref}= 1; - print "maintainer add >$p|$addmaint<\n" if $debug; + add_recipients(recipients => $param{recipients}, + addrs => $addmaint, + reason => $p, + bug_num => $param{data}{bug_num}, + type => 'cc', + ); + print "maintainer add >$p|$addmaint<\n" if $debug; } else { print "maintainer none >$p<\n" if $debug; - &transcript("Warning: Unknown package '$p'\n"); + print {$transcript} "Warning: Unknown package '$p'\n"; &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2; - $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1; + add_recipients(recipients => $param{recipients}, + addrs => $config{unknown_maintainer_email}, + reason => $p, + bug_num => $param{data}{bug_num}, + type => 'cc', + ) + if defined $config{unknown_maintainer_email} and + length $config{unknown_maintainer_email}; } } - if (length $data->{owner}) { - $addmaint = $data->{owner}; - &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2; - $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1; - print "owner add >$data->{package}|$addmaint<\n" if $debug; + if (length $param{data}{owner}) { + $addmaint = $param{data}{owner}; + &transcript("MO|$addmaint|$param{data}{package}|$ref|\n") if $dl>2; + add_recipients(recipients => $param{recipients}, + addrs => $addmaint, + reason => $p, + bug_num => $param{data}{bug_num}, + type => 'cc', + ); + print "owner add >$param{data}{package}|$addmaint<\n" if $debug; } } -sub ensuremaintainersloaded { - my ($a,$b); - return if $maintainersloaded++; - open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!"); - while () { - m/^\n$/ && next; - m/^\s*$/ && next; - m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'"); - $a= $1; $b= $2; $a =~ y/A-Z/a-z/; - $maintainerof{$a}= $2; - } - close(MAINT); - open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!"); - while () { - m/^\n$/ && next; - m/^\s*$/ && next; - m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'"); - $a= $1; $b= $2; $a =~ y/A-Z/a-z/; - $maintainerof{$a}= $2; - } - - open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!"); - while () { - next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/; - my ($a, $b) = ($1, $2); - $pkgsrc{lc($a)} = $b; - } - close(SOURCES); -} sub sendinfo { local ($wherefrom,$path,$description) = @_; if ($wherefrom eq "ftp.d.o") { - $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!"); + $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or die "fork for lynx/gunzip: $!"; $! = 0; if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) { - &transcript("$description is not available.\n"); + print {$transcript} "$description is not available.\n"; $ok++; return; } elsif ($?) { - &transcript("Error getting $description (code $? $!):\n$doc\n"); + print {$transcript} "Error getting $description (code $? $!):\n$doc\n"; return; } } elsif ($wherefrom eq "local") { @@ -1796,10 +1778,10 @@ sub sendinfo { $doc = do { local $/;

}; close P; } else { - &transcript("internal errror: info files location unknown.\n"); + print {$transcript} "internal errror: info files location unknown.\n"; $ok++; return; } - &transcript("Sending $description.\n"); + print {$transcript} "Sending $description.\n"; &sendmailmessage(<