X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scripts%2Fservice;h=10fbbc0a2488c3abc6f772e790bb2e0b5231e21f;hb=fd28ccea72e13b7e2dd7323af7c0cbaad9bb6663;hp=05925d2723cf1b56a94f07e81586bbe29c447e5a;hpb=90b39e8c4b91cb1e21df851d136085a1237243b8;p=debbugs.git diff --git a/scripts/service b/scripts/service index 05925d2..10fbbc0 100755 --- a/scripts/service +++ b/scripts/service @@ -4,86 +4,83 @@ # Usage: service .nn # Temps: incoming/P.nn +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 Debbugs::MIME qw(decode_rfc1522 encode_rfc1522); + +use Params::Validate qw(:types validate_with); + +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 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::Config qw(:globals :config); +use Debbugs::Status qw(splitpackages); + 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 Mail::RFC822::Address; +use Scalar::Util qw(looks_like_number); -$lib_path = $gLibPath; -require "$lib_path/errorlib"; -$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'}; +use List::Util qw(first); -chdir("$gSpoolDir") || die "chdir spool: $!\n"; +use Mail::RFC822::Address; +use Encode qw(decode encode); -# open(DEBUG,">&4"); -open DEBUG, ">/dev/null"; -$debug = 0; +chdir($config{spool_dir}) or + die "Unable to chdir to spool_dir '$config{spool_dir}': $!"; + +my $debug = 0; umask(002); -$_=shift; -m/^[RC]\.\d+$/ || &quit("bad argument"); -$control= m/C/; -$nn= $_; +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")) { - $_=$!.''; 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, $_; - } - - @bodylines = @msg[$i..$#msg]; -} +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; @@ -96,19 +93,8 @@ for (@headerlines) { print "!>$_<\n" if $debug; } } - -# 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; -} +$header{'message-id'} ||= ''; +$header{subject} ||= ''; grep(s/\s+$//,@bodylines); @@ -118,11 +104,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 +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; -$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 = ''; +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, + ); + +my $state= 'idle'; +my $lowstate= 'idle'; +my $mergelowstate= 'idle'; +my $midix=0; my $user = $replyto; $user =~ s/,.*//; @@ -152,39 +162,62 @@ 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; -} +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++) { - $state eq 'idle' || print "$state ?\n"; - $lowstate eq 'idle' || print "$lowstate ?\n"; - $mergelowstate eq 'idle' || print "$mergelowstate ?\n"; + 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"; if ($quickabort) { - &transcript("Stopping processing here.\n\n"); + print {$transcript} "Stopping processing here.\n\n"; last; } $_= $bodylines[$procline]; s/\s+$//; + # Remove BOM markers from UTF-8 strings + # Fixes #488554 + s/\xef\xbb\xbf//g; next unless m/\S/; - &transcript("> $_\n"); + 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) { - &transcript("Stopping processing here.\n\n"); + 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; - &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"); @@ -193,15 +226,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) { @@ -209,55 +242,55 @@ 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++; } 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) { + } 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") { &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 +354,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; @@ -332,12 +366,15 @@ END push @{$cats[-1]->{"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; @@ -353,46 +390,51 @@ 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}}; } $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}; } if ($user eq "") { - &transcript("No valid user selected\n"); + 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) { - &transcript("User is $user\n"); + 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) { - &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,943 +452,115 @@ 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"); - 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) { - &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"); - &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}}) { - &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"); - &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)) { - &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; - &transcript("$action\n"); - if (length($data->{done})) { - &transcript("(By the way, that $gBug is currently marked as done.)\n"); - } - &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})) { - &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 '') { - &transcript("There were no tags set.\n"); - } else { - &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) { - &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"); - } else { - &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; - &transcript("$action\n"); - if (length($data->{done})) { - &transcript("(By the way, that $gBug is currently marked as done.)\n"); - } - &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})) { - &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; - } - &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; - } - &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})) { - &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"); - $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 = (); - &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 { - &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; - my $transcript; - eval { - bug_unarchive(bug => $ref, - transcript => \$transcript, - affected_bugs => \%bug_affected, - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - ); - }; - 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++; - } - } } else { - &transcript("Unknown command or malformed arguments to command.\n\n"); + print {$transcript} "Unknown command or malformed arguments to command.\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) { +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"); -} - -&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"; + print {$transcript} "\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") || &quit("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") || &quit("writing db-h/-1.log: $!"); -close(AP) || &quit("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") || &quit("unlinking incoming/P$nn: $!"); +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, @@ -1360,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]); + Debbugs::CGI::bug_links(bug=>$_[0], + links_only => 1, + ); } }; return fill_in_template(template => $template, @@ -1394,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 { -# &transcript("Sorry, command $_[0] not yet implemented.\n\n"); +# 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". @@ -1416,15 +636,15 @@ 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; } } 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; } @@ -1462,6 +682,8 @@ sub manipset { # (modify s_* variables) # } while (getnextbug); +our $manybugs; + sub nochangebug { &dlen("nochangebug"); $state eq 'single' || $state eq 'multiple' || die "$state ?"; @@ -1471,6 +693,9 @@ sub nochangebug { &dlex("nochangebug"); } +our $sref; +our @thisbugmergelist; + sub setbug { &dlen("setbug $ref"); if ($ref =~ m/^-\d+/) { @@ -1523,7 +748,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"); @@ -1554,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"); @@ -1616,17 +841,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 +860,30 @@ sub urlsanit { sub sendlynxdoc { &sendlynxdocraw; - &transcript("\n"); + print {$transcript} "\n"; $ok++; } sub sendtxthelp { &sendtxthelpraw; - &transcript("\n"); + print {$transcript} "\n"; $ok++; } + +our $doc; sub sendtxthelpraw { - local ($relpath,$description) = @_; + my ($relpath,$description) = @_; $doc=''; - open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!"); + 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); - &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/) { - &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 ($?) { - &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(< assoc of packages -> assoc of bug#'s - my $data = shift; - my ($p, $addmaint); - &ensuremaintainersloaded; - $anymaintfound=0; $anymaintnotfound=0; - for $p (split(m/[ \t?,():]+/, $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 $data->{severity} and defined $gStrongList and - isstrongseverity($data->{severity})) { - addbcc("$gStrongList\@$gListDomain"); - } - if (defined($maintainerof{$p})) { - $addmaint= $maintainerof{$p}; - &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2; - $maintccreasons{$addmaint}{$p}{$ref}= 1; - print "maintainer add >$p|$addmaint<\n" if $debug; - } else { - print "maintainer none >$p<\n" if $debug; - &transcript("Warning: Unknown package '$p'\n"); - &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2; - $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1; - } - } - - 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; - } -} - -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) = @_; + 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 &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 +945,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(<