X-Git-Url: https://git.donarmstrong.com/?p=debbugs.git;a=blobdiff_plain;f=scripts%2Fservice;h=0059ef76df79bd1d5811163611bcc2219d7d6134;hp=a642aaba832f581f5120545802f7c5b13c6fc06e;hb=611a4b401fce2979a485476787afb136acf86af9;hpb=ef14d28751d8db12d45f05cb6f162fe1c5bfa4f2 diff --git a/scripts/service b/scripts/service index a642aab..0059ef7 100755 --- a/scripts/service +++ b/scripts/service @@ -7,6 +7,9 @@ use warnings; use strict; +use locale; +use POSIX qw(strftime locale_h); +setlocale(LC_TIME, "C"); use Debbugs::Config qw(:globals :config); @@ -18,8 +21,9 @@ 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); +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); @@ -30,10 +34,16 @@ use Debbugs::Status qw(splitpackages); use Debbugs::CGI qw(html_escape); 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{spool_dir}) or die "Unable to chdir to spool_dir '$config{spool_dir}': $!"; @@ -110,12 +120,33 @@ if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) { my $errors = 0; 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"; +open my $transcript, ">:scalar:utf8", \$transcript_scalar or + die "Unable to create transcript scalar: $!"; print {$transcript} "Processing commands for $controlrequestaddr:\n\n"; -# debug level + 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'; @@ -142,11 +173,6 @@ my %clonebugs = (); my %bcc = (); -my @bcc; -sub addbcc { - push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc; -} - our $data; our $message; our $extramessage; @@ -156,10 +182,6 @@ our $mismatch; our $action; -# recipients of mail -my %recipients; -# affected_packages -my %affected_packages; my $ok = 0; my $unknowns = 0; my $procline=0; @@ -176,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"); @@ -253,7 +285,7 @@ for ($procline=0; $procline<=$#bodylines; $procline++) { } elsif (m/^subscribe/i) { print {$transcript} < $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; @@ -378,12 +413,13 @@ 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 = (); @@ -429,967 +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; - my $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 { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - actions_taken => {done => 1}, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - $data->{done}= $replyto; - my @keywords= split ' ', $data->{keywords}; - my $extramessage = ''; - if (grep $_ eq 'pending', @keywords) { - $extramessage= "Removed pending tag.\n"; - $data->{keywords}= join ' ', grep $_ ne 'pending', - @keywords; - } - addfixedversions($data, $data->{package}, $version, 'binary'); - - my $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; - my $newpackage= $2; - $bug_affected{$ref}=1; - my $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 { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - $data->{package}= $newpackage; - $data->{found_versions}= []; - $data->{fixed_versions}= []; - # TODO: what if $newpackage is a source package? - addfoundversions($data, $data->{package}, $version, 'binary'); - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - } 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 { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - $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; - my $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 { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - # 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; - my $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 { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - 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; - my $version= $2; - if (&setbug) { - $action= - defined($version) ? - "$gBug marked as fixed in version $version." : - "$gBug reopened."; - do { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - addfixedversions($data, $data->{package}, $version, 'binary'); - } while (&getnextbug); - } - } - elsif (m[^notfixed\s+\#?(-?\d+)\s+ - ((?:$config{package_name_re}\/)? - \S+)\s*$]ix) { - $ok++; - $ref= $1; - my $version= $2; - if (&setbug) { - $action= - defined($version) ? - "$gBug no longer marked as fixed in version $version." : - "$gBug reopened."; - do { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - 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; - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - $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; - my $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 { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - actions_taken => {forwarded => 1}, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - $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 { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - $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; - my $newseverity= $2; - if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) { - print {$transcript} "Severity level \`$newseverity' is not known.\n". - "Recognized are: $gShowSeverities.\n\n"; - $errors++; - } elsif (exists $gObsoleteSeverities{$newseverity}) { - print {$transcript} "Severity level \`$newseverity' is obsolete. " . - "Use $gObsoleteSeverities{$newseverity} instead.\n\n"; - $errors++; - } elsif (&setbug) { - my $printseverity= $data->{severity}; - $printseverity= "$gDefaultSeverity" if $printseverity eq ''; - $action= "Severity set to \`$newseverity' from \`$printseverity'"; - do { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - 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; - my $addsubcode = $3; - my $tags = $4; - $bug_affected{$ref}=1; - my $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) { - print {$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 { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - $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; - my $addsub = "add"; - $addsub = "sub" if (defined $1 and $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 - my @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 { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - 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; my $newtitle= $2; - $bug_affected{$ref}=1; - if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) { - $ref = $clonebugs{$ref}; - } - if (&getbug) { - if (&checkpkglimit) { - &foundbug; - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - 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)."; - my @newmergelist= split(/ /,$data->{mergedwith}); - my $discref= $ref; - @bug_affected{@newmergelist} = 1 x @newmergelist; - do { - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - $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))) { - print {$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; - print {$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); - &checkmatch('summary','m_summary',$data->{summary},@newmergelist); - &checkmatch('affects','m_affects',$data->{affects},@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)) { - print {$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"; - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - @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; - print {$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))) { - print {$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; - print {$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}) { - print {$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"; - $affected_packages{$data->{package}} = 1; - add_recipients(data => $data, - recipients => \%recipients, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ); - @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 affects summary); - @{$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++; - - my $origref = $1; - my @newclonedids = split /\s+/, $2; - my $newbugsneeded = scalar(@newclonedids); - - $ref = $origref; - $bug_affected{$ref} = 1; - if (&setbug) { - $affected_packages{$data->{package}} = 1; - 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: $!"; - my $v=; $v =~ s/\n$// || die "nextnumber bad format"; - my $firstref= $v+0; $v += $newbugsneeded; - open(NN,">nextnumber"); print NN "$v\n"; close(NN); - &unfilelock; - - my $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 my $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; - print {$transcript} "Ignoring bugs not assigned to: " . - join(" ", keys(%limit_pkgs)) . "\n\n"; - } else { - %limit_pkgs = (); - print {$transcript} "Not ignoring any bugs.\n\n"; - } - } elsif (m/^affects?\s+\#?(-?\d+)(?:\s+((?:[=+-])?)\s*(\S.*)?)?\s*$/i) { - $ok++; - $ref = $1; - my $add_remove = $2 || ''; - my $packages = $3 || ''; - $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - $bug_affected{$ref} = 1; - eval { - affects(bug => $ref, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - recipients => \%recipients, - packages => [splitpackages($3)], - ($add_remove eq '+'?(add => 1):()), - ($add_remove eq '-'?(remove => 1):()), - ); - }; - if ($@) { - $errors++; - print {$transcript} "Failed to give $ref a summary: $@"; - } - - } elsif (m/^summary\s+\#?(-?\d+)\s*(\d+|)\s*$/i) { - $ok++; - $ref = $1; - my $summary_msg = length($2)?$2:undef; - $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - $bug_affected{$ref} = 1; - eval { - summary(bug => $ref, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - recipients => \%recipients, - summary => $summary_msg, - ); - }; - if ($@) { - $errors++; - print {$transcript} "Failed to give $ref a summary: $@"; - } - - } elsif (m/^owner\s+\#?(-?\d+)\s+((?:\S.*\S)|\!)\s*$/i) { - $ok++; - $ref = $1; - $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - my $newowner = $2; - if ($newowner eq '!') { - $newowner = $replyto; - } - $bug_affected{$ref} = 1; - eval { - owner(bug => $ref, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - recipients => \%recipients, - owner => $newowner, - ); - }; - if ($@) { - $errors++; - print {$transcript} "Failed to mark $ref as having an owner: $@"; - } - } elsif (m/^noowner\s+\#?(-?\d+)\s*$/i) { - $ok++; - $ref = $1; - $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - $bug_affected{$ref} = 1; - eval { - owner(bug => $ref, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - recipients => \%recipients, - owner => undef, - ); - }; - if ($@) { - $errors++; - print {$transcript} "Failed to mark $ref as not having an owner: $@"; + #### "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/^unarchive\s+#?(\d+)$/i) { - $ok++; - $ref = $1; - $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - $bug_affected{$ref} = 1; - eval { - bug_unarchive(bug => $ref, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - affected_bugs => \%bug_affected, - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - recipients => \%recipients, - ); - }; - if ($@) { - $errors++; - } - } elsif (m/^archive\s+#?(\d+)$/i) { - $ok++; - $ref = $1; - $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - $bug_affected{$ref} = 1; - eval { - bug_archive(bug => $ref, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - ignore_time => 1, - archive_unarchived => 0, - affected_bugs => \%bug_affected, - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - recipients => \%recipients, - ); - }; - 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"; @@ -1411,43 +504,41 @@ my @maintccs = determine_recipients(recipients => \%recipients, address_only => 1, cc => 1, ); -my $maintccs = 'Cc: '.join(",\n ", - determine_recipients(recipients => \%recipients, - cc => 1, - ) - )."\n"; - -my $packagepr = ''; -$packagepr = "X-${gProject}-PR-Package: " . join(keys %affected_packages) . "\n" if keys %affected_packages; - -# Add Bcc's to subscribed bugs -# now handled by Debbugs::Recipients -#push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected; - 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)":''; - -my $reply= < -Precedence: bulk -${packagepr}X-$gProject-PR-Message: transcript - -${transcript_scalar}Please contact me if you need assistance. - -$gMaintainer -(administrator, $gProject $gBugs database) -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, @@ -1455,19 +546,7 @@ my $repliedshow= join(', ',$replyto, address_only => 1, ) ); -# -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, @@ -1495,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, @@ -1793,6 +875,11 @@ our $doc; sub sendtxthelpraw { 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); @@ -1814,7 +901,7 @@ END sub sendlynxdocraw { 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/) {