X-Git-Url: https://git.donarmstrong.com/?p=debbugs.git;a=blobdiff_plain;f=scripts%2Fservice;h=0059ef76df79bd1d5811163611bcc2219d7d6134;hp=d4b3e062341173cd9aad957c502e2a82711200d6;hb=611a4b401fce2979a485476787afb136acf86af9;hpb=058e14633f72c9e83358ef38b61e51326808a377 diff --git a/scripts/service b/scripts/service index d4b3e06..0059ef7 100755 --- a/scripts/service +++ b/scripts/service @@ -7,36 +7,54 @@ use warnings; use strict; +use locale; +use POSIX qw(strftime locale_h); +setlocale(LC_TIME, "C"); + +use Debbugs::Config qw(:globals :config); + use File::Copy; use MIME::Parser; use Params::Validate qw(:types validate_with); -use Debbugs::Common qw(:util :quit :misc :lock) +use Debbugs::Common qw(:util :quit :misc :lock); + +use Debbugs::Status qw(:read :status :write :versions :hook); +use Debbugs::Packages qw(binary_to_source); -use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522); +use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522 create_mime_message); use Debbugs::Mail qw(send_mail_message); use Debbugs::User; +use Debbugs::Recipients qw(:all); 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); +use Debbugs::Control qw(:all); +use Debbugs::Control::Service qw(:all); use Debbugs::Log qw(:misc); use Debbugs::Text qw(:templates); +use Scalar::Util qw(looks_like_number); + +use List::Util qw(first); + use Mail::RFC822::Address; +use Encode qw(decode encode); -chdir($config{spoool_dir}) or +chdir($config{spool_dir}) or die "Unable to chdir to spool_dir '$config{spool_dir}': $!"; my $debug = 0; umask(002); -my ($control, $nn) = $ARGV[0] =~ m/^([RC])\.(\d+)$/ || die "bad argument"; +my ($nn,$control) = $ARGV[0] =~ m/^(([RC])\.\d+)$/; +if (not defined $control or not defined $nn) { + die "Bad argument to service.in"; +} if (!rename("incoming/G$nn","incoming/P$nn")) { defined $! and $! =~ m/no such file or directory/i and exit 0; die "Failed to rename incoming/G$nn to incoming/P$nn: $!"; @@ -62,7 +80,7 @@ my $parse_output = Debbugs::MIME::parse(join('',@log)); @headerlines = @{$parse_output->{header}}; @bodylines = @{$parse_output->{body}}; - +my %header; for (@headerlines) { $_ = decode_rfc1522($_); s/\n\s/ /g; @@ -75,6 +93,8 @@ for (@headerlines) { print "!>$_<\n" if $debug; } } +$header{'message-id'} ||= ''; +$header{subject} ||= ''; grep(s/\s+$//,@bodylines); @@ -98,19 +118,39 @@ 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; -my $controlrequestaddr= ($control ? 'control' : 'request').$config{email_domain}; +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"; +open my $transcript, ">:scalar:utf8", \$transcript_scalar or + die "Unable to create transcript scalar: $!"; +print {$transcript} "Processing commands for $controlrequestaddr:\n\n"; + + +my $dl = 0; +my %affected_packages; +my %recipients; +# this is the hashref which is passed to all control calls +my %limit = (); + + +my @common_control_options = + (transcript => $transcript, + requester => $header{from}, + request_addr => $controlrequestaddr, + request_msgid => $header{'message-id'}, + request_subject => $header{subject}, + request_nn => $nn, + request_replyto => $replyto, + message => \@log, + affected_bugs => \%bug_affected, + affected_packages => \%affected_packages, + recipients => \%recipients, + limit => \%limit, + ); -# debug level -my $dl= 0; my $state= 'idle'; my $lowstate= 'idle'; my $mergelowstate= 'idle'; my $midix=0; -my $extras=""; my $user = $replyto; $user =~ s/,.*//; @@ -132,11 +172,24 @@ my %limit_pkgs = (); my %clonebugs = (); my %bcc = (); -sub addbcc { - push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc; -} +our $data; +our $message; +our $extramessage; +our $ref; + +our $mismatch; +our $action; + + +my $ok = 0; +my $unknowns = 0; +my $procline=0; for ($procline=0; $procline<=$#bodylines; $procline++) { + my $noriginator; + my $newsubmitter; + my $oldsubmitter; + my $newowner; $state eq 'idle' || print "state: $state ?\n"; $lowstate eq 'idle' || print "lowstate: $lowstate ?\n"; $mergelowstate eq 'idle' || print "mergelowstate: $mergelowstate ?\n"; @@ -145,16 +198,26 @@ for ($procline=0; $procline<=$#bodylines; $procline++) { last; } $_= $bodylines[$procline]; s/\s+$//; + # Remove BOM markers from UTF-8 strings + # Fixes #488554 + s/\xef\xbb\xbf//g; next unless m/\S/; + eval { + my $temp = decode("utf8",$_,Encode::FB_CROAK); + $_ = $temp; + }; 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) { + if (m/^(?:stop|quit|--|thank(?:s|\s*you)?|kthxbye)\.*\s*$/i) { print {$transcript} "Stopping processing here.\n\n"; last; } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) { $dl= $1+0; - print {$transcript} "Debug level $dl.\n\n"; + if ($dl > 0 and not grep /debug/,@common_control_options) { + push @common_control_options,(debug => $transcript); + } + 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"); @@ -179,12 +242,12 @@ for ($procline=0; $procline<=$#bodylines; $procline++) { } elsif (m/^index(\s+|-)maints?$/i) { &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers'); } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) { - $maint = $2; + my $maint = $2; &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint), "$gBug list for maintainer \`$maint'"); $ok++; } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) { - $package = $+; + my $package = $+; &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package), "$gBug list for package $package"); $ok++; @@ -200,12 +263,12 @@ for ($procline=0; $procline<=$#bodylines; $procline++) { 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) { + } elsif (m/^getinfo\s+([\w.-]+)$/i) { # the following is basically a Debian-specific kludge, but who cares - $req = $1; + my $req = $1; if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") { &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file"); - } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) { + } elsif ($req =~ /^override\.(\w+)\.([\w.-]+)$/i) { $req =~ s/.gz$//; &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution"); } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") { @@ -222,7 +285,7 @@ for ($procline=0; $procline<=$#bodylines; $procline++) { } elsif (m/^subscribe/i) { print {$transcript} <{"ttl"}}, $desc; push @ords, "$ord $catsec"; } else { - @cats[-1]->{"def"} = $desc; + $cats[-1]->{"def"} = $desc; push @ords, "$ord DEF"; $catsec--; } - @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b"; - $a1 <=> $b1 || $a2 <=> $b2; } @ords; + @ords = sort { + my ($a1, $a2, $b1, $b2) = split / /, "$a $b"; + ((looks_like_number($a1) and looks_like_number($a2))?$a1 <=> $b1:$a1 cmp $b1) || + ((looks_like_number($a2) and looks_like_number($b2))?$a2 <=> $b2:$a2 cmp $b2); + } @ords; $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords]; } elsif ($o eq "*") { $catsec = 0; @@ -336,7 +403,9 @@ END $u->write(); } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) { $ok++; - $ref = $1; $addsubcode = $3 || "+"; $tags = $4; + $ref = $1; + my $addsubcode = $3 || "+"; + my $tags = $4; if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) { $ref = $clonebugs{$ref}; } @@ -344,22 +413,25 @@ END print {$transcript} "No valid user selected\n"; $errors++; $indicated_user = 1; - } elsif (&setbug) { + } elsif (check_limit(data => read_bug(bug => $ref), + limit => \%limit, + transcript => $transcript)) { if (not $indicated_user and defined $user) { print {$transcript} "User is $user\n"; $indicated_user = 1; } - &nochangebug; my %ut; Debbugs::User::read_usertags(\%ut, $user); my @oldtags = (); my @newtags = (); my @badtags = (); my %chtags; - for my $t (split /[,\s]+/, $tags) { - if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) { - $chtags{$t} = 1; - } else { - push @badtags, $t; - } + if (defined $tags and length $tags) { + for my $t (split /[,\s]+/, $tags) { + if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) { + $chtags{$t} = 1; + } else { + push @badtags, $t; + } + } } if (@badtags) { print {$transcript} "Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n"; @@ -393,813 +465,24 @@ Unknown command or malformed arguments to command. (Use control\@$gEmailDomain to manipulate reports.) END - $errors++; - if (++$unknowns >= 3) { - print {$transcript} "Too many unknown commands, stopping here.\n\n"; - last; - } -#### "developer only" ones start here - } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) { - $ok++; - $ref= $1; - $bug_affected{$ref}=1; - $version= $2; - if (&setbug) { - print {$transcript} "'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n"; - if (length($data->{done}) and not defined($version)) { - print {$transcript} "$gBug is already closed, cannot re-close.\n\n"; - &nochangebug; - } else { - $action= "$gBug " . - (defined($version) ? - "marked as fixed in version $version" : - "closed") . - ", send any further explanations to $data->{originator}"; - do { - &addmaintainers($data); - if ( length( $gDoneList ) > 0 && length( $gListDomain ) > - 0 ) { &addccaddress("$gDoneList\@$gListDomain"); } - $data->{done}= $replyto; - my @keywords= split ' ', $data->{keywords}; - if (grep $_ eq 'pending', @keywords) { - $extramessage= "Removed pending tag.\n"; - $data->{keywords}= join ' ', grep $_ ne 'pending', - @keywords; - } - addfixedversions($data, $data->{package}, $version, 'binary'); - - $message= <{originator} -Subject: $gBug#$ref acknowledged by developer - ($header{'subject'}) -References: $header{'message-id'} $data->{msgid} -In-Reply-To: $data->{msgid} -Message-ID: -Reply-To: $ref\@$gEmailDomain -X-$gProject-PR-Message: they-closed-control $ref - -This is an automatic notification regarding your $gBug report -#$ref: $data->{subject}, -which was filed against the $data->{package} package. - -It has been marked as closed by one of the developers, namely -$replyto. - -You should be hearing from them with a substantive response shortly, -in case you haven't already. If not, please contact them directly. - -$gMaintainer -(administrator, $gProject $gBugs database) - -END - &sendmailmessage($message,$data->{originator}); - } while (&getnextbug); - } - } - } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) { - $ok++; - $ref= $1; $newpackage= $2; - $bug_affected{$ref}=1; - $version= $3; - $newpackage =~ y/A-Z/a-z/; - if (&setbug) { - if (length($data->{package})) { - $action= "$gBug reassigned from package \`$data->{package}'". - " to \`$newpackage'."; - } else { - $action= "$gBug assigned to package \`$newpackage'."; - } - do { - &addmaintainers($data); - $data->{package}= $newpackage; - $data->{found_versions}= []; - $data->{fixed_versions}= []; - # TODO: what if $newpackage is a source package? - addfoundversions($data, $data->{package}, $version, 'binary'); - &addmaintainers($data); - } while (&getnextbug); - } - } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) : - m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) : - m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) : - m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) { - $ok++; - $ref= $1; - $bug_affected{$ref}=1; - if (&setbug) { - if (@{$data->{fixed_versions}}) { - 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})) { - print {$transcript} "$gBug is already open, cannot reopen.\n\n"; - &nochangebug; - } else { - $action= - $noriginator eq '' ? "$gBug reopened, originator not changed." : - "$gBug reopened, originator set to $noriginator."; - do { - &addmaintainers($data); - $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator; - $data->{fixed_versions}= []; - $data->{done}= ''; - } while (&getnextbug); - } - } - } elsif (m{^found\s+\#?(-?\d+) - (?:\s+((?:$config{package_name_re}\/)? - $config{package_version_re}))?$}ix) { - $ok++; - $ref= $1; - $version= $2; - if (&setbug) { - if (!length($data->{done}) and not defined($version)) { - print {$transcript} "$gBug is already open, cannot reopen.\n\n"; - $errors++; - &nochangebug; - } else { - $action= - defined($version) ? - "$gBug marked as found in version $version." : - "$gBug reopened."; - do { - &addmaintainers($data); - # The 'done' field gets a bit weird with version - # tracking, because a bug may be closed by multiple - # people in different branches. Until we have something - # more flexible, we set it every time a bug is fixed, - # and clear it when a bug is found in a version greater - # than any version in which the bug is fixed or when - # a bug is found and there is no fixed version - if (defined $version) { - my ($version_only) = $version =~ m{([^/]+)$}; - addfoundversions($data, $data->{package}, $version, 'binary'); - my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);} - map {s{.+/}{}; $_;} @{$data->{fixed_versions}}; - if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) { - $action = "$gBug marked as found in version $version and reopened." - if length $data->{done}; - $data->{done} = ''; - } - } else { - # Versionless found; assume old-style "not fixed at - # all". - $data->{fixed_versions} = []; - $data->{done} = ''; - } - } while (&getnextbug); - } - } - } elsif (m[^notfound\s+\#?(-?\d+)\s+ - ((?:$config{package_name_re}\/)? - \S+)\s*$]ix) { - $ok++; - $ref= $1; - $version= $2; - if (&setbug) { - $action= "$gBug no longer marked as found in version $version."; - if (length($data->{done})) { - $extramessage= "(By the way, this $gBug is currently marked as done.)\n"; - } - do { - &addmaintainers($data); - removefoundversions($data, $data->{package}, $version, 'binary'); - } while (&getnextbug); - } - } - elsif (m[^fixed\s+\#?(-?\d+)\s+ - ((?:$config{package_name_re}\/)? - $config{package_version_re})\s*$]ix) { - $ok++; - $ref= $1; - $version= $2; - if (&setbug) { - $action= - defined($version) ? - "$gBug marked as fixed in version $version." : - "$gBug reopened."; - do { - &addmaintainers($data); - addfixedversions($data, $data->{package}, $version, 'binary'); - } while (&getnextbug); - } - } - elsif (m[^notfixed\s+\#?(-?\d+)\s+ - ((?:$config{package_name_re}\/)? - \S+)\s*$]ix) { - $ok++; - $ref= $1; - $version= $2; - if (&setbug) { - $action= - defined($version) ? - "$gBug no longer marked as fixed in version $version." : - "$gBug reopened."; - do { - &addmaintainers($data); - removefixedversions($data, $data->{package}, $version, 'binary'); - } while (&getnextbug); - } - } - elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) : - m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) { - $ok++; - $ref= $1; - $bug_affected{$ref}=1; - if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) { - $ref = $clonebugs{$ref}; - } - if (not Mail::RFC822::Address::valid($newsubmitter)) { - transcript("$newsubmitter is not a valid e-mail address; not changing submitter\n"); - $errors++; - } - elsif (&getbug) { - if (&checkpkglimit) { - &foundbug; - &addmaintainers($data); - $oldsubmitter= $data->{originator}; - $data->{originator}= $newsubmitter; - $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter."; - &savebug; - print {$transcript} "$action\n"; - if (length($data->{done})) { - print {$transcript} "(By the way, that $gBug is currently marked as done.)\n"; - } - print {$transcript} "\n"; - $message= <{msgid} -In-Reply-To: $data->{msgid} -Message-ID: -Reply-To: $ref\@$gEmailDomain -X-$gProject-PR-Message: submitter-changed $ref - -The submitter address recorded for your $gBug report -#$ref: $data->{subject} -has been changed. - -The old submitter address for this report was -$oldsubmitter. -The new submitter address is -$newsubmitter. - -This change was made by -$replyto. -If it was incorrect, please contact them directly. - -$gMaintainer -(administrator, $gProject $gBugs database) - -END - &sendmailmessage($message,$oldsubmitter); - } else { - &cancelbug; - } - } else { - ¬foundbug; - } - } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) { - $ok++; - $ref= $1; $whereto= $2; - $bug_affected{$ref}=1; - if (&setbug) { - if (length($data->{forwarded})) { - $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto."; - } else { - $action= "Noted your statement that $gBug has been forwarded to $whereto."; - } - if (length($data->{done})) { - $extramessage= "(By the way, this $gBug is currently marked as done.)\n"; - } - do { - &addmaintainers($data); - if (length($gForwardList)>0 && length($gListDomain)>0 ) { - &addccaddress("$gForwardList\@$gListDomain"); - } - $data->{forwarded}= $whereto; - } while (&getnextbug); - } - } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) { - $ok++; - $ref= $1; - $bug_affected{$ref}=1; - if (&setbug) { - if (!length($data->{forwarded})) { - 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}."; - do { - &addmaintainers($data); - $data->{forwarded}= ''; - } while (&getnextbug); - } - } - } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i || - m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) { - $ok++; - $ref= $1; - $bug_affected{$ref}=1; - $newseverity= $2; - if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) { - &transcript("Severity level \`$newseverity' is not known.\n". - "Recognized are: $gShowSeverities.\n\n"); - $errors++; - } elsif (exists $gObsoleteSeverities{$newseverity}) { - &transcript("Severity level \`$newseverity' is obsolete. " . - "Use $gObsoleteSeverities{$newseverity} instead.\n\n"); - $errors++; - } elsif (&setbug) { - $printseverity= $data->{severity}; - $printseverity= "$gDefaultSeverity" if $printseverity eq ''; - $action= "Severity set to \`$newseverity' from \`$printseverity'"; - do { - &addmaintainers($data); - if (defined $gStrongList and isstrongseverity($newseverity)) { - addbcc("$gStrongList\@$gListDomain"); - } - $data->{severity}= $newseverity; - } while (&getnextbug); - } - } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) { - $ok++; - $ref = $1; $addsubcode = $3; $tags = $4; - $bug_affected{$ref}=1; - $addsub = "add"; - if (defined $addsubcode) { - $addsub = "sub" if ($addsubcode eq "-"); - $addsub = "add" if ($addsubcode eq "+"); - $addsub = "set" if ($addsubcode eq "="); - } - my @okaytags = (); - my @badtags = (); - foreach my $t (split /[\s,]+/, $tags) { - if (!grep($_ eq $t, @gTags)) { - push @badtags, $t; - } else { - push @okaytags, $t; - } - } - if (@badtags) { - &transcript("Unknown tag/s: ".join(', ', @badtags).".\n". - "Recognized are: ".join(' ', @gTags).".\n\n"); - $errors++; - } - if (&setbug) { - if ($data->{keywords} eq '') { - print {$transcript} "There were no tags set.\n"; - } else { - print {$transcript} "Tags were: $data->{keywords}\n"; - } - if ($addsub eq "set") { - $action= "Tags set to: " . join(", ", @okaytags); - } elsif ($addsub eq "add") { - $action= "Tags added: " . join(", ", @okaytags); - } elsif ($addsub eq "sub") { - $action= "Tags removed: " . join(", ", @okaytags); - } - do { - &addmaintainers($data); - $data->{keywords} = '' if ($addsub eq "set"); - # Allow removing obsolete tags. - if ($addsub eq "sub") { - foreach my $t (@badtags) { - $data->{keywords} = join ' ', grep $_ ne $t, - split ' ', $data->{keywords}; - } - } - # Now process all other additions and subtractions. - foreach my $t (@okaytags) { - $data->{keywords} = join ' ', grep $_ ne $t, - split ' ', $data->{keywords}; - $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub"); - } - $data->{keywords} =~ s/\s*$//; - } while (&getnextbug); - } - } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+(\S.*)?$/i) { - $ok++; - my $bugnum = $2; my $blockers = $4; - $addsub = "add"; - $addsub = "sub" if ($1 eq "un"); - if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) { - $bugnum = $clonebugs{$bugnum}; - } - - my @okayblockers; - my @badblockers; - foreach my $b (split /[\s,]+/, $blockers) { - $b=~s/^\#//; - if ($b=~/[0-9]+/) { - $ref=$b; - if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) { - $ref = $clonebugs{$ref}; - } - if (&getbug) { - &foundbug; - push @okayblockers, $ref; - - # add to the list all bugs that are merged with $b, - # because all of their data must be kept in sync - @thisbugmergelist= split(/ /,$data->{mergedwith}); - &cancelbug; - - foreach $ref (@thisbugmergelist) { - if (&getbug) { - push @okayblockers, $ref; - &cancelbug; - } - } - } - else { - ¬foundbug; - push @badblockers, $ref; - } - } - else { - push @badblockers, $b; - } - } - if (@badblockers) { - print {$transcript} "Unknown blocking bug/s: ".join(', ', @badblockers).".\n"; - $errors++; - } - - $ref=$bugnum; - if (&setbug) { - if ($data->{blockedby} eq '') { - print {$transcript} "Was not blocked by any bugs.\n"; - } else { - print {$transcript} "Was blocked by: $data->{blockedby}\n"; - } - if ($addsub eq "set") { - $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers); - } elsif ($addsub eq "add") { - $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers); - } elsif ($addsub eq "sub") { - $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers); - } - my %removedblocks; - my %addedblocks; - do { - &addmaintainers($data); - my @oldblockerlist = split ' ', $data->{blockedby}; - $data->{blockedby} = '' if ($addsub eq "set"); - foreach my $b (@okayblockers) { - $data->{blockedby} = manipset($data->{blockedby}, $b, - ($addsub ne "sub")); - } - - foreach my $b (@oldblockerlist) { - if (! grep { $_ eq $b } split ' ', $data->{blockedby}) { - push @{$removedblocks{$b}}, $ref; - } - } - foreach my $b (split ' ', $data->{blockedby}) { - if (! grep { $_ eq $b } @oldblockerlist) { - push @{$addedblocks{$b}}, $ref; - } - } - } while (&getnextbug); - - # Now that the blockedby data is updated, change blocks data - # to match the changes. - foreach $ref (keys %addedblocks) { - if (&getbug) { - foreach my $b (@{$addedblocks{$ref}}) { - $data->{blocks} = manipset($data->{blocks}, $b, 1); - } - &savebug; - } - } - foreach $ref (keys %removedblocks) { - if (&getbug) { - foreach my $b (@{$removedblocks{$ref}}) { - $data->{blocks} = manipset($data->{blocks}, $b, 0); - } - &savebug; - } - } - } - } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) { - $ok++; - $ref= $1; $newtitle= $2; - $bug_affected{$ref}=1; - if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) { - $ref = $clonebugs{$ref}; - } - if (&getbug) { - if (&checkpkglimit) { - &foundbug; - &addmaintainers($data); - my $oldtitle = $data->{subject}; - $data->{subject}= $newtitle; - $action= "Changed $gBug title to `$newtitle' from `$oldtitle'."; - &savebug; - print {$transcript} "$action\n"; - if (length($data->{done})) { - print {$transcript} "(By the way, that $gBug is currently marked as done.)\n"; - } - print {$transcript} "\n"; - } else { - &cancelbug; - } - } else { - ¬foundbug; - } - } elsif (m/^unmerge\s+\#?(-?\d+)$/i) { - $ok++; - $ref= $1; - $bug_affected{$ref} = 1; - if (&setbug) { - if (!length($data->{mergedwith})) { - print {$transcript} "$gBug is not marked as being merged with any others.\n\n"; - &nochangebug; - } else { - $mergelowstate eq 'locked' || die "$mergelowstate ?"; - $action= "Disconnected #$ref from all other report(s)."; - @newmergelist= split(/ /,$data->{mergedwith}); - $discref= $ref; - @bug_affected{@newmergelist} = 1 x @newmergelist; - do { - &addmaintainers($data); - $data->{mergedwith}= ($ref == $discref) ? '' - : join(' ',grep($_ ne $ref,@newmergelist)); - } while (&getnextbug); - } - } - } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) { - $ok++; - my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1); - my @newmergelist= (); - my %tags = (); - my %found = (); - my %fixed = (); - &getmerge; - while (defined($ref= shift(@tomerge))) { - &transcript("D| checking merge $ref\n") if $dl; - $ref+= 0; - if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) { - $ref = $clonebugs{$ref}; - } - next if grep($_ == $ref,@newmergelist); - if (!&getbug) { ¬foundbug; @newmergelist=(); last } - if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; } - &foundbug; - &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl; - $mismatch= ''; - &checkmatch('package','m_package',$data->{package},@newmergelist); - &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist); - $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq ''; - &checkmatch('severity','m_severity',$data->{severity},@newmergelist); - &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist); - &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist); - &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist); - &checkmatch('owner','m_owner',$data->{owner},@newmergelist); - foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; } - foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; } - foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; } - if (length($mismatch)) { - &transcript("Mismatch - only $gBugs in same state can be merged:\n". - $mismatch."\n"); - $errors++; - &cancelbug; @newmergelist=(); last; - } - push(@newmergelist,$ref); - push(@tomerge,split(/ /,$data->{mergedwith})); - &cancelbug; - } - if (@newmergelist) { - @newmergelist= sort { $a <=> $b } @newmergelist; - $action= "Merged @newmergelist."; - delete @fixed{keys %found}; - for $ref (@newmergelist) { - &getbug || die "huh ? $gBug $ref disappeared during merge"; - &addmaintainers($data); - @bug_affected{@newmergelist} = 1 x @newmergelist; - $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist)); - $data->{keywords}= join(' ', keys %tags); - $data->{found_versions}= [sort keys %found]; - $data->{fixed_versions}= [sort keys %fixed]; - &savebug; - } - print {$transcript} "$action\n\n"; - } - &endmerge; - } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) { - $ok++; - my @temp = split /\s+\#?/,$1; - my $master_bug = shift @temp; - my $master_bug_data; - my @tomerge = sort { $a <=> $b } @temp; - unshift @tomerge,$master_bug; - &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl; - my @newmergelist= (); - my %tags = (); - my %found = (); - my %fixed = (); - # Here we try to do the right thing. - # First, if the bugs are in the same package, we merge all of the found, fixed, and tags. - # If not, we discard the found and fixed. - # Everything else we set to the values of the first bug. - &getmerge; - while (defined($ref= shift(@tomerge))) { - &transcript("D| checking merge $ref\n") if $dl; - $ref+= 0; - if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) { - $ref = $clonebugs{$ref}; - } - next if grep($_ == $ref,@newmergelist); - if (!&getbug) { ¬foundbug; @newmergelist=(); last } - if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; } - &foundbug; - &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl; - $master_bug_data = $data if not defined $master_bug_data; - if ($data->{package} ne $master_bug_data->{package}) { - &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n". - "$gBug $ref is not in the same package as $master_bug\n"); - $errors++; - &cancelbug; @newmergelist=(); last; - } - for my $t (split /\s+/,$data->{keywords}) { - $tags{$t} = 1; - } - @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}}; - @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}}; - push(@newmergelist,$ref); - push(@tomerge,split(/ /,$data->{mergedwith})); - &cancelbug; - } - if (@newmergelist) { - @newmergelist= sort { $a <=> $b } @newmergelist; - $action= "Forcibly Merged @newmergelist."; - delete @fixed{keys %found}; - for $ref (@newmergelist) { - &getbug || die "huh ? $gBug $ref disappeared during merge"; - &addmaintainers($data); - @bug_affected{@newmergelist} = 1 x @newmergelist; - $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist)); - $data->{keywords}= join(' ', keys %tags); - $data->{found_versions}= [sort keys %found]; - $data->{fixed_versions}= [sort keys %fixed]; - my @field_list = qw(forwarded package severity blocks blockedby owner done); - @{$data}{@field_list} = @{$master_bug_data}{@field_list}; - &savebug; - } - print {$transcript} "$action\n\n"; - } - &endmerge; - } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) { - $ok++; - - $origref = $1; - @newclonedids = split /\s+/, $2; - $newbugsneeded = scalar(@newclonedids); - - $ref = $origref; - $bug_affected{$ref} = 1; - if (&setbug) { - if (length($data->{mergedwith})) { - 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") || 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; - - $lastref = $firstref + $newbugsneeded - 1; - - if ($newbugsneeded == 1) { - $action= "$gBug $origref cloned as bug $firstref."; - } else { - $action= "$gBug $origref cloned as bugs $firstref-$lastref."; - } - - my $blocks = $data->{blocks}; - my $blockedby = $data->{blockedby}; - - &getnextbug; - my $ohash = get_hashname($origref); - my $clone = $firstref; - @bug_affected{@newclonedids} = 1 x @newclonedids; - for $newclonedid (@newclonedids) { - $clonebugs{$newclonedid} = $clone; - - my $hash = get_hashname($clone); - copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log"); - copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status"); - copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary"); - copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report"); - &bughook('new', $clone, $data); - - # Update blocking info of bugs blocked by or blocking the - # cloned bug. - foreach $ref (split ' ', $blocks) { - &getbug; - $data->{blockedby} = manipset($data->{blockedby}, $clone, 1); - &savebug; - } - foreach $ref (split ' ', $blockedby) { - &getbug; - $data->{blocks} = manipset($data->{blocks}, $clone, 1); - &savebug; - } - - $clone++; - } - } - } - } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) { - $ok++; - my @pkgs = split /\s+/, $1; - if (scalar(@pkgs) > 0) { - %limit_pkgs = map { ($_, 1) } @pkgs; - &transcript("Ignoring bugs not assigned to: " . - join(" ", keys(%limit_pkgs)) . "\n\n"); - } else { - %limit_pkgs = (); - print {$transcript} "Not ignoring any bugs.\n\n"; + #### "developer only" ones start here + } elsif (defined valid_control($_)) { + my ($new_errors,$terminate_control) = + control_line(line => $_, + clonebugs => \%clonebugs, + limit => \%limit, + common_control_options => \@common_control_options, + errors => \$errors, + transcript => $transcript, + debug => $debug, + ok => \$ok, + replyto => $replyto, + ); + if ($terminate_control) { + last; } - } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) : - m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) { - $ok++; - $ref = $1; - $bug_affected{$ref} = 1; - if (&setbug) { - if (length $data->{owner}) { - $action = "Owner changed from $data->{owner} to $newowner."; - } else { - $action = "Owner recorded as $newowner."; - } - if (length $data->{done}) { - $extramessage = "(By the way, this $gBug is currently " . - "marked as done.)\n"; - } - do { - &addmaintainers($data); - $data->{owner} = $newowner; - } while (&getnextbug); - } - } elsif (m/^noowner\s+\#?(-?\d+)$/i) { - $ok++; - $ref = $1; - $bug_affected{$ref} = 1; - if (&setbug) { - if (length $data->{owner}) { - $action = "Removed annotation that $gBug was owned by " . - "$data->{owner}."; - do { - &addmaintainers($data); - $data->{owner} = ''; - } while (&getnextbug); - } else { - print {$transcript} "$gBug is not marked as having an owner.\n\n"; - &nochangebug; - } - } - } elsif (m/^unarchive\s+#?(\d+)$/i) { - $ok++; - $ref = $1; - $bug_affected{$ref} = 1; - eval { - bug_unarchive(bug => $ref, - transcript => $transcript, - affected_bugs => \%bug_affected, - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - ); - }; - if ($@) { - $errors++; - } - } elsif (m/^archive\s+#?(\d+)$/i) { - $ok++; - $ref = $1; - $bug_affected{$ref} = 1; - 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 { - print {$transcript} "Unknown command or malformed arguments to command.\n\n"; + print {$transcript} "Unknown command or malformed arguments to command.\n"; $errors++; if (++$unknowns >= 5) { print {$transcript} "Too many unknown commands, stopping here.\n\n"; @@ -1210,100 +493,74 @@ END if ($procline>$#bodylines) { print {$transcript} ">\nEnd of message, stopping processing here.\n\n"; } -if (!$ok && !quickabort) { +if (!$ok && !$quickabort) { $errors++; print {$transcript} "No commands successfully parsed; sending the help text(s).\n"; &sendhelp; print {$transcript} "\n"; } -&transcript("MC\n") if $dl>1; -@maintccs= (); -for $maint (keys %maintccreasons) { -&transcript("MM|$maint|\n") if $dl>1; - next if $maint eq $replyto; - $reasonstring= ''; - $reasonsref= $maintccreasons{$maint}; -&transcript("MY|$maint|\n") if $dl>2; - for $p (sort keys %$reasonsref) { -&transcript("MP|$p|\n") if $dl>2; - $reasonstring.= ', ' if length($reasonstring); - $reasonstring.= $p.' ' if length($p); - $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}})); - } - if (length($reasonstring) > 40) { - (substr $reasonstring, 37) = "..."; - } - $reasonstring = "" if (!defined($reasonstring)); - push(@maintccs,"$maint ($reasonstring)"); - push(@maintccaddrs,"$maint"); -} - -$maintccs = ""; -if (@maintccs) { - &transcript("MC|@maintccs|\n") if $dl>2; - $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n"; -} - -my %packagepr; -for my $maint (keys %maintccreasons) { - for my $package (keys %{$maintccreasons{$maint}}) { - next unless length $package; - $packagepr{$package} = 1; - } -} -my $packagepr = ''; -$packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr; - -# Add Bcc's to subscribed bugs -push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected; - +my @maintccs = determine_recipients(recipients => \%recipients, + address_only => 1, + cc => 1, + ); if (!defined $header{'subject'} || $header{'subject'} eq "") { $header{'subject'} = "your mail"; } # Error text here advertises how many errors there were -my $error_text = $errors > 0 ? " (with $errors errors)":''; - -$reply= < -Precedence: bulk -${packagepr}X-$gProject-PR-Message: transcript - -${transcript}Please contact me if you need assistance. - -$gMaintainer -(administrator, $gProject $gBugs database) -$extras -END +my $error_text = $errors > 0 ? " (with $errors error" . ($errors > 1 ? "s" : "") . ")" : ""; + +my @common_headers; +push @common_headers, 'X-Loop',$gMaintainerEmail; + +my $temp_transcript = $transcript_scalar; +eval{ + $temp_transcript = decode("utf8",$temp_transcript,Encode::FB_CROAK); +}; +my $reply = + create_mime_message([From => "$gMaintainerEmail ($gProject $gBug Tracking System)", + To => $replyto, + @maintccs ? (Cc => join(', ',@maintccs)):(), + Subject => "Processed${error_text}: $header{subject}", + 'Message-ID' => "", + 'In-Reply-To' => $header{'message-id'}, + References => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}), + Precedence => 'bulk', + keys %affected_packages ?("X-${gProject}-PR-Package" => join(' ',keys %affected_packages)):(), + keys %affected_packages ?("X-${gProject}-PR-Source" => + join(' ', + map {defined $_ ?(ref($_)?@{$_}:$_):()} + binary_to_source(binary => [keys %affected_packages], + source_only => 1))):(), + "X-$gProject-PR-Message" => 'transcript', + @common_headers, + ], + fill_template('mail/message_body', + {body => "${temp_transcript}Please contact me if you need assistance."}, + )); + +my $repliedshow= join(', ',$replyto, + determine_recipients(recipients => \%recipients, + cc => 1, + address_only => 1, + ) + ); -$repliedshow= join(', ',$replyto,@maintccaddrs); -# -1 is the service.in log -&filelock("lock/-1"); -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". - "Request received from ". - html_escape($header{'from'})."\n". - "to ".html_escape($controlrequestaddr)."\n". - "\3\n". - "\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); +&sendmailmessage($reply, + exists $header{'x-debbugs-no-ack'}?():$replyto, + make_list(values %{{determine_recipients(recipients => \%recipients, + address_only => 1, + )}} + ), + ); unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!"; sub sendmailmessage { - local ($message,@recips) = @_; + my ($message,@recips) = @_; $message = "X-Loop: $gMaintainerEmail\n" . $message; send_mail_message(message => $message, recipients => \@recips, @@ -1317,12 +574,15 @@ sub fill_template{ my $variables = {config => \%config, defined($ref)?(ref => $ref):(), defined($data)?(data => $data):(), + refs => [map {exists $clonebugs{$_}?$clonebugs{$_}:$_} keys %bug_affected], %{$extra_var}, }; my $hole_var = {'&bugurl' => sub{"$_[0]: ". - 'http://'.$config{cgi_domain}.'/'. - Debbugs::CGI::bug_url($_[0]); + $config{cgi_domain}.'/'. + Debbugs::CGI::bug_links(bug=>$_[0], + links_only => 1, + ); } }; return fill_in_template(template => $template, @@ -1351,21 +611,24 @@ sub message_body_template{ } sub sendhelp { - &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain"); - &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain") - if $control; + if ($control) { + &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain") + } + else { + &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain"); + } } #sub unimplemented { # print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n"; #} - +our %checkmatch_values; sub checkmatch { - local ($string,$mvarname,$svarvalue,@newmergelist) = @_; - local ($mvarvalue); + my ($string,$mvarname,$svarvalue,@newmergelist) = @_; + my ($mvarvalue); if (@newmergelist) { - eval "\$mvarvalue= \$$mvarname"; - &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n") + $mvarvalue = $checkmatch_values{$mvarname}; + print {$transcript} "D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n" if $dl; $mismatch .= "Values for \`$string' don't match:\n". @@ -1373,9 +636,9 @@ sub checkmatch { " #$ref has \`$svarvalue'\n" if $mvarvalue ne $svarvalue; } else { - &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n") - if $dl; - eval "\$$mvarname= \$svarvalue"; + print {$transcript} "D| setupmatch \`$string' /$mvarname/$svarvalue/\n" + if $dl; + $checkmatch_values{$mvarname} = $svarvalue; } } @@ -1419,6 +682,8 @@ sub manipset { # (modify s_* variables) # } while (getnextbug); +our $manybugs; + sub nochangebug { &dlen("nochangebug"); $state eq 'single' || $state eq 'multiple' || die "$state ?"; @@ -1428,6 +693,9 @@ sub nochangebug { &dlex("nochangebug"); } +our $sref; +our @thisbugmergelist; + sub setbug { &dlen("setbug $ref"); if ($ref =~ m/^-\d+/) { @@ -1511,8 +779,8 @@ sub getnextbug { # &transcript("$action\n\n") # endmerge -sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); } -sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); } +sub notfoundbug { print {$transcript} "$gBug number $ref not found. (Is it archived?)\n\n"; } +sub foundbug { print {$transcript} "$gBug#$ref: $data->{subject}\n"; } sub getmerge { &dlen("getmerge"); @@ -1602,9 +870,16 @@ sub sendtxthelp { $ok++; } + +our $doc; sub sendtxthelpraw { - local ($relpath,$description) = @_; + my ($relpath,$description) = @_; $doc=''; + if (not -e "$gDocDir/$relpath") { + print {$transcript} "Unfortunatly, the help text doesn't exist, so it wasn't sent.\n"; + warn "Help text $gDocDir/$relpath not found"; + return; + } open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!"; while() { $doc.=$_; } close(D); @@ -1624,14 +899,14 @@ END } sub sendlynxdocraw { - local ($relpath,$description) = @_; + my ($relpath,$description) = @_; $doc=''; - open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || die "fork for lynx: $!"; + open(L,"lynx -nolist -dump $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/) { - &transcript("Information ($description) is not available -\n". - "perhaps the $gBug does not exist or is not on the WWW yet.\n"); + print {$transcript} "Information ($description) is not available -\n". + "perhaps the $gBug does not exist or is not on the WWW yet.\n"; $ok++; } elsif ($?) { print {$transcript} "Error getting $description (code $? $!):\n$doc\n"; @@ -1652,117 +927,9 @@ END } } -sub addrecipient { - my %param = validate_width(params => \@_, - 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 %param = validate_with(params => \@_, - spec => {data => {type => HASHREF, - }, - recipients => {type => HASHREF, - }, - } - ); - my ($p, $addmaint); - 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 $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 $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(getmaintainers->{$p})) { - $addmaint= getmaintainers->{$p}; - &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2; - 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; - print {$transcript} "Warning: Unknown package '$p'\n"; - &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2; - 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 $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 sendinfo { - local ($wherefrom,$path,$description) = @_; + my ($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 die "fork for lynx/gunzip: $!"; $! = 0;