From: Debian BTS Date: Sat, 9 Aug 2008 14:19:13 +0000 (+0000) Subject: merge changes from dla source X-Git-Tag: release/2.6.0~488 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=46fa42780ecb746d7bec2fb01190b05584b9283e;hp=cf03b14c6ead845eee0b65720e4ceb0efaedf64a;p=debbugs.git merge changes from dla source --- diff --git a/Debbugs/Bugs.pm b/Debbugs/Bugs.pm index 62cd03f..9bfd4ae 100644 --- a/Debbugs/Bugs.pm +++ b/Debbugs/Bugs.pm @@ -90,6 +90,8 @@ for limited regular expressions, and/or more complex expressions. =item owner -- owner of the bug +=item correspondent -- address of someone who sent mail to the log + =item dist -- distribution (I don't know about this one yet) =item bugs -- list of bugs to search within @@ -177,6 +179,9 @@ sub get_bugs{ dist => {type => SCALAR|ARRAYREF, optional => 1, }, + correspondent => {type => SCALAR|ARRAYREF, + optional => 1, + }, function => {type => CODEREF, optional => 1, }, @@ -299,14 +304,16 @@ sub newest_bug { Allows filtering bugs on commonly used criteria + + =cut sub bug_filter { my %param = validate_with(params => \@_, - spec => {bug => {type => SCALAR, - regex => qr/^\d+$/, - }, - status => {type => HASHREF, + spec => {bug => {type => ARRAYREF|SCALAR, + optional => 1, + }, + status => {type => HASHREF|ARRAYREF, optional => 1, }, seen_merged => {type => HASHREF, @@ -334,6 +341,9 @@ sub bug_filter { not defined $param{seen_merged}) { croak "repeat_merged false requires seen_merged to be passed"; } + if (not exists $param{bug} and not exists $param{status}) { + croak "one of bug or status must be passed"; + } if (not exists $param{status}) { my $location = getbuglocation($param{bug}, 'summary'); @@ -402,6 +412,9 @@ sub get_bugs_by_idx{ bugs => {type => SCALAR|ARRAYREF, optional => 1, }, + correspondent => {type => SCALAR|ARRAYREF, + optional => 1, + }, usertags => {type => HASHREF, optional => 1, }, @@ -498,10 +511,13 @@ sub get_bugs_flatfile{ tag => {type => SCALAR|ARRAYREF, optional => 1, }, + owner => {type => SCALAR|ARRAYREF, + optional => 1, + }, + correspondent => {type => SCALAR|ARRAYREF, + optional => 1, + }, # not yet supported -# owner => {type => SCALAR|ARRAYREF, -# optional => 1, -# }, # dist => {type => SCALAR|ARRAYREF, # optional => 1, # }, @@ -544,11 +560,23 @@ sub get_bugs_flatfile{ delete @param{qw(maint src)}; $param{package} = [@packages]; } + my $grep_bugs = 0; + my %bugs; + if (exists $param{bugs}) { + $bugs{$_} = 1 for make_list($param{bugs}); + $grep_bugs = 1; + } + if (exists $param{owner} or exists $param{correspondent}) { + $bugs{$_} = 1 for get_bugs_by_idx(exists $param{correspondent}?(correspondent => $param{correspondent}):(), + exists $param{owner}?(owner => $param{owner}):(), + ); + $grep_bugs = 1; + } my @bugs; while (<$flatfile>) { next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/; my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7); - next if exists $param{bugs} and not grep {$bug == $_} make_list($param{bugs}); + next if $grep_bugs and not exists $bugs{$bug}; if (exists $param{package}) { my @packages = splitpackages($pkg); next unless grep { my $pkg_list = $_; @@ -670,6 +698,7 @@ my %field_match = ( }, 'severity' => \&__exact_field_match, 'pending' => \&__exact_field_match, + 'package' => \&__exact_field_match, 'originator' => \&__contains_field_match, 'forwarded' => \&__contains_field_match, 'owner' => \&__contains_field_match, diff --git a/Debbugs/CGI.pm b/Debbugs/CGI.pm index 8fc14f2..1ba4799 100644 --- a/Debbugs/CGI.pm +++ b/Debbugs/CGI.pm @@ -37,7 +37,7 @@ use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); use base qw(Exporter); use Debbugs::URI; use HTML::Entities; -use Debbugs::Common qw(getparsedaddrs); +use Debbugs::Common qw(getparsedaddrs make_list); use Params::Validate qw(validate_with :types); use Debbugs::Config qw(:config); use Debbugs::Status qw(splitpackages isstrongseverity); @@ -45,6 +45,12 @@ use Mail::Address; use POSIX qw(ceil); use Storable qw(dclone); +use List::Util qw(max); + +use Carp; + +use Debbugs::Text qw(fill_in_template); + our %URL_PARAMS = (); @@ -55,18 +61,21 @@ BEGIN{ @EXPORT = (); %EXPORT_TAGS = (url => [qw(bug_url bug_links bug_linklist maybelink), qw(set_url_params pkg_url version_url), - qw(submitterurl mainturl munge_url) + qw(submitterurl mainturl munge_url), + qw(package_links bug_links), ], html => [qw(html_escape htmlize_bugs htmlize_packagelinks), qw(maybelink htmlize_addresslinks htmlize_maintlinks), ], util => [qw(cgi_parameters quitcgi), ], + forms => [qw(option_form form_options_and_normal_param)], misc => [qw(maint_decode)], + package_search => [qw(@package_search_key_order %package_search_keys)], #status => [qw(getbugstatus)], ); @EXPORT_OK = (); - Exporter::export_ok_tags(qw(url html util misc)); + Exporter::export_ok_tags(keys %EXPORT_TAGS); $EXPORT_TAGS{all} = [@EXPORT_OK]; } @@ -112,6 +121,8 @@ sub bug_url{ else { %params = @_; } + carp "bug_url is deprecated, use bug_links instead"; + return munge_url('bugreport.cgi?',%params,bug=>$ref); } @@ -124,6 +135,7 @@ sub pkg_url{ else { %params = @_; } + carp "pkg_url is deprecated, use package_links instead"; return munge_url('pkgreport.cgi?',%params); } @@ -151,22 +163,64 @@ sub munge_url { =head2 version_url - version_url($package,$found,$fixed) + version_url(package => $package,found => $found,fixed => $fixed) Creates a link to the version cgi script +=over + +=item package -- source package whose graph to display + +=item found -- arrayref of found versions + +=item fixed -- arrayref of fixed versions + +=item width -- optional width of graph + +=item height -- optional height of graph + +=item info -- display html info surrounding graph; defaults to 1 if +width and height are not passed. + +=item collapse -- whether to collapse the graph; defaults to 1 if +width and height are passed. + +=back + =cut sub version_url{ - my ($package,$found,$fixed,$width,$height) = @_; + my %params = validate_with(params => \@_, + spec => {package => {type => SCALAR, + }, + found => {type => ARRAYREF, + default => [], + }, + fixed => {type => ARRAYREF, + default => [], + }, + width => {type => SCALAR, + optional => 1, + }, + height => {type => SCALAR, + optional => 1, + }, + absolute => {type => BOOLEAN, + default => 0, + }, + collapse => {type => BOOLEAN, + default => 1, + }, + info => {type => BOOLEAN, + optional => 1, + }, + } + ); + if (not defined $params{width} and not defined $params{height}) { + $params{info} = 1 if not exists $params{info}; + } my $url = Debbugs::URI->new('version.cgi?'); - $url->query_form(package => $package, - found => $found, - fixed => $fixed, - (defined $width)?(width => $width):(), - (defined $height)?(height => $height):(), - (defined $width or defined $height)?(collapse => 1):(info => 1), - ); + $url->query_form(%params); return $url->as_string; } @@ -231,168 +285,233 @@ sub cgi_parameters { sub quitcgi { my $msg = shift; print "Content-Type: text/html\n\n"; - print "Error\n"; - print "An error occurred. Dammit.\n"; - print "Error was: $msg.\n"; - print "\n"; + print fill_in_template(template=>'cgi/quit', + variables => {msg => $msg} + ); exit 0; } =head HTML -=head2 htmlize_bugs +=head2 htmlize_packagelinks - htmlize_bugs({bug=>1,status=>\%status,extravars=>\%extra},{bug=>...}}); + htmlize_packagelinks -Turns a list of bugs into an html snippit of the bugs. +Given a scalar containing a list of packages separated by something +that L can separate, returns a +formatted set of links to packages in html. =cut -# htmlize_bugs(bugs=>[@bugs]); -sub htmlize_bugs{ - my @bugs = @_; - my @html; - - for my $bug (@bugs) { - my $html = sprintf "
  • #%d: %s\n
    ", - bug_url($bug->{bug}), $bug->{bug}, html_escape($bug->{status}{subject}); - $html .= htmlize_bugstatus($bug->{status}) . "\n"; - } - return @html; + +sub htmlize_packagelinks { + my ($pkgs) = @_; + return '' unless defined $pkgs and $pkgs ne ''; + my @pkglist = splitpackages($pkgs); + + carp "htmlize_packagelinks is deprecated, use package_links instead"; + + return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' . + package_links(package =>\@pkglist, + class => 'submitter' + ); } +=head2 package_links -sub htmlize_bugstatus { - my %status = %{$_[0]}; + join(', ', package_links(packages => \@packages)) - my $result = ""; +Given a list of packages, return a list of html which links to the package - my $showseverity; - if ($status{severity} eq $config{default_severity}) { - $showseverity = ''; - } elsif (isstrongseverity($status{severity})) { - $showseverity = "Severity: $status{severity};\n"; - } else { - $showseverity = "Severity: $status{severity};\n"; - } +=over + +=item package -- arrayref or scalar of package(s) + +=item submitter -- arrayref or scalar of submitter(s) + +=item src -- arrayref or scalar of source(s) + +=item maintainer -- arrayref or scalar of maintainer(s) + +=item links_only -- return only links, not htmlized links, defaults to +returning htmlized links. + +=item class -- class of the a href, defaults to '' + +=back - $result .= htmlize_packagelinks($status{"package"}, 1); +=cut - my $showversions = ''; - if (@{$status{found_versions}}) { - my @found = @{$status{found_versions}}; - local $_; - s{/}{ } foreach @found; - $showversions .= join ', ', map html_escape($_), @found; +our @package_search_key_order = (package => 'in package', + tag => 'tagged', + severity => 'with severity', + src => 'in source package', + maint => 'in packages maintained by', + submitter => 'submitted by', + owner => 'owned by', + status => 'with status', + correspondent => 'with mail from', + newest => 'newest bugs', + ); +our %package_search_keys = @package_search_key_order; + + +sub package_links { + my %param = validate_with(params => \@_, + spec => {(map { ($_,{type => SCALAR|ARRAYREF, + optional => 1, + }); + } keys %package_search_keys, + ), + links_only => {type => BOOLEAN, + default => 0, + }, + class => {type => SCALAR, + default => '', + }, + separator => {type => SCALAR, + default => ', ', + }, + options => {type => HASHREF, + default => {}, + }, + }, + normalize_keys => + sub { + my ($key) = @_; + my %map = (source => 'src', + maintainer => 'maint', + pkg => 'package', + ); + return $map{$key} if exists $map{$key}; + return $key; + } + ); + my %options = %{$param{options}}; + for ((keys %package_search_keys,qw(msg att))) { + delete $options{$_} if exists $options{$_}; } - if (@{$status{fixed_versions}}) { - $showversions .= '; ' if length $showversions; - $showversions .= 'fixed: '; - my @fixed = @{$status{fixed_versions}}; - $showversions .= join ', ', map {s#/##; html_escape($_)} @fixed; + my @links = (); + for my $type (qw(src package)) { + push @links, map {(munge_url('pkgreport.cgi?', + %options, + $type => $_, + ), + $_); + } make_list($param{$type}) if exists $param{$type}; } - $result .= " ($showversions)" if length $showversions; - $result .= ";\n"; - - $result .= $showseverity; - $result .= htmlize_addresslinks("Reported by: ", \&submitterurl, - $status{originator}); - $result .= ";\nOwned by: " . html_escape($status{owner}) - if length $status{owner}; - $result .= ";\nTags: " - . html_escape(join(", ", sort(split(/\s+/, $status{tags})))) - . "" - if (length($status{tags})); - - $result .= ";\nMerged with ". - bug_linklist(', ', - 'submitter', - split(/ /,$status{mergedwith})) - if length $status{mergedwith}; - $result .= ";\nBlocked by ". - bug_linklist(", ", - 'submitter', - split(/ /,$status{blockedby})) - if length $status{blockedby}; - $result .= ";\nBlocks ". - bug_linklist(", ", - 'submitter', - split(/ /,$status{blocks}) - ) - if length $status{blocks}; - - my $days = 0; - if (length($status{done})) { - $result .= "
    Done: " . html_escape($status{done}); - $days = ceil($debbugs::gRemoveAge - -M buglog($status{id})); - if ($days >= 0) { - $result .= ";\nWill be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . ""; - } else { - $result .= ";\nArchived"; + for my $type (qw(maint owner submitter correspondent)) { + push @links, map {my $addr = getparsedaddrs($_); + $addr = defined $addr?$addr->address:''; + (munge_url('pkgreport.cgi?', + %options, + $type => $addr, + ), + $_); + } make_list($param{$type}) if exists $param{$type}; + } + my @return = (); + my ($link,$link_name); + my $class = ''; + if (length $param{class}) { + $class = q( class=").html_escape($param{class}).q("); + } + while (($link,$link_name) = splice(@links,0,2)) { + if ($param{links_only}) { + push @return,$link + } + else { + push @return, + qq(). + html_escape($link_name).q(); } } + if (wantarray) { + return @return; + } else { - if (length($status{forwarded})) { - $result .= ";\nForwarded to " - . maybelink($status{forwarded}); - } - my $daysold = int((time - $status{date}) / 86400); # seconds to days - if ($daysold >= 7) { - my $font = ""; - my $efont = ""; - $font = "em" if ($daysold > 30); - $font = "strong" if ($daysold > 60); - $efont = "" if ($font); - $font = "<$font>" if ($font); - - my $yearsold = int($daysold / 365); - $daysold -= $yearsold * 365; - - $result .= ";\n $font"; - my @age; - push @age, "1 year" if ($yearsold == 1); - push @age, "$yearsold years" if ($yearsold > 1); - push @age, "1 day" if ($daysold == 1); - push @age, "$daysold days" if ($daysold > 1); - $result .= join(" and ", @age); - $result .= " old$efont"; - } - } + return join($param{separator},@return); + } +} - $result .= "."; +=head2 bug_links - return $result; -} + join(', ', bug_links(bug => \@packages)) -=head2 htmlize_packagelinks +Given a list of bugs, return a list of html which links to the bugs - htmlize_packagelinks +=over -Given a scalar containing a list of packages separated by something -that L can separate, returns a -formatted set of links to packages. +=item bug -- arrayref or scalar of bug(s) -=cut +=item links_only -- return only links, not htmlized links, defaults to +returning htmlized links. -sub htmlize_packagelinks { - my ($pkgs,$strong) = @_; - return unless defined $pkgs and $pkgs ne ''; - my @pkglist = splitpackages($pkgs); +=item class -- class of the a href, defaults to '' - $strong = 0; - my $openstrong = $strong ? '' : ''; - my $closestrong = $strong ? '' : ''; +=back - return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' . - join(', ', - map { - '' . - $openstrong . html_escape($_) . $closestrong . '' - } @pkglist - ); +=cut + +sub bug_links { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR|ARRAYREF, + optional => 1, + }, + links_only => {type => BOOLEAN, + default => 0, + }, + class => {type => SCALAR, + default => '', + }, + separator => {type => SCALAR, + default => ', ', + }, + options => {type => HASHREF, + default => {}, + }, + }, + ); + my %options = %{$param{options}}; + + for (qw(bug)) { + delete $options{$_} if exists $options{$_}; + } + my @links; + push @links, map {(munge_url('bugreport.cgi?', + %options, + bug => $_, + ), + $_); + } make_list($param{bug}) if exists $param{bug}; + my @return; + my ($link,$link_name); + my $class = ''; + if (length $param{class}) { + $class = q( class=").html_escape($param{class}).q("); + } + while (($link,$link_name) = splice(@links,0,2)) { + if ($param{links_only}) { + push @return,$link + } + else { + push @return, + qq(). + html_escape($link_name).q(); + } + } + if (wantarray) { + return @return; + } + else { + return join($param{separator},@return); + } } + =head2 maybelink maybelink($in); @@ -444,6 +563,8 @@ or submitterurl which returns the URL for each individual address. sub htmlize_addresslinks { my ($prefixfunc, $urlfunc, $addresses,$class) = @_; + carp "htmlize_addresslinks is deprecated"; + $class = defined $class?qq(class="$class" ):''; if (defined $addresses and $addresses ne '') { my @addrs = getparsedaddrs($addresses); @@ -473,10 +594,11 @@ sub emailfromrfc822{ return $addr; } -sub mainturl { pkg_url(maint => emailfromrfc822($_[0])); } -sub submitterurl { pkg_url(submitter => emailfromrfc822($_[0])); } +sub mainturl { package_links(maint => $_[0], links_only => 1); } +sub submitterurl { package_links(submitter => $_[0], links_only => 1); } sub htmlize_maintlinks { my ($prefixfunc, $maints) = @_; + carp "htmlize_maintlinks is deprecated"; return htmlize_addresslinks($prefixfunc, \&mainturl, $maints); } @@ -484,33 +606,6 @@ sub htmlize_maintlinks { our $_maintainer; our $_maintainer_rev; -=head2 bug_links - - bug_links($one_bug); - bug_links($starting_bug,$stoping_bugs,); - -Creates a set of links to bugs, starting with bug number -$starting_bug, and finishing with $stoping_bug; if only one bug is -passed, makes a link to only a single bug. - -The content of the link is the bug number. - -XXX Use L; we want to be able to support query -arguments here too. - -=cut - -sub bug_links{ - my ($start,$stop,$query_arguments) = @_; - $stop = $stop || $start; - $query_arguments ||= ''; - my @output; - for my $bug ($start..$stop) { - push @output,'$bug); - } - return join(', ',@output); -} - =head2 bug_linklist bug_linklist($separator,$class,@bugs) @@ -528,14 +623,234 @@ too.] sub bug_linklist{ my ($sep,$class,@bugs) = @_; - if (length $class) { - $class = qq(class="$class" ); + carp "bug_linklist is deprecated; use bug_links instead"; + return scalar bug_links(bug=>\@bugs,class=>$class,separator=>$sep); +} + + + +=head1 Forms + +=cut + +=head2 form_options_and_normal_param + + my ($form_option,$param) = form_options_and_normal_param(\%param) + if $param{form_options}; + my $form_option = form_options_and_normal_param(\%param) + if $param{form_options}; + +Translates from special form_options to a set of parameters which can +be used to run the current page. + +The idea behind this is to allow complex forms to relatively easily +cause options that the existing cgi scripts understand to be set. + +Currently there are two commands which are understood: +combine, and concatenate. + +=head3 combine + +Combine works by entering key,value pairs into the parameters using +the key field option input field, and the value field option input +field. + +For example, you would have + + + +which would combine the _fo_searchkey and _fo_searchvalue input fields, so + + + + +would yield foo=>'bar' in %param. + +=head3 concatenate + +Concatenate concatenates values into a single entry in a parameter + +For example, you would have + + + +which would combine the _fo_searchkey and _fo_searchvalue input fields, so + + + + +would yield foo=>'bar:baz' in %param. + + +=cut + +my $form_option_leader = '_fo_'; +sub form_options_and_normal_param{ + my ($orig_param) = @_; + # all form_option parameters start with _fo_ + my ($param,$form_option) = ({},{}); + for my $key (keys %{$orig_param}) { + if ($key =~ /^\Q$form_option_leader\E/) { + $form_option->{$key} = $orig_param->{$key}; + } + else { + $param->{$key} = $orig_param->{$key}; + } } - return join($sep,map{qq(#$_) - } @bugs); + # at this point, we check for commands + COMMAND: for my $key (keys %{$form_option}) { + $key =~ s/^\Q$form_option_leader\E//; + if (my ($key_name,$value_name) = + $key =~ /combine_key(\Q$form_option_leader\E.+) + _value(\Q$form_option_leader\E.+)$/x + ) { + next unless defined $form_option->{$key_name}; + next unless defined $form_option->{$value_name}; + my @keys = make_list($form_option->{$key_name}); + my @values = make_list($form_option->{$value_name}); + for my $i (0 .. $#keys) { + last if $i > $#values; + next if not defined $keys[$i]; + next if not defined $values[$i]; + __add_to_param($param, + $keys[$i], + $values[$i], + ); + } + } + elsif (my ($field,$concatenate_key,$fields) = + $key =~ /concatenate_into_(.+?)((?:_with_[^_])?) + ((?:\Q$form_option_leader\E.+?)+) + $/x + ) { + if (length $concatenate_key) { + $concatenate_key =~ s/_with_//; + } + else { + $concatenate_key = ':'; + } + my @fields = $fields =~ m/(\Q$form_option_leader\E.+?)(?:(?=\Q$form_option_leader\E)|$)/g; + my %field_list; + my $max_num = 0; + for my $f (@fields) { + next COMMAND unless defined $form_option->{$f}; + $field_list{$f} = [make_list($form_option->{$f})]; + $max_num = max($max_num,$#{$field_list{$f}}); + } + for my $i (0 .. $max_num) { + next unless @fields == grep {$i <= $#{$field_list{$_}} and + defined $field_list{$_}[$i]} @fields; + __add_to_param($param, + $field, + join($concatenate_key, + map {$field_list{$_}[$i]} @fields + ) + ); + } + } + } + return wantarray?($form_option,$param):$form_option; } +=head2 option_form + + print option_form(template=>'pkgreport_options', + param => \%param, + form_options => $form_options, + ) + + + +=cut + +sub option_form{ + my %param = validate_with(params => \@_, + spec => {template => {type => SCALAR, + }, + variables => {type => HASHREF, + default => {}, + }, + language => {type => SCALAR, + optional => 1, + }, + param => {type => HASHREF, + default => {}, + }, + form_options => {type => HASHREF, + default => {}, + }, + }, + ); + + # First, we need to see if we need to add particular types of + # parameters + my $variables = dclone($param{variables}); + $variables->{param} = dclone($param{param}); + for my $key (keys %{$param{form_option}}) { + # strip out leader; shouldn't be anything here without one, + # but skip stupid things anyway + my $o_key = $key; + next unless $key =~ s/^\Q$form_option_leader\E//; + if ($key =~ /^add_(.+)$/) { + # this causes a specific parameter to be added + __add_to_param($variables->{param}, + $1, + '' + ); + } + elsif ($key =~ /^delete_(.+?)(?:_(\d+))?$/) { + next unless exists $variables->{param}{$1}; + if (ref $variables->{param}{$1} eq 'ARRAY' and + defined $2 and + defined $variables->{param}{$1}[$2] + ) { + splice @{$variables->{param}{$1}},$2,1; + } + else { + delete $variables->{param}{$1}; + } + } + # we'll add extra comands here once I figure out what they + # should be + } + # add in a few utility routines + $variables->{output_select_options} = sub { + my ($options,$value) = @_; + my @options = @{$options}; + my $output = ''; + while (my ($o_value,$name) = splice @options,0,2) { + my $selected = ''; + if (defined $value and $o_value eq $value) { + $selected = ' selected'; + } + $output .= qq(\n); + } + return $output; + }; + $variables->{make_list} = sub { make_list(@_); + }; + # now at this point, we're ready to create the template + return Debbugs::Text::fill_in_template(template=>$param{template}, + (exists $param{language}?(language=>$param{language}):()), + variables => $variables, + ); +} + +sub __add_to_param{ + my ($param,$key,@values) = @_; + + if (exists $param->{$key} and not + ref $param->{$key}) { + @{$param->{$key}} = [$param->{$key}, + @values + ]; + } + else { + push @{$param->{$key}}, @values; + } +} + + =head1 misc diff --git a/Debbugs/CGI/Bugreport.pm b/Debbugs/CGI/Bugreport.pm new file mode 100644 index 0000000..faed9be --- /dev/null +++ b/Debbugs/CGI/Bugreport.pm @@ -0,0 +1,409 @@ +# This module is part of debbugs, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# +# [Other people have contributed to this file; their copyrights should +# be listed here too.] +# Copyright 2008 by Don Armstrong . + + +package Debbugs::CGI::Bugreport; + +=head1 NAME + +Debbugs::CGI::Bugreport -- specific routines for the bugreport cgi script + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +use IO::Scalar; +use Params::Validate qw(validate_with :types); +use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522 create_mime_message); +use Debbugs::CGI qw(:url :html :util); +use Debbugs::Common qw(globify_scalar); +use POSIX qw(strftime); + +BEGIN{ + ($VERSION) = q$Revision: 494 $ =~ /^Revision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (); + @EXPORT_OK = (qw(display_entities handle_record handle_email_message)); + Exporter::export_ok_tags(keys %EXPORT_TAGS); + $EXPORT_TAGS{all} = [@EXPORT_OK]; +} + + + +=head2 display_entity + + display_entity(entity => $entity, + bug_num => $ref, + outer => 1, + msg_num => $msg_num, + attachments => \@attachments, + output => \$output); + + +=over + +=item entity -- MIME::Parser entity + +=item bug_num -- Bug number + +=item outer -- Whether this is the outer entity; defaults to 1 + +=item msg_num -- message number in the log + +=item attachments -- arrayref of attachments + +=item output -- scalar reference for output + +=back + +=cut + +sub display_entity { + my %param = validate_with(params => \@_, + spec => {entity => {type => OBJECT, + }, + bug_num => {type => SCALAR, + regex => qr/^\d+$/, + }, + outer => {type => BOOLEAN, + default => 1, + }, + msg_num => {type => SCALAR, + }, + attachments => {type => ARRAYREF, + default => [], + }, + output => {type => SCALARREF|HANDLE, + default => \*STDOUT, + }, + terse => {type => BOOLEAN, + default => 0, + }, + msg => {type => SCALAR, + optional => 1, + }, + att => {type => SCALAR, + optional => 1, + }, + trim_headers => {type => BOOLEAN, + default => 1, + }, + } + ); + + $param{output} = globify_scalar($param{output}); + my $entity = $param{entity}; + my $ref = $param{bug_num}; + my $top = $param{outer}; + my $xmessage = $param{msg_num}; + my $attachments = $param{attachments}; + + my $head = $entity->head; + my $disposition = $head->mime_attr('content-disposition'); + $disposition = 'inline' if not defined $disposition or $disposition eq ''; + my $type = $entity->effective_type; + my $filename = $entity->head->recommended_filename; + $filename = '' unless defined $filename; + $filename = decode_rfc1522($filename); + + if ($param{outer} and + not $param{terse} and + not exists $param{att}) { + my $header = $entity->head; + print {$param{output}} "
    \n";
+	 if ($param{trim_headers}) {
+	      my @headers;
+	      foreach (qw(From To Cc Subject Date)) {
+		   my $head_field = $head->get($_);
+		   next unless defined $head_field and $head_field ne '';
+		   push @headers, qq($_: ) . html_escape(decode_rfc1522($head_field));
+	      }
+	      print {$param{output}} join(qq(), @headers);
+	 } else {
+	      print {$param{output}} html_escape(decode_rfc1522($entity->head->stringify));
+	 }
+	 print {$param{output}} "
    \n"; + } + + if (not (($param{outer} and $type =~ m{^text(?:/plain)?(?:;|$)}) + or $type =~ m{^multipart/} + )) { + push @$attachments, $param{entity}; + # output this attachment + if (exists $param{att} and + $param{att} == $#$attachments) { + my $head = $entity->head; + chomp(my $type = $entity->effective_type); + my $body = $entity->stringify_body; + print {$param{output}} "Content-Type: $type"; + my ($charset) = $head->get('Content-Type:') =~ m/charset\s*=\s*\"?([\w-]+)\"?/i; + print {$param{output}} qq(; charset="$charset") if defined $charset; + print {$param{output}}"\n"; + if ($filename ne '') { + my $qf = $filename; + $qf =~ s/"/\\"/g; + $qf =~ s[.*/][]; + print {$param{output}} qq{Content-Disposition: inline; filename="$qf"\n}; + } + print {$param{output}} "\n"; + my $decoder = MIME::Decoder->new($head->mime_encoding); + $decoder->decode(IO::Scalar->new(\$body), $param{output}); + return; + } + elsif (not exists $param{att}) { + my @dlargs = (msg=>$xmessage, att=>$#$attachments); + push @dlargs, (filename=>$filename) if $filename ne ''; + my $printname = $filename; + $printname = 'Message part ' . ($#$attachments + 1) if $filename eq ''; + print {$param{output}} '
    [$printname } .
+				  "($type, $disposition)]
    \n"; + } + } + + return if not $param{outer} and $disposition eq 'attachment' and not exists $param{att}; + return unless ($type =~ m[^text/?] and + $type !~ m[^text/(?:html|enriched)(?:;|$)]) or + $type =~ m[^application/pgp(?:;|$)] or + $entity->parts; + + if ($entity->is_multipart) { + my @parts = $entity->parts; + foreach my $part (@parts) { + display_entity(entity => $part, + bug_num => $ref, + outer => 0, + msg_num => $xmessage, + output => $param{output}, + attachments => $attachments, + terse => $param{terse}, + exists $param{msg}?(msg=>$param{msg}):(), + exists $param{att}?(att=>$param{att}):(), + ); + # print {$param{output}} "\n"; + } + } elsif ($entity->parts) { + # We must be dealing with a nested message. + if (not exists $param{att}) { + print {$param{output}} "
    \n"; + } + my @parts = $entity->parts; + foreach my $part (@parts) { + display_entity(entity => $part, + bug_num => $ref, + outer => 1, + msg_num => $xmessage, + ouput => $param{output}, + attachments => $attachments, + terse => $param{terse}, + exists $param{msg}?(msg=>$param{msg}):(), + exists $param{att}?(att=>$param{att}):(), + ); + # print {$param{output}} "\n"; + } + if (not exists $param{att}) { + print {$param{output}} "
    \n"; + } + } elsif (not $param{terse}) { + my $content_type = $entity->head->get('Content-Type:') || "text/html"; + my ($charset) = $content_type =~ m/charset\s*=\s*\"?([\w-]+)\"?/i; + my $body = $entity->bodyhandle->as_string; + $body = convert_to_utf8($body,$charset) if defined $charset; + $body = html_escape($body); + # Attempt to deal with format=flowed + if ($content_type =~ m/format\s*=\s*\"?flowed\"?/i) { + $body =~ s{^\ }{}mgo; + # we ignore the other things that you can do with + # flowed e-mails cause they don't really matter. + } + # Add links to URLs + # We don't html escape here because we escape above; + # wierd terminators are because of that + $body =~ s{((?:ftp|http|https|svn|ftps|rsync)://[\S~-]+?/?) # Url + ((?:\>\;)?[)]?(?:'|\&\#39\;)?[:.\,]?(?:\s|$)) # terminators + }{$1$2}gox; + # Add links to bug closures + $body =~ s[(closes:\s*(?:bug)?\#?\s?\d+(?:,?\s*(?:bug)?\#?\s?\d+)*)] + [my $temp = $1; + $temp =~ s{(\d+)} + {bug_links(bug=>$1)}ge; + $temp;]gxie; + + if (not exists $param{att}) { + print {$param{output}} qq(
    $body
    \n); + } + } +} + + +=head2 handle_email_message + + handle_email_message($record->{text}, + ref => $bug_number, + msg_num => $msg_number, + ); + +Returns a decoded e-mail message and displays entities/attachments as +appropriate. + + +=cut + +sub handle_email_message{ + my ($email,%param) = @_; + + my $output = ''; + my $parser = MIME::Parser->new(); + # Because we are using memory, not tempfiles, there's no need to + # clean up here like in Debbugs::MIME + $parser->tmp_to_core(1); + $parser->output_to_core(1); + my $entity = $parser->parse_data( $email); + my @attachments = (); + display_entity(entity => $entity, + bug_num => $param{ref}, + outer => 1, + msg_num => $param{msg_num}, + output => \$output, + attachments => \@attachments, + terse => $param{terse}, + exists $param{msg}?(msg=>$param{msg}):(), + exists $param{att}?(att=>$param{att}):(), + ); + return $output; + +} + +=head2 handle_record + + push @log, handle_record($record,$ref,$msg_num); + +Deals with a record in a bug log as returned by +L; returns the log information that +should be output to the browser. + +=cut + +sub handle_record{ + my ($record,$bug_number,$msg_number,$seen_msg_ids) = @_; + + my $output = ''; + local $_ = $record->{type}; + if (/html/) { + my ($time) = $record->{text} =~ //; + my $class = $record->{text} =~ /^(?:Acknowledgement|Reply|Information|Report|Notification)/ ? 'infmessage':'msgreceived'; + $output .= decode_rfc1522($record->{text}); + # Link to forwarded http:// urls in the midst of the report + # (even though these links already exist at the top) + $output =~ s,((?:ftp|http|https)://[\S~-]+?/?)([\)\'\:\.\,]?(?:\s|\.<|$)),$1$2,go; + # Add links to the cloned bugs + $output =~ s{(Bug )(\d+)( cloned as bugs? )(\d+)(?:\-(\d+)|)}{$1.bug_links(bug=>$2).$3.bug_links(bug=>[$4..$5])}eo; + # Add links to merged bugs + $output =~ s{(?<=Merged )([\d\s]+)(?=\.)}{join(' ',map {bug_links(bug=>$_)} (split /\s+/, $1))}eo; + # Add links to blocked bugs + $output =~ s{(?<=Blocking bugs)(?:( of )(\d+))?( (?:added|set to|removed):\s+)([\d\s\,]+)} + {(defined $2?$1.bug_links(bug=>$2):'').$3. + join(' ',map {bug_links(bug=>$_)} (split /\,?\s+/, $4))}eo; + # Add links to reassigned packages + $output =~ s{(Bug reassigned from package \`)([^']+?)((?:'|\&\#39;) to \`)([^']+?)((?:'|\&\#39;))} + {$1.q($2).$3.q($4).$5}eo; + if (defined $time) { + $output .= ' ('.strftime('%a, %d %b %Y %T GMT',gmtime($time)).') '; + } + $output .= 'Full text and rfc822 format available.'; + + $output = qq(
    \n\n) . $output . "
    \n"; + } + elsif (/recips/) { + my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; + if (defined $msg_id and exists $$seen_msg_ids{$msg_id}) { + return (); + } + elsif (defined $msg_id) { + $$seen_msg_ids{$msg_id} = 1; + } + $output .= qq(

    \n); + $output .= 'View this message in rfc822 format

    '; + $output .= handle_email_message($record->{text}, + ref => $bug_number, + msg_num => $msg_number, + ); + } + elsif (/autocheck/) { + # Do nothing + } + elsif (/incoming-recv/) { + my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; + if (defined $msg_id and exists $$seen_msg_ids{$msg_id}) { + return (); + } + elsif (defined $msg_id) { + $$seen_msg_ids{$msg_id} = 1; + } + # Incomming Mail Message + my ($received,$hostname) = $record->{text} =~ m/Received: \(at (\S+)\) by (\S+)\;/; + $output .= qq|

    Message #$msg_number received at |. + html_escape("$received\@$hostname") . + q| (full text'. + q|, mbox)'.":

    \n"; + $output .= handle_email_message($record->{text}, + ref => $bug_number, + msg_num => $msg_number, + ); + } + else { + die "Unknown record type $_"; + } + return $output; +} + + + +1; + + +__END__ + + + + + + diff --git a/Debbugs/CGI/Pkgreport.pm b/Debbugs/CGI/Pkgreport.pm new file mode 100644 index 0000000..51ebe42 --- /dev/null +++ b/Debbugs/CGI/Pkgreport.pm @@ -0,0 +1,790 @@ +# This module is part of debbugs, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# +# [Other people have contributed to this file; their copyrights should +# be listed here too.] +# Copyright 2008 by Don Armstrong . + + +package Debbugs::CGI::Pkgreport; + +=head1 NAME + +Debbugs::CGI::Pkgreport -- specific routines for the pkgreport cgi script + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +use IO::Scalar; +use Params::Validate qw(validate_with :types); + +use Debbugs::Config qw(:config :globals); +use Debbugs::CGI qw(:url :html :util); +use Debbugs::Common qw(:misc :util :date); +use Debbugs::Status qw(:status); +use Debbugs::Bugs qw(bug_filter); +use Debbugs::Packages qw(:mapping); + +use Debbugs::Text qw(:templates); + +use POSIX qw(strftime); + + +BEGIN{ + ($VERSION) = q$Revision: 494 $ =~ /^Revision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (html => [qw(short_bug_status_html pkg_htmlizebugs), + qw(pkg_javascript), + qw(pkg_htmlselectyesno pkg_htmlselectsuite), + qw(buglinklist pkg_htmlselectarch) + ], + misc => [qw(generate_package_info make_order_list), + qw(myurl), + qw(get_bug_order_index determine_ordering), + ], + ); + @EXPORT_OK = (qw()); + Exporter::export_ok_tags(keys %EXPORT_TAGS); + $EXPORT_TAGS{all} = [@EXPORT_OK]; +} + +=head2 generate_package_info + + generate_package_info($srcorbin,$package) + +Generates the informational bits for a package and returns it + +=cut + +sub generate_package_info{ + my %param = validate_with(params => \@_, + spec => {binary => {type => BOOLEAN, + default => 1, + }, + package => {type => SCALAR|ARRAYREF, + }, + options => {type => HASHREF, + }, + bugs => {type => ARRAYREF, + }, + }, + ); + + my $output_scalar = ''; + my $output = globify_scalar(\$output_scalar); + + my $package = $param{package}; + + my %pkgsrc = %{getpkgsrc()}; + my $srcforpkg = $package; + if ($param{binary} and exists $pkgsrc{$package} + and defined $pkgsrc{$package}) { + $srcforpkg = $pkgsrc{$package}; + } + + my $showpkg = html_escape($package); + my $maintainers = getmaintainers(); + my $maint = $maintainers->{$srcforpkg}; + if (defined $maint) { + print {$output} '

    '; + print {$output} (($maint =~ /,/)? "Maintainer for $showpkg is " + : "Maintainers for $showpkg are ") . + package_links(maint => $maint); + print {$output} ".

    \n"; + } + else { + print {$output} "

    No maintainer for $showpkg. Please do not report new bugs against this package.

    \n"; + } + my @pkgs = getsrcpkgs($srcforpkg); + @pkgs = grep( !/^\Q$package\E$/, @pkgs ); + if ( @pkgs ) { + @pkgs = sort @pkgs; + if ($param{binary}) { + print {$output} "

    You may want to refer to the following packages that are part of the same source:\n"; + } + else { + print {$output} "

    You may want to refer to the following individual bug pages:\n"; + } + #push @pkgs, $src if ( $src && !grep(/^\Q$src\E$/, @pkgs) ); + print {$output} scalar package_links(package=>[@pkgs]); + print {$output} ".\n"; + } + my @references; + my $pseudodesc = getpseudodesc(); + if ($package and defined($pseudodesc) and exists($pseudodesc->{$package})) { + push @references, "to the ". + "list of other pseudo-packages"; + } + else { + if ($package and defined $gPackagePages) { + push @references, sprintf "to the %s package page", + html_escape("http://${gPackagePages}/$package"), html_escape("$package"); + } + if (defined $gSubscriptionDomain) { + my $ptslink = $param{binary} ? $srcforpkg : $package; + push @references, q(to the Package Tracking System); + } + # Only output this if the source listing is non-trivial. + if ($param{binary} and $srcforpkg) { + push @references, + "to the source package ". + package_links(src=>$srcforpkg, + options => $param{options}) . + "'s bug page"; + } + } + if (@references) { + $references[$#references] = "or $references[$#references]" if @references > 1; + print {$output} "

    You might like to refer ", join(", ", @references), ".

    \n"; + } + if (defined $param{maint} || defined $param{maintenc}) { + print {$output} "

    If you find a bug not listed here, please\n"; + printf {$output} "report it.

    \n", + html_escape("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}"); + } + if (not $maint and not @{$param{bugs}}) { + print {$output} "

    There is no record of the " . html_escape($package) . + ($param{binary} ? " package" : " source package") . + ", and no bugs have been filed against it.

    "; + } + return $output_scalar; +} + + +=head2 short_bug_status_html + + print short_bug_status_html(status => read_bug(bug => 5), + options => \%param, + ); + +=over + +=item status -- status hashref as returned by read_bug + +=item options -- hashref of options to pass to package_links (defaults +to an empty hashref) + +=item bug_options -- hashref of options to pass to bug_links (default +to an empty hashref) + +=item snippet -- optional snippet of information about the bug to +display below + + +=back + + + +=cut + +sub short_bug_status_html { + my %param = validate_with(params => \@_, + spec => {status => {type => HASHREF, + }, + options => {type => HASHREF, + default => {}, + }, + bug_options => {type => HASHREF, + default => {}, + }, + snippet => {type => SCALAR, + default => '', + }, + }, + ); + + my %status = %{$param{status}}; + + $status{tags_array} = [sort(split(/\s+/, $status{tags}))]; + $status{date_text} = strftime('%a, %e %b %Y %T UTC', gmtime($status{date})); + $status{mergedwith_array} = [split(/ /,$status{mergedwith})]; + + my @blockedby= split(/ /, $status{blockedby}); + $status{blockedby_array} = []; + if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) { + for my $b (@blockedby) { + my %s = %{get_bug_status($b)}; + next if $s{"pending"} eq 'fixed' || length $s{done}; + push @{$status{blockedby_array}},{bug_num => $b, subject => $s{subject}, status => \%s}; + } + } + + my @blocks= split(/ /, $status{blocks}); + $status{blocks_array} = []; + if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) { + for my $b (@blocks) { + my %s = %{get_bug_status($b)}; + next if $s{"pending"} eq 'fixed' || length $s{done}; + push @{$status{blocks_array}}, {bug_num => $b, subject => $s{subject}, status => \%s}; + } + } + + + return fill_in_template(template => 'cgi/short_bug_status', + variables => {status => \%status, + isstrongseverity => \&Debbugs::Status::isstrongseverity, + html_escape => \&Debbugs::CGI::html_escape, + looks_like_number => \&Scalar::Util::looks_like_number, + }, + hole_var => {'&package_links' => \&Debbugs::CGI::package_links, + '&bug_links' => \&Debbugs::CGI::bug_links, + '&version_url' => \&Debbugs::CGI::version_url, + '&secs_to_english' => \&Debbugs::Common::secs_to_english, + '&strftime' => \&POSIX::strftime, + }, + ); + + my $result = ""; + + my $showseverity; + if ($status{severity} eq 'normal') { + $showseverity = ''; + } + elsif (isstrongseverity($status{severity})) { + $showseverity = "Severity: $status{severity};\n"; + } + else { + $showseverity = "Severity: $status{severity};\n"; + } + + $result .= package_links(package => $status{package}, + options => $param{options}, + ); + + my $showversions = ''; + if (@{$status{found_versions}}) { + my @found = @{$status{found_versions}}; + $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @found; + } + if (@{$status{fixed_versions}}) { + $showversions .= '; ' if length $showversions; + $showversions .= 'fixed: '; + my @fixed = @{$status{fixed_versions}}; + $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @fixed; + } + $result .= ' ($showversions)} if length $showversions; + $result .= ";\n"; + + $result .= $showseverity; + $result .= "Reported by: ".package_links(submitter=>$status{originator}, + class => "submitter", + ); + $result .= ";\nOwned by: " . package_links(owner => $status{owner}, + class => "submitter", + ) + if length $status{owner}; + $result .= ";\nTags: " + . html_escape(join(", ", sort(split(/\s+/, $status{tags})))) + . "" + if (length($status{tags})); + + $result .= (length($status{mergedwith})?";\nMerged with ":"") . + bug_links(bug => [split(/ /,$status{mergedwith})], + class => "submitter", + ); + $result .= (length($status{blockedby})?";\nBlocked by ":"") . + bug_links(bug => [split(/ /,$status{blockedby})], + class => "submitter", + ); + $result .= (length($status{blocks})?";\nBlocks ":"") . + bug_links(bug => [split(/ /,$status{blocks})], + class => "submitter", + ); + + if (length($status{done})) { + $result .= "
    Done: " . html_escape($status{done}); + my $days = bug_archiveable(bug => $status{id}, + status => \%status, + days_until => 1, + ); + if ($days >= 0 and defined $status{location} and $status{location} ne 'archive') { + $result .= ";\nCan be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . ""; + } + elsif (defined $status{location} and $status{location} eq 'archived') { + $result .= ";\nArchived."; + } + } + + unless (length($status{done})) { + if (length($status{forwarded})) { + $result .= ";\nForwarded to " + . join(', ', + map {maybelink($_)} + split /\,\s+/,$status{forwarded} + ); + } + # Check the age of the logfile + my ($days_last,$eng_last) = secs_to_english(time - $status{log_modified}); + my ($days,$eng) = secs_to_english(time - $status{date}); + + if ($days >= 7) { + my $font = ""; + my $efont = ""; + $font = "em" if ($days > 30); + $font = "strong" if ($days > 60); + $efont = "" if ($font); + $font = "<$font>" if ($font); + + $result .= ";\n ${font}$eng old$efont"; + } + if ($days_last > 7) { + my $font = ""; + my $efont = ""; + $font = "em" if ($days_last > 30); + $font = "strong" if ($days_last > 60); + $efont = "" if ($font); + $font = "<$font>" if ($font); + + $result .= ";\n ${font}Modified $eng_last ago$efont"; + } + } + + $result .= "."; + + return $result; +} + + +sub pkg_htmlizebugs { + my %param = validate_with(params => \@_, + spec => {bugs => {type => ARRAYREF, + }, + names => {type => ARRAYREF, + }, + title => {type => ARRAYREF, + }, + prior => {type => ARRAYREF, + }, + order => {type => ARRAYREF, + }, + ordering => {type => SCALAR, + }, + bugusertags => {type => HASHREF, + default => {}, + }, + bug_rev => {type => BOOLEAN, + default => 0, + }, + bug_order => {type => SCALAR, + }, + repeatmerged => {type => BOOLEAN, + default => 1, + }, + include => {type => ARRAYREF, + default => [], + }, + exclude => {type => ARRAYREF, + default => [], + }, + this => {type => SCALAR, + default => '', + }, + options => {type => HASHREF, + default => {}, + }, + } + ); + my @bugs = @{$param{bugs}}; + + my @status = (); + my %count; + my $header = ''; + my $footer = "

    Summary

    \n"; + + my @dummy = ($gRemoveAge); #, @gSeverityList, @gSeverityDisplay); #, $gHTMLExpireNote); + + if (@bugs == 0) { + return "

    No reports found!

    \n"; + } + + if ( $param{bug_rev} ) { + @bugs = sort {$b<=>$a} @bugs; + } + else { + @bugs = sort {$a<=>$b} @bugs; + } + my %seenmerged; + + my %common = ( + 'show_list_header' => 1, + 'show_list_footer' => 1, + ); + + my %section = (); + # Make the include/exclude map + my %include; + my %exclude; + for my $include (make_list($param{include})) { + next unless defined $include; + my ($key,$value) = split /\s*:\s*/,$include,2; + unless (defined $value) { + $key = 'tags'; + $value = $include; + } + push @{$include{$key}}, split /\s*,\s*/, $value; + } + for my $exclude (make_list($param{exclude})) { + next unless defined $exclude; + my ($key,$value) = split /\s*:\s*/,$exclude,2; + unless (defined $value) { + $key = 'tags'; + $value = $exclude; + } + push @{$exclude{$key}}, split /\s*,\s*/, $value; + } + + foreach my $bug (@bugs) { + my %status = %{get_bug_status(bug=>$bug, + (exists $param{dist}?(dist => $param{dist}):()), + bugusertags => $param{bugusertags}, + (exists $param{version}?(version => $param{version}):()), + (exists $param{arch}?(arch => $param{arch}):(arch => $config{default_architectures})), + )}; + next unless %status; + next if bug_filter(bug => $bug, + status => \%status, + repeat_merged => $param{repeatmerged}, + seen_merged => \%seenmerged, + (keys %include ? (include => \%include):()), + (keys %exclude ? (exclude => \%exclude):()), + ); + + my $html = "
  • "; ##%d: %s\n
    ", + #bug_url($bug), $bug, html_escape($status{subject}); + $html .= short_bug_status_html(status => \%status, + options => $param{options}, + ) . "\n"; + push @status, [ $bug, \%status, $html ]; + } + if ($param{bug_order} eq 'age') { + # MWHAHAHAHA + @status = sort {$a->[1]{log_modified} <=> $b->[1]{log_modified}} @status; + } + elsif ($param{bug_order} eq 'agerev') { + @status = sort {$b->[1]{log_modified} <=> $a->[1]{log_modified}} @status; + } + for my $entry (@status) { + my $key = ""; + for my $i (0..$#{$param{prior}}) { + my $v = get_bug_order_index($param{prior}[$i], $entry->[1]); + $count{"g_${i}_${v}"}++; + $key .= "_$v"; + } + $section{$key} .= $entry->[2]; + $count{"_$key"}++; + } + + my $result = ""; + if ($param{ordering} eq "raw") { + $result .= "
      \n" . join("", map( { $_->[ 2 ] } @status ) ) . "
    \n"; + } + else { + $header .= "
    \n
      \n"; + my @keys_in_order = (""); + for my $o (@{$param{order}}) { + push @keys_in_order, "X"; + while ((my $k = shift @keys_in_order) ne "X") { + for my $k2 (@{$o}) { + $k2+=0; + push @keys_in_order, "${k}_${k2}"; + } + } + } + for my $order (@keys_in_order) { + next unless defined $section{$order}; + my @ttl = split /_/, $order; + shift @ttl; + my $title = $param{title}[0]->[$ttl[0]] . " bugs"; + if ($#ttl > 0) { + $title .= " -- "; + $title .= join("; ", grep {($_ || "") ne ""} + map { $param{title}[$_]->[$ttl[$_]] } 1..$#ttl); + } + $title = html_escape($title); + + my $count = $count{"_$order"}; + my $bugs = $count == 1 ? "bug" : "bugs"; + + $header .= "
    • $title ($count $bugs)
      • \n"; + if ($common{show_list_header}) { + my $count = $count{"_$order"}; + my $bugs = $count == 1 ? "bug" : "bugs"; + $result .= "

      $title ($count $bugs)

      \n"; + } + else { + $result .= "

      $title

      \n"; + } + $result .= "
      \n
        \n"; + $result .= "\n\n\n\n"; + $result .= $section{$order}; + $result .= "\n\n\n\n"; + $result .= "
      \n
      \n"; + } + $header .= "
    \n"; + + $footer .= "
    \n
      \n"; + for my $i (0..$#{$param{prior}}) { + my $local_result = ''; + foreach my $key ( @{$param{order}[$i]} ) { + my $count = $count{"g_${i}_$key"}; + next if !$count or !$param{title}[$i]->[$key]; + $local_result .= "
    • $count $param{title}[$i]->[$key]
      • \n"; + } + if ( $local_result ) { + $footer .= "
    • $param{names}[$i]
        \n$local_result
      • \n"; + } + } + $footer .= "
    \n
    \n"; + } + + $result = $header . $result if ( $common{show_list_header} ); + $result .= $footer if ( $common{show_list_footer} ); + return $result; +} + +sub pkg_javascript { + return fill_in_template(template=>'cgi/pkgreport_javascript', + ); +} + +sub pkg_htmlselectyesno { + my ($name, $n, $y, $default) = @_; + return sprintf('', $name, ($default ? "" : " selected"), $n, ($default ? " selected" : ""), $y); +} + +sub pkg_htmlselectsuite { + my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2]; + my @suites = ("stable", "testing", "unstable", "experimental"); + my %suiteaka = ("stable", "etch", "testing", "lenny", "unstable", "sid"); + my $defaultsuite = "unstable"; + + my $result = sprintf ''; + return $result; +} + +sub pkg_htmlselectarch { + my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2]; + my @arches = qw(alpha amd64 arm hppa i386 ia64 m68k mips mipsel powerpc s390 sparc); + + my $result = sprintf ''; + return $result; +} + +sub myurl { + my %param = @_; + return html_escape(pkg_url(map {exists $param{$_}?($_,$param{$_}):()} + qw(archive repeatmerged mindays maxdays), + qw(version dist arch package src tag maint submitter) + ) + ); +} + +sub make_order_list { + my $vfull = shift; + my @x = (); + + if ($vfull =~ m/^([^:]+):(.*)$/) { + my $v = $1; + for my $vv (split /,/, $2) { + push @x, "$v=$vv"; + } + } + else { + for my $v (split /,/, $vfull) { + next unless $v =~ m/.=./; + push @x, $v; + } + } + push @x, ""; # catch all + return @x; +} + +sub get_bug_order_index { + my $order = shift; + my $status = shift; + my $pos = -1; + + my %tags = (); + %tags = map { $_, 1 } split / /, $status->{"tags"} + if defined $status->{"tags"}; + + for my $el (@${order}) { + $pos++; + my $match = 1; + for my $item (split /[+]/, $el) { + my ($f, $v) = split /=/, $item, 2; + next unless (defined $f and defined $v); + my $isokay = 0; + $isokay = 1 if (defined $status->{$f} and $v eq $status->{$f}); + $isokay = 1 if ($f eq "tag" && defined $tags{$v}); + unless ($isokay) { + $match = 0; + last; + } + } + if ($match) { + return $pos; + last; + } + } + return $pos + 1; +} + +sub buglinklist { + my ($prefix, $infix, @els) = @_; + return '' if not @els; + return $prefix . bug_linklist($infix,'submitter',@els); +} + + +# sets: my @names; my @prior; my @title; my @order; + +sub determine_ordering { + my %param = validate_with(params => \@_, + spec => {cats => {type => HASHREF, + }, + param => {type => HASHREF, + }, + ordering => {type => SCALARREF, + }, + names => {type => ARRAYREF, + }, + pend_rev => {type => BOOLEAN, + default => 0, + }, + sev_rev => {type => BOOLEAN, + default => 0, + }, + prior => {type => ARRAYREF, + }, + title => {type => ARRAYREF, + }, + order => {type => ARRAYREF, + }, + }, + ); + $param{cats}{status}[0]{ord} = [ reverse @{$param{cats}{status}[0]{ord}} ] + if ($param{pend_rev}); + $param{cats}{severity}[0]{ord} = [ reverse @{$param{cats}{severity}[0]{ord}} ] + if ($param{sev_rev}); + + my $i; + if (defined $param{param}{"pri0"}) { + my @c = (); + $i = 0; + while (defined $param{param}{"pri$i"}) { + my $h = {}; + + my ($pri) = make_list($param{param}{"pri$i"}); + if ($pri =~ m/^([^:]*):(.*)$/) { + $h->{"nam"} = $1; # overridden later if necesary + $h->{"pri"} = [ map { "$1=$_" } (split /,/, $2) ]; + } + else { + $h->{"pri"} = [ split /,/, $pri ]; + } + + ($h->{"nam"}) = make_list($param{param}{"nam$i"}) + if (defined $param{param}{"nam$i"}); + $h->{"ord"} = [ map {split /\s*,\s*/} make_list($param{param}{"ord$i"}) ] + if (defined $param{param}{"ord$i"}); + $h->{"ttl"} = [ map {split /\s*,\s*/} make_list($param{param}{"ttl$i"}) ] + if (defined $param{param}{"ttl$i"}); + + push @c, $h; + $i++; + } + $param{cats}{"_"} = [@c]; + ${$param{ordering}} = "_"; + } + + ${$param{ordering}} = "normal" unless defined $param{cats}{${$param{ordering}}}; + + sub get_ordering { + my @res; + my $cats = shift; + my $o = shift; + for my $c (@{$cats->{$o}}) { + if (ref($c) eq "HASH") { + push @res, $c; + } + else { + push @res, get_ordering($cats, $c); + } + } + return @res; + } + my @cats = get_ordering($param{cats}, ${$param{ordering}}); + + sub toenglish { + my $expr = shift; + $expr =~ s/[+]/ and /g; + $expr =~ s/[a-z]+=//g; + return $expr; + } + + $i = 0; + for my $c (@cats) { + $i++; + push @{$param{prior}}, $c->{"pri"}; + push @{$param{names}}, ($c->{"nam"} || "Bug attribute #" . $i); + if (defined $c->{"ord"}) { + push @{$param{order}}, $c->{"ord"}; + } + else { + push @{$param{order}}, [ 0..$#{$param{prior}[-1]} ]; + } + my @t = @{ $c->{"ttl"} } if defined $c->{ttl}; + if (@t < $#{$param{prior}[-1]}) { + push @t, map { toenglish($param{prior}[-1][$_]) } @t..($#{$param{prior}[-1]}); + } + push @t, $c->{"def"} || ""; + push @{$param{title}}, [@t]; + } +} + + + + +1; + + +__END__ + + + + + + diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm index bb42bf8..f4a3f0c 100644 --- a/Debbugs/Common.pm +++ b/Debbugs/Common.pm @@ -43,10 +43,10 @@ BEGIN{ qw(getmaintainers_reverse), qw(getpseudodesc), ], - misc => [qw(make_list)], + misc => [qw(make_list globify_scalar)], date => [qw(secs_to_english)], quit => [qw(quit)], - lock => [qw(filelock unfilelock @cleanups lockpid)], + lock => [qw(filelock unfilelock lockpid)], ); @EXPORT_OK = (); Exporter::export_ok_tags(qw(lock quit date util misc)); @@ -54,8 +54,12 @@ BEGIN{ } #use Debbugs::Config qw(:globals); + +use Carp; + use Debbugs::Config qw(:config); use IO::File; +use IO::Scalar; use Debbugs::MIME qw(decode_rfc1522); use Mail::Address; use Cwd qw(cwd); @@ -178,14 +182,11 @@ Opens a file for appending and writes data to it. =cut sub appendfile { - my $file = shift; - if (!open(AP,">>$file")) { - print $DEBUG_FH "failed open log<\n" if $DEBUG; - print $DEBUG_FH "failed open log err $!<\n" if $DEBUG; - &quit("opening $file (appendfile): $!"); - } - print(AP @_) || &quit("writing $file (appendfile): $!"); - close(AP) || &quit("closing $file (appendfile): $!"); + my ($file,@data) = @_; + my $fh = IO::File->new($file,'a') or + die "Unable top open $file for appending: $!"; + print {$fh} @data or die "Unable to write to $file: $!"; + close $fh or die "Unable to close $file: $!"; } =head2 getparsedaddrs @@ -214,6 +215,14 @@ sub getparsedaddrs { return wantarray?@{$_parsedaddrs{$addr}}:$_parsedaddrs{$addr}[0]; } +=head2 getmaintainers + + my $maintainer = getmaintainers()->{debbugs} + +Returns a hashref of package => maintainer pairs. + +=cut + our $_maintainer; our $_maintainer_rev; sub getmaintainers { @@ -222,8 +231,8 @@ sub getmaintainers { my %maintainer_rev; for my $file (@config{qw(maintainer_file maintainer_file_override pseduo_maint_file)}) { next unless defined $file; - my $maintfile = new IO::File $file,'r' or - &quitcgi("Unable to open $file: $!"); + my $maintfile = IO::File->new($file,'r') or + die "Unable to open maintainer file $file: $!"; while(<$maintfile>) { next unless m/^(\S+)\s+(\S.*\S)\s*$/; ($a,$b)=($1,$2); @@ -239,6 +248,15 @@ sub getmaintainers { $_maintainer_rev = \%maintainer_rev; return $_maintainer; } + +=head2 getmaintainers_reverse + + my @packages = @{getmaintainers_reverse->{'don@debian.org'}||[]}; + +Returns a hashref of maintainer => [qw(list of packages)] pairs. + +=cut + sub getmaintainers_reverse{ return $_maintainer_rev if $_maintainer_rev; getmaintainers(); @@ -319,7 +337,6 @@ FLOCKs the passed file. Use unfilelock to unlock it. =cut our @filelocks; -our @cleanups; sub filelock { # NB - NOT COMPATIBLE WITH `with-lock' @@ -346,11 +363,17 @@ sub filelock { } if (--$count <=0) { $errors =~ s/\n+$//; - &quit("failed to get lock on $lockfile -- $errors"); + die "failed to get lock on $lockfile -- $errors"; } sleep 10; } - push(@cleanups,\&unfilelock); +} + +# clean up all outstanding locks at end time +END { + while (@filelocks) { + unfilelock(); + } } @@ -371,7 +394,6 @@ sub unfilelock { return; } my %fl = %{pop(@filelocks)}; - pop(@cleanups); flock($fl{fh},LOCK_UN) or warn "Unable to unlock lockfile $fl{file}: $!"; close($fl{fh}) @@ -380,6 +402,7 @@ sub unfilelock { or warn "Unable to unlink lockfile $fl{file}: $!"; } + =head2 lockpid lockpid('/path/to/pidfile'); @@ -422,20 +445,18 @@ These functions are exported with the :quit tag. quit() -Exits the program by calling die after running some cleanups. +Exits the program by calling die. -This should be replaced with an END handler which runs the cleanups -instead. (Or possibly a die handler, if the cleanups are important) +Usage of quit is deprecated; just call die instead. =cut sub quit { - print $DEBUG_FH "quitting >$_[0]<\n" if $DEBUG; - my ($u); - while ($u= $cleanups[$#cleanups]) { &$u; } - die "*** $_[0]\n"; + print {$DEBUG_FH} "quitting >$_[0]<\n" if $DEBUG; + carp "quit() is deprecated; call die directly instead"; } + =head1 MISC These functions are exported with the :misc tag @@ -457,6 +478,42 @@ sub make_list { } +=head2 globify_scalar + + my $handle = globify_scalar(\$foo); + +if $foo isn't already a glob or a globref, turn it into one using +IO::Scalar. Gives a new handle to /dev/null if $foo isn't defined. + +Will carp if given a scalar which isn't a scalarref or a glob (or +globref), and return /dev/null. May return undef if IO::Scalar or +IO::File fails. (Check $!) + +=cut + +sub globify_scalar { + my ($scalar) = @_; + my $handle; + if (defined $scalar) { + if (defined ref($scalar)) { + if (ref($scalar) eq 'SCALAR' and + not UNIVERSAL::isa($scalar,'GLOB')) { + return IO::Scalar->new($scalar); + } + else { + return $scalar; + } + } + elsif (UNIVERSAL::isa(\$scalar,'GLOB')) { + return $scalar; + } + else { + carp "Given a non-scalar reference, non-glob to globify_scalar; returning /dev/null handle"; + } + } + return IO::File->new('/dev/null','w'); +} + 1; diff --git a/Debbugs/Config.pm b/Debbugs/Config.pm index 5f2936a..2a34f18 100644 --- a/Debbugs/Config.pm +++ b/Debbugs/Config.pm @@ -50,6 +50,7 @@ BEGIN { qw($gSubmitList $gMaintList $gQuietList $gForwardList), qw($gDoneList $gRequestList $gSubmitterList $gControlList), qw($gStrongList), + qw($gBugSubscriptionDomain), qw($gPackageVersionRe), qw($gSummaryList $gMirrorList $gMailer $gBug), qw($gBugs $gRemoveAge $gSaveOldBugs $gDefaultSeverity), @@ -60,14 +61,16 @@ BEGIN { qw($gVersionTimeIndex), qw($gSendmail $gLibPath $gSpamScan @gExcludeFromControl), qw(%gSeverityDisplay @gTags @gSeverityList @gStrongSeverities), + qw(%gTagsSingleLetter), qw(%gSearchEstraier), qw(%gDistributionAliases), + qw(%gObsoleteSeverities), qw(@gPostProcessall @gRemovalDefaultDistributionTags @gRemovalDistributionTags @gRemovalArchitectures), qw(@gRemovalStrongSeverityDefaultDistributionTags), qw(@gDefaultArchitectures), qw($gTemplateDir), qw($gDefaultPackage), - qw($gSpamMaxThreads $gSpamSpamsPerThread $gSpamKeepRunning $gSpamScan $gSpamCrossassassinDb) + qw($gSpamMaxThreads $gSpamSpamsPerThread $gSpamKeepRunning $gSpamScan $gSpamCrossassassinDb), ], text => [qw($gBadEmailPrefix $gHTMLTail $gHTMLExpireNote), ], @@ -76,6 +79,7 @@ BEGIN { @EXPORT_OK = (); Exporter::export_ok_tags(qw(globals text config)); $EXPORT_TAGS{all} = [@EXPORT_OK]; + $ENV{HOME} = '' if not defined $ENV{HOME}; } use File::Basename qw(dirname); @@ -295,8 +299,6 @@ set_default(\%config,'unknown_maintainer_email',$config{maintainer_email}); =item mirror_list -=back - =cut set_default(\%config, 'submit_list', 'bug-submit-list'); @@ -311,6 +313,21 @@ set_default(\%config, 'summary_list', 'bug-summary-list'); set_default(\%config, 'mirror_list', 'bug-mirror-list'); set_default(\%config, 'strong_list', 'bug-strong-list'); +=item bug_subscription_domain + +Domain of list for messages regarding a single bug; prefixed with +bug=${bugnum}@ when bugs are actually sent out. Set to undef or '' to +disable sending messages to the bug subscription list. + +Default: list_domain + +=back + +=cut + +set_default(\%config,'bug_subscription_domain',$config{list_domain}); + + =head2 Misc Options =over @@ -400,6 +417,18 @@ set_default(\%config,'default_architectures', [qw(i386 amd64 arm powerpc sparc alpha)] ); +=item removal_unremovable_tags + +Bugs which have these tags set cannot be archived + +Default: [] + +=cut + +set_default(\%config,'removal_unremovable_tags', + [], + ); + =item removal_distribution_tags Tags which specifiy distributions to check @@ -530,27 +559,115 @@ set_default(\%config,'exclude_from_control',[]); +=item default_severity + +The default severity of bugs which have no severity set + +Default: normal + +=cut set_default(\%config,'default_severity','normal'); -set_default(\%config,'show_severities','critical, grave, normal, minor, wishlist'); -set_default(\%config,'strong_severities',[qw(critical grave)]); -set_default(\%config,'severity_list',[qw(critical grave normal wishlist)]); + +=item severity_display + +A hashref of severities and the informative text which describes them. + +Default: + + {critical => "Critical $config{bugs}", + grave => "Grave $config{bugs}", + normal => "Normal $config{bugs}", + wishlist => "Wishlist $config{bugs}", + } + +=cut + set_default(\%config,'severity_display',{critical => "Critical $config{bugs}", grave => "Grave $config{bugs}", normal => "Normal $config{bugs}", wishlist => "Wishlist $config{bugs}", }); +=item show_severities + +A scalar list of the severities to show + +Defaults to the concatenation of the keys of the severity_display +hashlist with ', ' above. + +=cut + +set_default(\%config,'show_severities',join(', ',keys %{$config{severity_display}})); + +=item strong_severities + +An arrayref of the serious severities which shoud be emphasized + +Default: [qw(critical grave)] + +=cut + +set_default(\%config,'strong_severities',[qw(critical grave)]); + +=item severity_list + +An arrayref of a list of the severities + +Defaults to the keys of the severity display hashref + +=cut + +set_default(\%config,'severity_list',[keys %{$config{severity_display}}]); + +=item obsolete_severities + +A hashref of obsolete severities with the replacing severity + +Default: {} + +=cut + +set_default(\%config,'obsolete_severities',{}); + +=item tags + +An arrayref of the tags used + +Default: [qw(patch wontfix moreinfo unreproducible fixed)] and also +includes the distributions. + +=cut + set_default(\%config,'tags',[qw(patch wontfix moreinfo unreproducible fixed), @{$config{distributions}} ]); +set_default(\%config,'tags_single_letter', + {patch => '+', + wontfix => '', + moreinfo => 'M', + unreproducible => 'R', + fixed => 'F', + } + ); + set_default(\%config,'bounce_froms','^mailer|^da?emon|^post.*mast|^root|^wpuser|^mmdf|^smt.*|'. '^mrgate|^vmmail|^mail.*system|^uucp|-maiser-|^mal\@|'. '^mail.*agent|^tcpmail|^bitmail|^mailman'); set_default(\%config,'config_dir',dirname(exists $ENV{DEBBUGS_CONFIG_FILE}?$ENV{DEBBUGS_CONFIG_FILE}:'/etc/debbugs/config')); set_default(\%config,'spool_dir','/var/lib/debbugs/spool'); + +=item usertag_dir + +Directory which contains the usertags + +Default: $config{spool_dir}/user + +=cut + +set_default(\%config,'usertag_dir',$config{spool_dir}.'/user'); set_default(\%config,'incoming_dir','incoming'); set_default(\%config,'web_dir','/var/lib/debbugs/www'); set_default(\%config,'doc_dir','/var/lib/debbugs/www/txt'); @@ -729,7 +846,6 @@ Site rules directory for spamassassin, defaults to set_default(\%config,'spam_rules_dir','/usr/share/spamassassin'); - =back @@ -768,6 +884,8 @@ set_default(\%config,'text_instructions',$config{bad_email_prefix}); This shows up at the end of (most) html pages +In many pages this has been replaced by the html/tail template. + =cut set_default(\%config,'html_tail',< [qw(bug_archive bug_unarchive), + %EXPORT_TAGS = (owner => [qw(owner)], + archive => [qw(bug_archive bug_unarchive), ], log => [qw(append_action_to_log), ], ); @EXPORT_OK = (); - Exporter::export_ok_tags(qw(archive log)); + Exporter::export_ok_tags(keys %EXPORT_TAGS); $EXPORT_TAGS{all} = [@EXPORT_OK]; } use Debbugs::Config qw(:config); -use Debbugs::Common qw(:lock buglog make_list get_hashname); +use Debbugs::Common qw(:lock buglog :misc get_hashname); use Debbugs::Status qw(bug_archiveable :read :hook writebug); use Debbugs::CGI qw(html_escape); use Debbugs::Log qw(:misc); +use Debbugs::Recipients qw(:add); use Params::Validate qw(validate_with :types); use File::Path qw(mkpath); use IO::File; -use IO::Scalar; use Debbugs::Text qw(:templates); @@ -105,17 +106,28 @@ use Debbugs::Mail qw(rfc822_date); use POSIX qw(strftime); +use Carp; + # These are a set of options which are common to all of these functions -my %common_options = (debug => {type => SCALARREF, +my %common_options = (debug => {type => SCALARREF|HANDLE, optional => 1, }, - transcript => {type => SCALARREF, + transcript => {type => SCALARREF|HANDLE, optional => 1, }, affected_bugs => {type => HASHREF, optional => 1, }, + affected_packages => {type => HASHREF, + optional => 1, + }, + recipients => {type => HASHREF, + default => {}, + }, + limit => {type => HASHREF, + default => {}, + }, ); @@ -144,6 +156,127 @@ my %append_action_options = ); +# this is just a generic stub for Debbugs::Control functions. +# sub foo { +# my %param = validate_with(params => \@_, +# spec => {bug => {type => SCALAR, +# regex => qr/^\d+$/, +# }, +# # specific options here +# %common_options, +# %append_action_options, +# }, +# ); +# our $locks = 0; +# $locks = 0; +# local $SIG{__DIE__} = sub { +# if ($locks) { +# for (1..$locks) { unfilelock(); } +# $locks = 0; +# } +# }; +# my ($debug,$transcript) = __handle_debug_transcript(%param); +# my (@data); +# ($locks, @data) = lock_read_all_merged_bugs($param{bug}); +# __handle_affected_packages(data => \@data,%param); +# add_recipients(data => \@data, +# recipients => $param{recipients} +# ); +# } + +=head1 OWNER FUNCTIONS + +=head2 owner + + 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 having an owner: $@"; + } + +Handles all setting of the owner field; given an owner of undef or of +no length, indicates that a bug is not owned by anyone. + +=cut + +sub owner { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + owner => {type => SCALAR|UNDEF, + }, + %common_options, + %append_action_options, + }, + ); + our $locks = 0; + $locks = 0; + local $SIG{__DIE__} = sub { + if ($locks) { + for (1..$locks) { unfilelock(); } + $locks = 0; + } + }; + my ($debug,$transcript) = __handle_debug_transcript(%param); + my (@data); + ($locks, @data) = lock_read_all_merged_bugs($param{bug}); + __handle_affected_packages(data => \@data,%param); + @data and defined $data[0] or die "No bug found for $param{bug}"; + add_recipients(data => \@data, + recipients => $param{recipients} + ); + my $action = ''; + for my $data (@data) { + print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n"; + print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n"; + if (not defined $param{owner} or not length $param{owner}) { + $param{owner} = ''; + $action = "Removed annotation that $config{bug} was owned by " . + "$data->{owner}."; + } + else { + if (length $data->{owner}) { + $action = "Owner changed from $data->{owner} to $param{owner}."; + } + else { + $action = "Owner recorded as $param{owner}." + } + } + $data->{owner} = $param{owner}; + append_action_to_log(bug => $data->{bug_num}, + get_lock => 0, + __return_append_to_log_options( + %param, + action => $action, + ), + ) + if not exists $param{append_log} or $param{append_log}; + writebug($data->{bug_num},$data); + print {$transcript} "$action\n"; + add_recipients(data => $data, + recipients => $param{recipients}, + ); + } + if ($locks) { + for (1..$locks) { unfilelock(); } + } +} + + +=head1 ARCHIVE FUNCTIONS + + =head2 bug_archive my $error = ''; @@ -163,6 +296,22 @@ my %append_action_options = This routine archives a bug +=over + +=item bug -- bug number + +=item check_archiveable -- check wether a bug is archiveable before +archiving; defaults to 1 + +=item archive_unarchived -- whether to archive bugs which have not +previously been archived; defaults to 1. [Set to 0 when used from +control@] + +=item ignore_time -- whether to ignore time constraints when archiving +a bug; defaults to 0. + +=back + =cut sub bug_archive { @@ -173,6 +322,9 @@ sub bug_archive { check_archiveable => {type => BOOLEAN, default => 1, }, + archive_unarchived => {type => BOOLEAN, + default => 1, + }, ignore_time => {type => BOOLEAN, default => 0, }, @@ -181,6 +333,7 @@ sub bug_archive { }, ); our $locks = 0; + $locks = 0; local $SIG{__DIE__} = sub { if ($locks) { for (1..$locks) { unfilelock(); } @@ -197,41 +350,31 @@ sub bug_archive { die "Bug $param{bug} cannot be archived"; } print {$debug} "$param{bug} considering\n"; - my ($data); - ($locks, $data) = lockreadbugmerge($param{bug}); + my (@data); + ($locks, @data) = lock_read_all_merged_bugs($param{bug}); + __handle_affected_packages(data => \@data,%param); print {$debug} "$param{bug} read $locks\n"; - defined $data or die "No bug found for $param{bug}"; - print {$debug} "$param{bug} read ok (done $data->{done})\n"; + @data and defined $data[0] or die "No bug found for $param{bug}"; print {$debug} "$param{bug} read done\n"; - my @bugs = ($param{bug}); - # my %bugs; - # @bugs{@bugs} = (1) x @bugs; - if (length($data->{mergedwith})) { - push(@bugs,split / /,$data->{mergedwith}); + + if (not $param{archive_unarchived} and + not exists $data[0]{unarchived} + ) { + print {$transcript} "$param{bug} has not been archived previously\n"; + die "$param{bug} has not been archived previously"; } + add_recipients(recipients => $param{recipients}, + data => \@data, + ); + my @bugs = map {$_->{bug_num}} @data; print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n"; for my $bug (@bugs) { - my $newdata; - print {$debug} "$param{bug} $bug check\n"; - if ($bug != $param{bug}) { - print {$debug} "$param{bug} $bug reading\n"; - $newdata = lockreadbug($bug) || die "huh $bug ?"; - print {$debug} "$param{bug} $bug read ok\n"; - $locks++; - } else { - $newdata = $data; - } - print {$debug} "$param{bug} $bug read/not\n"; - my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs)); - $newdata->{mergedwith} eq $expectmerge || - die "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")"; - print {$debug} "$param{bug} $bug merge-ok\n"; - if ($param{check_archiveable}) { - die "Bug $bug cannot be archived (but $param{bug} can?)" - unless bug_archiveable(bug=>$bug, - ignore_time => $param{ignore_time}, - ); - } + if ($param{check_archiveable}) { + die "Bug $bug cannot be archived (but $param{bug} can?)" + unless bug_archiveable(bug=>$bug, + ignore_time => $param{ignore_time}, + ); + } } # If we get here, we can archive/remove this bug print {$debug} "$param{bug} removing\n"; @@ -242,23 +385,22 @@ sub bug_archive { append_action_to_log(bug => $bug, get_lock => 0, __return_append_to_log_options( - (map {exists $param{$_}?($_,$param{$_}):()} - keys %append_action_options, - ), + %param, action => $action, ) ) if not exists $param{append_log} or $param{append_log}; - my @files_to_remove = map {s#db-h/$dir/##; $_} glob("db-h/$dir/$bug.*"); + my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*"); if ($config{save_old_bugs}) { - mkpath("archive/$dir"); + mkpath("$config{spool_dir}/archive/$dir"); foreach my $file (@files_to_remove) { - link( "db-h/$dir/$file", "archive/$dir/$file" ) || copy( "db-h/$dir/$file", "archive/$dir/$file" ); + link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or + copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ); } print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n"; } - unlink(map {"db-h/$dir/$_"} @files_to_remove); + unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove); print {$transcript} "deleted $bug (from $param{bug})\n"; } bughook_archive(@bugs); @@ -300,58 +442,41 @@ sub bug_unarchive { %append_action_options, }, ); + our $locks = 0; + local $SIG{__DIE__} = sub { + if ($locks) { + for (1..$locks) { unfilelock(); } + $locks = 0; + } + }; my $action = "$config{bug} unarchived."; my ($debug,$transcript) = __handle_debug_transcript(%param); print {$debug} "$param{bug} considering\n"; - my ($locks, $data) = lockreadbugmerge($param{bug},'archive'); + my @data = (); + ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive'); + __handle_affected_packages(data => \@data,%param); print {$debug} "$param{bug} read $locks\n"; - if (not defined $data) { - print {$transcript} "No bug found for $param{bug}\n"; - die "No bug found for $param{bug}"; + if (not @data or not defined $data[0]) { + print {$transcript} "No bug found for $param{bug}\n"; + die "No bug found for $param{bug}"; } - print {$debug} "$param{bug} read ok (done $data->{done})\n"; print {$debug} "$param{bug} read done\n"; - my @bugs = ($param{bug}); - # my %bugs; - # @bugs{@bugs} = (1) x @bugs; - if (length($data->{mergedwith})) { - push(@bugs,split / /,$data->{mergedwith}); - } + my @bugs = map {$_->{bug_num}} @data; print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n"; - for my $bug (@bugs) { - my $newdata; - print {$debug} "$param{bug} $bug check\n"; - if ($bug != $param{bug}) { - print {$debug} "$param{bug} $bug reading\n"; - $newdata = lockreadbug($bug,'archive') or die "huh $bug ?"; - print {$debug} "$param{bug} $bug read ok\n"; - $locks++; - } else { - $newdata = $data; - } - print {$debug} "$param{bug} $bug read/not\n"; - my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs)); - if ($newdata->{mergedwith} ne $expectmerge ) { - print {$transcript} "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (@bugs)"; - die "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (@bugs)"; - } - print {$debug} "$param{bug} $bug merge-ok\n"; - } - # If we get here, we can archive/remove this bug - print {$debug} "$param{bug} removing\n"; + print {$debug} "$param{bug} unarchiving\n"; my @files_to_remove; for my $bug (@bugs) { print {$debug} "$param{bug} removing $bug\n"; my $dir = get_hashname($bug); - my @files_to_copy = map {s#archive/$dir/##; $_} glob("archive/$dir/$bug.*"); + my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*"); mkpath("archive/$dir"); foreach my $file (@files_to_copy) { # die'ing here sucks - link( "archive/$dir/$file", "db-h/$dir/$file" ) or - copy( "archive/$dir/$file", "db-h/$dir/$file" ) or - die "Unable to copy archive/$dir/$file to db-h/$dir/$file"; + link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or + copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or + die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file"; } - push @files_to_remove, map {"archive/$dir/$_"} @files_to_copy; + push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy; print {$transcript} "Unarchived $config{bug} $bug\n"; } unlink(@files_to_remove) or die "Unable to unlink bugs"; @@ -366,14 +491,15 @@ sub bug_unarchive { append_action_to_log(bug => $bug, get_lock => 0, __return_append_to_log_options( - (map {exists $param{$_}?($_,$param{$_}):()} - keys %append_action_options, - ), + %param, action => $action, ) ) if not exists $param{append_log} or $param{append_log}; writebug($bug,$newdata); + add_recipients(recipients => $param{recipients}, + data => $newdata, + ); } print {$debug} "$param{bug} unlocking $locks\n"; if ($locks) { @@ -443,11 +569,34 @@ sub append_action_to_log{ =head1 PRIVATE FUNCTIONS +=head2 __handle_affected_packages + + __handle_affected_packages(affected_packages => {}, + data => [@data], + ) + + + +=cut + +sub __handle_affected_packages{ + my %param = validate_with(params => \@_, + spec => {%common_options, + data => {type => ARRAYREF|HASHREF + }, + }, + allow_extra => 1, + ); + for my $data (make_list($param{data})) { + $param{affected_packages}{$data->{package}} = 1; + } +} + =head2 __handle_debug_transcript my ($debug,$transcript) = __handle_debug_transcript(%param); -Returns a debug and transcript IO::Scalar filehandle +Returns a debug and transcript filehandle =cut @@ -457,16 +606,14 @@ sub __handle_debug_transcript{ spec => {%common_options}, allow_extra => 1, ); - my $fake_scalar; - my $debug = IO::Scalar->new(exists $param{debug}?$param{debug}:\$fake_scalar); - my $transcript = IO::Scalar->new(exists $param{transcript}?$param{transcript}:\$fake_scalar); + my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef); + my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef); return ($debug,$transcript); - } sub __return_append_to_log_options{ my %param = @_; - my $action = 'Unknown action'; + my $action = $param{action} if exists $param{action}; if (not exists $param{requester}) { $param{requester} = $config{control_internal_requester}; } @@ -474,7 +621,6 @@ sub __return_append_to_log_options{ $param{request_addr} = $config{control_internal_request_addr}; } if (not exists $param{message}) { - $action = $param{action} if exists $param{action}; my $date = rfc822_date(); $param{message} = fill_in_template(template => 'mail/fake_control_message', variables => {request_addr => $param{request_addr}, @@ -484,8 +630,14 @@ sub __return_append_to_log_options{ }, ); } + if (not defined $action) { + carp "Undefined action!"; + $action = "unknown action"; + } return (action => $action, - %param); + (map {exists $append_action_options{$_}?($_,$param{$_}):()} + keys %param), + ); } diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm index 35881c4..c4d741e 100644 --- a/Debbugs/Log.pm +++ b/Debbugs/Log.pm @@ -35,6 +35,11 @@ BEGIN { $EXPORT_TAGS{all} = [@EXPORT_OK]; } +use Carp; + +use Debbugs::Common qw(getbuglocation getbugcomponent); +use Params::Validate qw(:types validate_with); + =head1 NAME Debbugs::Log - an interface to debbugs .log files @@ -132,15 +137,69 @@ C<[html]> as above; C is a reference to an array of recipients Creates a new log reader based on a .log filehandle. + my $log = Debbugs::Log->new($logfh); + my $log = Debbugs::Log->new(bug_num => $nnn); + my $log = Debbugs::Log->new(logfh => $logfh); + +Parameters + +=over + +=item bug_num -- bug number + +=item logfh -- log filehandle + +=item log_name -- name of log + +=back + +One of the above options must be passed. + =cut sub new { my $this = shift; + my %param; + if (@_ == 1) { + ($param{logfh}) = @_; + } + else { + %param = validate_with(params => \@_, + spec => {bug_num => {type => SCALAR, + optional => 1, + }, + logfh => {type => SCALAR, + optional => 1, + }, + log_name => {type => SCALAR, + optional => 1, + }, + } + ); + } + if (grep({exists $param{$_} and defined $param{$_}} qw(bug_num logfh log_name)) ne 1) { + croak "Exactly one of bug_num, logfh, or log_name must be passed and must be defined"; + } + my $class = ref($this) || $this; my $self = {}; bless $self, $class; - $self->{logfh} = shift; + + if (exists $param{logfh}) { + $self->{logfh} = $param{logfh} + } + elsif (exists $param{log_name}) { + $self->{logfh} = IO::File->new($param{log_name},'r') or + die "Unable to open bug log $param{log_name} for reading: $!"; + } + elsif (exists $param{bug_num}) { + my $location = getbuglocation($param{bug_num},'log'); + my $bug_log = getbugcomponent($param{bug_num},'log',$location); + $self->{logfh} = IO::File->new($bug_log, 'r') or + die "Unable to open bug log $bug_log for reading: $!"; + } + $self->{state} = 'kill-init'; $self->{linenum} = 0; return $self; diff --git a/Debbugs/MIME.pm b/Debbugs/MIME.pm index 183adc7..7859974 100644 --- a/Debbugs/MIME.pm +++ b/Debbugs/MIME.pm @@ -56,12 +56,12 @@ sub getmailbody return undef; } -sub parse ($) +sub parse { # header and decoded body respectively my (@headerlines, @bodylines); - my $parser = new MIME::Parser; + my $parser = MIME::Parser->new(); mkdir "mime.tmp.$$", 0777; $parser->output_under("mime.tmp.$$"); my $entity = eval { $parser->parse_data($_[0]) }; @@ -215,8 +215,7 @@ BEGIN { ])); } -sub decode_rfc1522 ($) -{ +sub decode_rfc1522 { my ($string) = @_; # this is craptacular, but leading space is hacked off by unmime. @@ -240,7 +239,7 @@ MIME::Words::encode_mimeword on distinct words as appropriate. # We cannot use MIME::Words::encode_mimewords because that function # does not handle spaces properly at all. -sub encode_rfc1522 ($) { +sub encode_rfc1522 { my ($rawstr) = @_; # handle being passed undef properly diff --git a/Debbugs/Packages.pm b/Debbugs/Packages.pm index 0bceb72..191b453 100644 --- a/Debbugs/Packages.pm +++ b/Debbugs/Packages.pm @@ -12,11 +12,11 @@ package Debbugs::Packages; use warnings; use strict; -use Debbugs::Config qw(:config :globals); - use base qw(Exporter); use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT); +use Debbugs::Config qw(:config :globals); + BEGIN { $VERSION = 1.00; @@ -39,6 +39,8 @@ use Debbugs::Common qw(make_list); use List::Util qw(min max); +use IO::File; + $MLDBM::DumpMeth = 'portable'; $MLDBM::RemoveTaint = 1; @@ -75,17 +77,17 @@ sub getpkgsrc { my %pkgcomponent; my %srcpkg; - open(MM,"$Debbugs::Packages::gPackageSource") - or die("open $Debbugs::Packages::gPackageSource: $!"); - while() { + my $fh = IO::File->new($config{package_source},'r') + or die("Unable to open $config{package_source} for reading: $!"); + while(<$fh>) { next unless m/^(\S+)\s+(\S+)\s+(\S.*\S)\s*$/; my ($bin,$cmp,$src)=($1,$2,$3); - $bin =~ y/A-Z/a-z/; + $bin = lc($bin); $pkgsrc{$bin}= $src; push @{$srcpkg{$src}}, $bin; $pkgcomponent{$bin}= $cmp; } - close(MM); + close($fh); $_pkgsrc = \%pkgsrc; $_pkgcomponent = \%pkgcomponent; $_srcpkg = \%srcpkg; diff --git a/Debbugs/Recipients.pm b/Debbugs/Recipients.pm new file mode 100644 index 0000000..4922c3d --- /dev/null +++ b/Debbugs/Recipients.pm @@ -0,0 +1,371 @@ +# This module is part of debbugs, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# Copyright 2008 by Don Armstrong . +# $Id: perl_module_header.pm 1221 2008-05-19 15:00:40Z don $ + +package Debbugs::Recipients; + +=head1 NAME + +Debbugs::Recipients -- Determine recipients of messages from the bts + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +BEGIN{ + ($VERSION) = q$Revision: 1221 $ =~ /^Revision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (add => [qw(add_recipients)], + det => [qw(determine_recipients)], + ); + @EXPORT_OK = (); + Exporter::export_ok_tags(keys %EXPORT_TAGS); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +use Debbugs::Config qw(:config); +use Params::Validate qw(:types validate_with); +use Debbugs::Common qw(:misc :util); +use Debbugs::Status qw(splitpackages isstrongseverity); + +use Debbugs::Mail qw(get_addresses); + +use Carp; + +=head2 add_recipients + + add_recipients(data => $data, + recipients => \%recipients; + ); + +Given data (from read_bug or similar) (or an arrayref of data), +calculates the addresses which need to receive mail involving this +bug. + +=over + +=item data -- Data from read_bug or similar; can be an arrayref of data + +=item recipients -- hashref of recipient data structure; pass to +subsequent calls of add_recipients or + +=item debug -- optional + + +=back + +=cut + + +sub add_recipients { + # Data structure is: + # maintainer email address &c -> assoc of packages -> assoc of bug#'s + my %param = validate_with(params => \@_, + spec => {data => {type => HASHREF|ARRAYREF, + }, + recipients => {type => HASHREF, + }, + debug => {type => HANDLE|SCALARREF, + optional => 1, + }, + transcript => {type => HANDLE|SCALARREF, + optional => 1, + }, + actions_taken => {type => HASHREF, + default => {}, + }, + }, + ); + + $param{transcript} = globify_scalar($param{transcript}); + $param{debug} = globify_scalar($param{debug}); + if (ref ($param{data}) eq 'ARRAY') { + for my $data (@{$param{data}}) { + add_recipients(data => $data, + map {exists $param{$_}?($_,$param{$_}):()} + qw(recipients debug transcript actions_taken) + ); + } + return; + } + my ($p, $addmaint); + my $anymaintfound=0; my $anymaintnotfound=0; + my $ref = $param{data}{bug_num}; + for my $p (splitpackages($param{data}{package})) { + $p = lc($p); + if (defined $config{subscription_domain}) { + my @source_packages = binarytosource($p); + if (@source_packages) { + for my $source (@source_packages) { + _add_address(recipients => $param{recipients}, + address => "$source\@".$config{subscription_domain}, + reason => $source, + type => 'bcc', + ); + } + } + else { + _add_address(recipients => $param{recipients}, + address => "$p\@".$config{subscription_domain}, + reason => $p, + type => 'bcc', + ); + } + } + if (defined $param{data}{severity} and defined $config{strong_list} and + isstrongseverity($param{data}{severity})) { + _add_address(recipients => $param{recipients}, + address => "$config{strong_list}\@".$config{list_domain}, + reason => $param{data}{severity}, + type => 'bcc', + ); + } + if (defined(getmaintainers()->{$p})) { + $addmaint= getmaintainers()->{$p}; + print {$param{debug}} "MR|$addmaint|$p|$ref|\n"; + _add_address(recipients => $param{recipients}, + address => $addmaint, + reason => $p, + bug_num => $param{data}{bug_num}, + type => 'cc', + ); + print {$param{debug}} "maintainer add >$p|$addmaint<\n"; + } + else { + print {$param{debug}} "maintainer none >$p<\n"; + print {$param{transcript}} "Warning: Unknown package '$p'\n"; + print {$param{debug}} "MR|unknown-package|$p|$ref|\n"; + _add_address(recipients => $param{recipients}, + address => $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 (defined $config{bug_subscription_domain} and + length $config{bug_subscription_domain}) { + _add_address(recipients => $param{recipients}, + address => 'bug='.$param{data}{bug_num}.'@'. + $config{bug_subscription_domain}, + reason => "bug $param{data}{bug_num}", + bug_num => $param{data}{bug_num}, + type => 'bcc', + ); + } + + if (length $param{data}{owner}) { + $addmaint = $param{data}{owner}; + print {$param{debug}} "MO|$addmaint|$param{data}{package}|$ref|\n"; + _add_address(recipients => $param{recipients}, + address => $addmaint, + reason => "owner of $param{data}{bug_num}", + bug_num => $param{data}{bug_num}, + type => 'cc', + ); + print {$param{debug}} "owner add >$param{data}{package}|$addmaint<\n"; + } + if (exists $param{actions_taken}) { + if (exists $param{actions_taken}{done} and + $param{actions_taken}{done} and + length($config{done_list}) and + length($config{list_domain}) + ) { + _add_address(recipients => $param{recipients}, + type => 'cc', + address => $config{done_list}.'@'.$config{list_domain}, + bug_num => $param{data}{bug_num}, + reason => "bug $param{data}{bug_num} done", + ); + } + if (exists $param{actions_taken}{forwarded} and + $param{actions_taken}{forwarded} and + length($config{forward_list}) and + length($config{list_domain}) + ) { + _add_address(recipients => $param{recipients}, + type => 'cc', + address => $config{forward_list}.'@'.$config{list_domain}, + bug_num => $param{data}{bug_num}, + reason => "bug $param{data}{bug_num} forwarded", + ); + } + } +} + +=head2 determine_recipients + + my @recipients = determine_recipients(recipients => \%recipients, + bcc => 1, + ); + my %recipients => determine_recipients(recipients => \%recipients,); + + # or a crazy example: + send_mail_message(message => $message, + recipients => + [make_list( + values %{{determine_recipients( + recipients => \%recipients) + }}) + ], + ); + +Using the recipient hashref, determines the set of recipients. + +If you specify one of C, C, or C, you will receive only a +LIST of recipients which the main should be Bcc'ed, Cc'ed, or To'ed +respectively. By default, a LIST with keys bcc, cc, and to is returned +with ARRAYREF values correponding to the users to whom a message +should be sent. + +=over + +=item address_only -- whether to only return mail addresses without reasons or realnamesq + +=back + +Passing more than one of bcc, cc or to is a fatal error. + +=cut + +sub determine_recipients { + my %param = validate_with(params => \@_, + spec => {recipients => {type => HASHREF, + }, + bcc => {type => BOOLEAN, + default => 0, + }, + cc => {type => BOOLEAN, + default => 0, + }, + to => {type => BOOLEAN, + default => 0, + }, + address_only => {type => BOOLEAN, + default => 0, + } + }, + ); + + if (1 < scalar grep {$param{$_}} qw(to cc bcc)) { + croak "Passing more than one of to, cc, or bcc is non-sensical"; + } + + my %final_recipients; + # start with the to recipients + for my $addr (keys %{$param{recipients}}) { + my $level = 'bcc'; + my @reasons; + for my $reason (keys %{$param{recipients}{$addr}}) { + my @bugs; + for my $bug (keys %{$param{recipients}{$addr}{$reason}}) { + push @bugs, $bug; + my $t_level = $param{recipients}{$addr}{$reason}{$bug}; + if ($level eq 'to' or + $t_level eq 'to') { + $level = 'to'; + } + elsif ($t_level eq 'cc') { + $level = 'cc'; + } + } + # strip out all non-word non-spaces + $reason =~ s/[^\ \w]//g; + push @reasons, $reason . ' for {'.join(',',@bugs).'}'; + } + if ($param{address_only}) { + push @{$final_recipients{$level}}, get_addresses($addr); + } + else { + push @{$final_recipients{$level}}, $addr . ' ('.join(', ',@reasons).')'; + } + } + for (qw(to cc bcc)) { + if ($param{$_}) { + return @{$final_recipients{$_}}; + } + } + return %final_recipients; +} + + +=head1 PRIVATE FUNCTIONS + +=head2 _add_address + + _add_address(recipients => $param{recipients}, + address => $addmaint, + reason => $param{data}{package}, + bug_num => $param{data}{bug_num}, + type => 'cc', + ); + + +=cut + + +sub _add_address { + my %param = validate_with(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|to)$/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; + } + elsif (lc($param{type}) eq 'cc' and + exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} + and $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} eq 'to' + ) { + next; + } + $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} = lc($param{type}); + } +} + +1; + + +__END__ + + + + + + diff --git a/Debbugs/SOAP.pm b/Debbugs/SOAP.pm index 5f0138a..32e874e 100644 --- a/Debbugs/SOAP.pm +++ b/Debbugs/SOAP.pm @@ -225,13 +225,7 @@ sub get_bug_log{ my $VERSION = __populate_version(pop); my ($self,$bug,$msg_num) = @_; - my $location = getbuglocation($bug,'log'); - my $bug_log = getbugcomponent($bug,'log',$location); - - my $log_fh = IO::File->new($bug_log, 'r') or - die "Unable to open bug log $bug_log for reading: $!"; - - my $log = Debbugs::Log->new($log_fh) or + my $log = Debbugs::Log->new(bug_num => $bug) or die "Debbugs::Log was unable to be initialized"; my %seen_msg_ids; diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm index 73a1dbc..1a5e7ae 100644 --- a/Debbugs/Status.pm +++ b/Debbugs/Status.pm @@ -32,6 +32,7 @@ status of a particular bug use warnings; use strict; + use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); use base qw(Exporter); @@ -55,7 +56,9 @@ BEGIN{ %EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable), qw(isstrongseverity bug_presence), ], - read => [qw(readbug read_bug lockreadbug lockreadbugmerge)], + read => [qw(readbug read_bug lockreadbug lockreadbugmerge), + qw(lock_read_all_merged_bugs), + ], write => [qw(writebug makestatus unlockwritebug)], versions => [qw(addfoundversions addfixedversions), qw(removefoundversions removefixedversions) @@ -129,6 +132,10 @@ path to the summary file instead of the bug number and/or location. =item summary -- complete path to the .summary file which will be read +=item lock -- whether to obtain a lock for the bug to prevent +something modifying it while the bug has been read. You B call +C if something not undef is returned from read_bug. + =back One of C or C must be passed. This function will return @@ -154,6 +161,9 @@ sub read_bug{ summary => {type => SCALAR, optional => 1, }, + lock => {type => BOOLEAN, + optional => 1, + }, }, ); die "One of bug or summary must be passed to read_bug" @@ -178,8 +188,17 @@ sub read_bug{ $log =~ s/\.summary$/.log/; ($location) = $status =~ m/(db-h|db|archive)/; } - my $status_fh = new IO::File $status, 'r' or - warn "Unable to open $status for reading: $!" and return undef; + if ($param{lock}) { + filelock("$config{spool_dir}/lock/$param{bug}"); + } + my $status_fh = IO::File->new($status, 'r'); + if (not defined $status_fh) { + warn "Unable to open $status for reading: $!"; + if ($param{lock}) { + unfilelock(); + } + return undef; + } my %data; my @lines; @@ -193,7 +212,13 @@ sub read_bug{ } # Version 3 is the latest format version currently supported. - return undef if $version > 3; + if ($version > 3) { + warn "Unsupported status version '$version'"; + if ($param{lock}) { + unfilelock(); + } + return undef; + } my %namemap = reverse %fields; for my $line (@lines) { @@ -226,6 +251,8 @@ sub read_bug{ # Add log last modified time $data{log_modified} = (stat($log))[9]; $data{location} = $location; + $data{archived} = $location eq 'archive'; + $data{bug_num} = $param{bug}; return \%data; } @@ -244,10 +271,7 @@ See readbug above for information on what this returns sub lockreadbug { my ($lref, $location) = @_; - &filelock("lock/$lref"); - my $data = read_bug(bug => $lref, location => $location); - &unfilelock unless defined $data; - return $data; + return read_bug(bug => $lref, location => $location, lock => 1); } =head2 lockreadbugmerge @@ -270,7 +294,7 @@ sub lockreadbugmerge { return (1,$data); } unfilelock(); - filelock('lock/merge'); + filelock("$config{spool_dir}/lock/merge"); $data = lockreadbug(@_); if (not defined $data) { unfilelock(); @@ -279,6 +303,67 @@ sub lockreadbugmerge { return (2,$data); } +=head2 lock_read_all_merged_bugs + + my ($locks,@bug_data) = lock_read_all_merged_bugs($bug_num,$location); + +Performs a filelock, then reads the bug passed. If the bug is merged, +locks the merge lock, then reads and locks all of the other merged +bugs. Returns a list of the number of locks and the bug data for all +of the merged bugs. + +Will also return undef if any of the merged bugs failed to be read, +even if all of the others were read properly. + +=cut + +sub lock_read_all_merged_bugs { + my ($bug_num,$location) = @_; + my @data = (lockreadbug(@_)); + if (not @data and not defined $data[0]) { + return (0,undef); + } + if (not length $data[0]->{mergedwith}) { + return (1,@data); + } + unfilelock(); + filelock("$config{spool_dir}/lock/merge"); + my $locks = 0; + @data = (lockreadbug(@_)); + if (not @data and not defined $data[0]) { + unfilelock(); #for merge lock above + return (0,undef); + } + $locks++; + my @bugs = split / /, $data[0]->{mergedwith}; + for my $bug (@bugs) { + my $newdata = undef; + if ($bug ne $bug_num) { + $newdata = lockreadbug($bug,$location); + if (not defined $newdata) { + for (1..$locks) { + unfilelock(); + } + $locks = 0; + warn "Unable to read bug: $bug while handling merged bug: $bug_num"; + return ($locks,undef); + } + $locks++; + push @data,$newdata; + } + # perform a sanity check to make sure that the merged bugs are + # all merged with eachother + my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs)); + if ($newdata->{mergedwith} ne $expectmerge) { + for (1..$locks) { + unfilelock(); + } + die "Bug $bug_num differs from bug $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")"; + } + } + return (2,@data); +} + my @v1fieldorder = qw(originator date subject msgid package keywords done forwarded mergedwith severity); @@ -369,17 +454,17 @@ sub writebug { for my $version (keys %outputs) { next if defined $minversion and $version < $minversion; my $status = getbugcomponent($ref, $outputs{$version}, $location); - &quit("can't find location for $ref") unless defined $status; - open(S,"> $status.new") || &quit("opening $status.new: $!"); + die "can't find location for $ref" unless defined $status; + open(S,"> $status.new") || die "opening $status.new: $!"; print(S makestatus($data, $version)) || - &quit("writing $status.new: $!"); - close(S) || &quit("closing $status.new: $!"); + die "writing $status.new: $!"; + close(S) || die "closing $status.new: $!"; if (-e $status) { $change = 'change'; } else { $change = 'new'; } - rename("$status.new",$status) || &quit("installing new $status: $!"); + rename("$status.new",$status) || die "installing new $status: $!"; } # $disablebughook is a bit of a hack to let format migration scripts use @@ -627,6 +712,16 @@ sub bug_archiveable{ print STDERR "Cannot archive $param{bug} because it is not done\n" if $DEBUG; return $cannot_archive } + # Check to make sure that the bug has none of the unremovable tags set + if (@{$config{removal_unremovable_tags}}) { + for my $tag (split ' ', ($status->{tags}||'')) { + if (grep {$tag eq $_} @{$config{removal_unremovable_tags}}) { + print STDERR "Cannot archive $param{bug} because it has an unremovable tag '$tag'\n" if $DEBUG; + return $cannot_archive; + } + } + } + # If we just are checking if the bug can be archived, we'll not even bother # checking the versioning information if the bug has been -done for less than 28 days. my $log_file = getbugcomponent($param{bug},'log'); @@ -725,7 +820,10 @@ sub bug_archiveable{ last if $buggy eq 'found'; $min_fixed_time = min($time_versions{$version},$min_fixed_time); } - $min_archive_days = max($min_archive_days,ceil($config{remove_age} - (time - $min_fixed_time)/(60*60*24))); + $min_archive_days = max($min_archive_days,ceil($config{remove_age} - (time - $min_fixed_time)/(60*60*24))) + # if there are no versions in the archive at all, then + # we can archive if enough days have passed + if @sourceversions; } # If $param{ignore_time}, then we should ignore time. if ($param{ignore_time}) { @@ -862,7 +960,8 @@ sub get_bug_status { $status{"pending"} = 'fixed' if ($tags{fixed}); - my $presence = bug_presence(map{(exists $param{$_})?($_,$param{$_}):()} + my $presence = bug_presence(status => \%status, + map{(exists $param{$_})?($_,$param{$_}):()} qw(bug sourceversions arch dist version found fixed package) ); if (defined $presence) { @@ -1231,7 +1330,7 @@ sub update_realtime { sub bughook_archive { my @refs = @_; - &filelock("debbugs.trace.lock"); + &filelock("$config{spool_dir}/debbugs.trace.lock"); &appendfile("debbugs.trace","archive ".join(',',@refs)."\n"); my %bugs = update_realtime("$config{spool_dir}/index.db.realtime", map{($_,'REMOVE')} @refs); @@ -1242,7 +1341,7 @@ sub bughook_archive { sub bughook { my ( $type, %bugs_temp ) = @_; - &filelock("debbugs.trace.lock"); + &filelock("$config{spool_dir}/debbugs.trace.lock"); my %bugs; for my $bug (keys %bugs_temp) { diff --git a/Debbugs/Text.pm b/Debbugs/Text.pm index 0f3a529..61c7781 100644 --- a/Debbugs/Text.pm +++ b/Debbugs/Text.pm @@ -16,8 +16,8 @@ Debbugs::Text -- General routines for text templates =head1 SYNOPSIS -use Debbugs::Text qw(:templates); -print fill_in_template(template => 'cgi/foo'); + use Debbugs::Text qw(:templates); + print fill_in_template(template => 'cgi/foo'); =head1 DESCRIPTION @@ -164,6 +164,7 @@ sub fill_in_template{ qw(padsv padav padhv padany), qw(rv2gv refgen srefgen ref), qw(caller require entereval), + qw(gmtime time sprintf prtf), ); $safe->share('*STDERR'); $safe->share('%config'); @@ -191,7 +192,7 @@ sub fill_in_template{ my $tt; if ($tt_type eq 'FILE' and defined $tt_templates{$tt_source} and - (stat $tt_source)[9] > $tt_templates{$tt_source}{mtime} + (stat $tt_source)[9] <= $tt_templates{$tt_source}{mtime} ) { $tt = $tt_templates{$tt_source}{template}; } @@ -202,6 +203,7 @@ sub fill_in_template{ } $tt = Text::Template->new(TYPE => $tt_type, SOURCE => $tt_source, + UNTAINT => 1, ); if ($tt_type eq 'FILE') { $tt_templates{$tt_source}{template} = $tt; @@ -210,10 +212,7 @@ sub fill_in_template{ if (not defined $tt) { die "Unable to create Text::Template for $tt_type:$tt_source"; } - my $ret = $tt->fill_in(#(defined $param{nosafe} and $param{nosafe})?():(HASH=>$param{variables}), - #(defined $param{nosafe} and $param{nosafe})?():(SAFE=>$safe), - SAFE => $safe, - #(defined $param{nosafe} and $param{nosafe})?(PACKAGE => 'main'):(), + my $ret = $tt->fill_in(SAFE => $safe, defined $param{output}?(OUTPUT=>$param{output}):(), ); if (not defined $ret) { diff --git a/Debbugs/User.pm b/Debbugs/User.pm index b82ce70..cbb0fa8 100644 --- a/Debbugs/User.pm +++ b/Debbugs/User.pm @@ -6,7 +6,7 @@ # [Other people have contributed to this file; their copyrights should # go here too.] # Copyright 2004 by Anthony Towns - +# Copyright 2008 by Don Armstrong package Debbugs::User; @@ -36,6 +36,37 @@ $u->{"name"} read_usertags(\%ut, $userid); write_usertags(\%ut, $userid); +=head1 USERTAG FILE FORMAT + +Usertags are in a file which has (roughly) RFC822 format, with stanzas +separated by newlines. For example: + + Tag: search + Bugs: 73671, 392392 + + Value: priority + Bug-73671: 5 + Bug-73487: 2 + + Value: bugzilla + Bug-72341: http://bugzilla/2039471 + Bug-1022: http://bugzilla/230941 + + Category: normal + Cat1: status + Cat2: debbugs.tasks + + Category: debbugs.tasks + Hidden: yes + Cat1: debbugs.tasks + + Cat1Options: + tag=quick + tag=medium + tag=arch + tag=not-for-me + + =head1 EXPORT TAGS =over @@ -54,87 +85,25 @@ use Fcntl ':flock'; use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); use base qw(Exporter); -use Debbugs::Config qw(:globals); +use Debbugs::Config qw(:config); use List::Util qw(min); +use Carp; +use IO::File; + BEGIN { ($VERSION) = q$Revision: 1.4 $ =~ /^Revision:\s+([^\s+])/; $DEBUG = 0 unless defined $DEBUG; @EXPORT = (); - @EXPORT_OK = qw(is_valid_user open read_usertags write_usertags); + @EXPORT_OK = qw(is_valid_user read_usertags write_usertags); $EXPORT_TAGS{all} = [@EXPORT_OK]; } -# Obsolete compatability functions - -sub read_usertags { - my $ut = shift; - my $u = shift; - - my $user = get_user($u); - for my $t (keys %{$user->{"tags"}}) { - $ut->{$t} = [] unless defined $ut->{$t}; - push @{$ut->{$t}}, @{$user->{"tags"}->{$t}}; - } -} - -sub write_usertags { - my $ut = shift; - my $u = shift; - - my $user = get_user($u, 1); # locked - $user->{"tags"} = { %{$ut} }; - $user->write(); -} ####################################################################### # Helper functions -sub filefromemail { - my $e = shift; - my $l = length($e) % 7; - return "$gSpoolDir/user/$l/" . join("", - map { m/^[0-9a-zA-Z_+.-]$/ ? $_ : sprintf("%%%02X", ord($_)) } - split //, $e); -} - -sub read_stanza { - my $f = shift; - my $field = 0; - my @res; - while (<$f>) { - chomp; - last if (m/^$/); - - if ($field && m/^ (.*)$/) { - $res[-1] .= "\n" . $1; - } elsif (m/^([^:]+):(\s+(.*))?$/) { - $field = $1; - push @res, ($1, $3); - } - } - return @res; -} - -sub fmt { - my $s = shift; - my $n = shift; - my $sofar = 0; - my $res = ""; - while ($s =~ m/^([^,]*,\s*)(.*)$/ || $s =~ m/^([^,]+)()$/) { - my $k = $1; - $s = $2; - unless ($sofar == 0 or $sofar + length($k) <= $n) { - $res .= "\n "; - $sofar = 1; - } - $res .= $k; - $sofar += length($k); - } - return $res . $s; -} - sub is_valid_user { my $u = shift; return ($u =~ /^[a-zA-Z0-9._+-]+[@][a-z0-9-.]{4,}$/); @@ -144,32 +113,48 @@ sub is_valid_user { # The real deal sub get_user { - my $ut = {}; - my $user = { - "tags" => $ut, - "categories" => {}, - "visible_cats" => [], - "unknown_stanzas" => [] - }; + return Debbugs::User->new(@_); +} - my $u = shift; - my $need_lock = shift || 0; - my $p = filefromemail($u); +=head2 new - my $uf; - $user->{"filename"} = $p; - if (not -r $p) { - return bless $user, "Debbugs::User"; + my $user = Debbugs::User->new('foo@bar.com',$lock); + +Reads the user file associated with 'foo@bar.com' and returns a +Debbugs::User object. + +=cut + +sub new { + my $class = shift; + $class = ref($class) || $class; + my ($email,$need_lock) = @_; + $need_lock ||= 0; + + my $ut = {}; + my $self = {"tags" => $ut, + "categories" => {}, + "visible_cats" => [], + "unknown_stanzas" => [], + values => {}, + email => $email, + }; + bless $self, $class; + + $self->{filename} = _file_from_email($self->{email}); + if (not -r $self->{filename}) { + return $self; } - open($uf, "< $p") or die "Unable to open file $p for reading: $!"; + my $uf = IO::File->new($self->{filename},'r') + or die "Unable to open file $self->{filename} for reading: $!"; if ($need_lock) { - flock($uf, LOCK_EX); - $user->{"locked"} = $uf; + flock($uf, LOCK_EX); + $self->{"locked"} = $uf; } - + while(1) { - my @stanza = read_stanza($uf); - last if ($#stanza == -1); + my @stanza = _read_stanza($uf); + last unless @stanza; if ($stanza[0] eq "Tag") { my %tag = @stanza; my $t = $tag{"Tag"}; @@ -208,52 +193,66 @@ sub get_user { } $c{"ttl"} = [@ttl]; $c{"pri"} = [@pri]; - push @cat, { %c }; + push @cat, { %c }; } else { push @cat, $stanza{"Cat${i}"}; } } - $user->{"categories"}->{$catname} = [@cat]; - push @{$user->{"visible_cats"}}, $catname - unless ($stanza{"Hidden"} || "no") eq "yes"; - } else { - push @{$user->{"unknown_stanzas"}}, [@stanza]; + $self->{"categories"}->{$catname} = [@cat]; + push @{$self->{"visible_cats"}}, $catname + unless ($stanza{"Hidden"} || "no") eq "yes"; + } + elsif ($stanza[0] eq 'Value') { + my ($value,$value_name,%bug_values) = @stanza; + while (my ($k,$v) = each %bug_values) { + my ($bug) = $k =~ m/^Bug-(\d+)/; + next unless defined $bug; + $self->{values}{$bug}{$value_name} = $v; + } + } + else { + push @{$self->{"unknown_stanzas"}}, [@stanza]; } } - close($uf) unless $need_lock; - bless $user, "Debbugs::User"; - return $user; + return $self; } sub write { - my $user = shift; - my $uf; - my $ut = $user->{"tags"}; - my $p = $user->{"filename"}; + my $self = shift; + + my $ut = $self->{"tags"}; + my $p = $self->{"filename"}; - if ($p =~ m/^(.+)$/) { $p = $1; } else { return; } - open $uf, "> $p" or return; + if (not defined $self->{filename} or not + length $self->{filename}) { + carp "Tried to write a usertag with no filename defined"; + return; + } + my $uf = IO::File->new($self->{filename},'w'); + if (not $uf) { + carp "Unable to open $self->{filename} for writing: $!"; + return; + } - for my $us (@{$user->{"unknown_stanzas"}}) { + for my $us (@{$self->{"unknown_stanzas"}}) { my @us = @{$us}; - while (@us) { - my $k = shift @us; my $v = shift @us; + while (my ($k,$v) = splice (@us,0,2)) { $v =~ s/\n/\n /g; - print $uf "$k: $v\n"; - } - print $uf "\n"; + print {$uf} "$k: $v\n"; + } + print {$uf} "\n"; } for my $t (keys %{$ut}) { next if @{$ut->{$t}} == 0; - print $uf "Tag: $t\n"; - print $uf fmt("Bugs: " . join(", ", @{$ut->{$t}}), 77) . "\n"; + print {$uf} "Tag: $t\n"; + print {$uf} _wrap_to_length("Bugs: " . join(", ", @{$ut->{$t}}), 77) . "\n"; print $uf "\n"; } - my $uc = $user->{"categories"}; - my %vis = map { $_, 1 } @{$user->{"visible_cats"}}; + my $uc = $self->{"categories"}; + my %vis = map { $_, 1 } @{$self->{"visible_cats"}}; for my $c (keys %{$uc}) { next if @{$uc->{$c}} == 0; @@ -283,11 +282,143 @@ sub write { } print $uf "\n"; } + # handle the value stanzas + my %value; + # invert the bug->value hash slightly + for my $bug (keys %{$self->{values}}) { + for my $value (keys %{$self->{values}{$bug}}) { + $value{$value}{$bug} = $self->{values}{$bug}{$value} + } + } + for my $value (keys %value) { + print {$uf} "Value: $value\n"; + for my $bug (keys %{$value{$value}}) { + my $bug_value = $value{$value}{$bug}; + $bug_value =~ s/\n/\n /g; + print {$uf} "Bug-$bug: $bug_value\n"; + } + print {$uf} "\n"; + } close($uf); - delete $user->{"locked"}; + delete $self->{"locked"}; +} + +=head1 OBSOLETE FUNCTIONS + +=cut + +=head2 read_usertags + + read_usertags($usertags,$email) + + +=cut + +sub read_usertags { + my ($usertags,$email) = @_; + + carp "read_usertags is deprecated"; + my $user = get_user($email); + for my $tag (keys %{$user->{"tags"}}) { + $usertags->{$tag} = [] unless defined $usertags->{$tag}; + push @{$usertags->{$tag}}, @{$user->{"tags"}->{$tag}}; + } + return $usertags; +} + +=head2 write_usertags + + write_usertags($usertags,$email); + +Gets a lock on the usertags, applies the usertags passed, and writes +them out. + +=cut + +sub write_usertags { + my ($usertags,$email) = @_; + + carp "write_usertags is deprecated"; + my $user = Debbugs::User->new($email,1); # locked + $user->{"tags"} = { %{$usertags} }; + $user->write(); +} + + +=head1 PRIVATE FUNCTIONS + +=head2 _file_from_email + + my $filename = _file_from_email($email) + +Turns an email into the filename where the usertag can be located. + +=cut + +sub _file_from_email { + my ($email) = @_; + my $email_length = length($email) % 7; + my $escaped_email = $email; + $escaped_email =~ s/([^0-9a-zA-Z_+.-])/sprintf("%%%02X", ord($1))/eg; + return "$config{usertag_dir}/$email_length/$escaped_email"; +} + +=head2 _read_stanza + + my @stanza = _read_stanza($fh); + +Reads a single stanza from a filehandle and returns it + +=cut + +sub _read_stanza { + my ($file_handle) = @_; + my $field = 0; + my @res; + while (<$file_handle>) { + chomp; + last if (m/^$/); + if ($field && m/^ (.*)$/) { + $res[-1] .= "\n" . $1; + } elsif (m/^([^:]+):(\s+(.*))?$/) { + $field = $1; + push @res, ($1, $3||''); + } + } + return @res; } + +=head2 _wrap_to_length + + _wrap_to_length + +Wraps a line to a specific length by splitting at commas + +=cut + +sub _wrap_to_length { + my ($content,$line_length) = @_; + my $current_line_length; + my $result = ""; + while ($content =~ m/^([^,]*,\s*)(.*)$/ || $content =~ m/^([^,]+)()$/) { + my $current_word = $1; + $content = $2; + if ($current_line_length != 0 and + $current_line_length + length($current_word) <= $line_length) { + $result .= "\n "; + $current_line_length = 1; + } + $result .= $current_word; + $current_line_length += length($current_word); + } + return $result . $content; +} + + + + 1; __END__ diff --git a/Debbugs/Versions.pm b/Debbugs/Versions.pm index 26f0138..5545b48 100644 --- a/Debbugs/Versions.pm +++ b/Debbugs/Versions.pm @@ -8,6 +8,8 @@ package Debbugs::Versions; +use warnings; + use strict; =head1 NAME @@ -61,7 +63,7 @@ function. =cut -sub new ($$) +sub new { my $this = shift; my $class = ref($this) || $this; @@ -81,7 +83,7 @@ This method is expected mainly to be used internally by the C method. =cut -sub isancestor ($$$) +sub isancestor { my $self = shift; my $ancestor = shift; @@ -104,7 +106,7 @@ This method is mainly for internal use. =cut -sub leaves ($) +sub leaves { my $self = shift; @@ -126,7 +128,7 @@ the next in the list. =cut -sub merge ($@) +sub merge { my $self = shift; return unless @_; @@ -157,7 +159,7 @@ whitespace. =cut -sub load ($*) +sub load { my $self = shift; my $fh = shift; @@ -175,7 +177,7 @@ method. =cut -sub save ($*) +sub save { my $self = shift; my $fh = shift; @@ -217,7 +219,7 @@ that nothing is known about any of the found versions. =cut -sub buggy ($$$$) +sub buggy { my $self = shift; my $version = shift; @@ -275,7 +277,7 @@ number of known and interested versions. =cut -sub allstates ($$$;$) +sub allstates { my $self = shift; my $found = shift; diff --git a/Makefile b/Makefile index 0fdfa0c..d1185b6 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ man_dir := $(DESTDIR)/usr/share/man man8_dir := $(man_dir)/man8 examples_dir := $(doc_dir)/examples -scripts_in := $(filter-out scripts/config.in scripts/errorlib.in scripts/text.in, $(wildcard scripts/*.in)) +scripts_in := $(filter-out scripts/config scripts/errorlib scripts/text, $(wildcard scripts/*)) htmls_in := $(wildcard html/*.html.in) cgis := $(wildcard cgi/*.cgi cgi/*.pl) @@ -48,13 +48,13 @@ $(var_dir)/spool/db-h $(scripts_dir) $(perl_dir) $(examples_dir) $(man8_dir); \ # install the scripts - $(foreach script,$(scripts_in), $(install_exec) $(script) $(scripts_dir)/$(patsubst scripts/%.in,%,$(script));) - $(install_data) scripts/errorlib.in $(scripts_dir)/errorlib + $(foreach script,$(scripts_in), $(install_exec) $(script) $(scripts_dir)/$(script);) + $(install_data) scripts/errorlib $(scripts_dir)/errorlib # install examples - $(install_data) scripts/config.in $(examples_dir)/config + $(install_data) scripts/config $(examples_dir)/config $(install_data) scripts/config.debian $(examples_dir)/config.debian - $(install_data) scripts/text.in $(examples_dir)/text + $(install_data) scripts/text $(examples_dir)/text $(install_data) debian/crontab misc/nextnumber misc/Maintainers \ misc/Maintainers.override misc/pseudo-packages.description \ misc/sources $(examples_dir) @@ -67,7 +67,7 @@ $(var_dir)/spool/db-h $(scripts_dir) $(perl_dir) $(examples_dir) $(man8_dir); \ # install the CGIs for cgi in $(cgis); do $(install_exec) $$cgi $(var_dir)/www/cgi; done - $(install_exec) cgi/bugs-fetch2.pl.in $(var_dir)/www/cgi/bugs-fetch2.pl + $(install_exec) cgi/bugs-fetch2.pl $(var_dir)/www/cgi/bugs-fetch2.pl # # install Perl modules # for perl in $(perls); do $(install_data) $$perl $(perl_dir); done diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi index abc8dbe..5711e1b 100755 --- a/cgi/bugreport.cgi +++ b/cgi/bugreport.cgi @@ -2,7 +2,8 @@ use warnings; use strict; -use POSIX qw(strftime tzset); + +use POSIX qw(strftime); use MIME::Parser; use MIME::Decoder; use IO::Scalar; @@ -12,13 +13,16 @@ use Debbugs::Config qw(:globals :text); # for read_log_records use Debbugs::Log qw(read_log_records); -use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522 create_mime_message); use Debbugs::CGI qw(:url :html :util); +use Debbugs::CGI::Bugreport qw(:all); use Debbugs::Common qw(buglog getmaintainers); use Debbugs::Packages qw(getpkgsrc); use Debbugs::Status qw(splitpackages get_bug_status isstrongseverity); use Scalar::Util qw(looks_like_number); + +use Debbugs::Text qw(:templates); + use CGI::Simple; my $q = new CGI::Simple; @@ -28,7 +32,7 @@ my %param = cgi_parameters(query => $q, qw(mboxstat mboxmaint archive), qw(repeatmerged) ], - default => {msg => '', + default => {# msg => '', boring => 'no', terse => 'no', reverse => 'no', @@ -42,21 +46,19 @@ my %param = cgi_parameters(query => $q, ); # This is craptacular. -my $tail_html; - my $ref = $param{bug} or quitcgi("No bug number"); $ref =~ /(\d+)/ or quitcgi("Invalid bug number"); $ref = $1; my $short = "#$ref"; -my $msg = $param{'msg'}; -my $att = $param{'att'}; +my ($msg) = $param{msg} =~ /^(\d+)$/ if exists $param{msg}; +my ($att) = $param{att} =~ /^(\d+)$/ if exists $param{att}; my $boring = $param{'boring'} eq 'yes'; my $terse = $param{'terse'} eq 'yes'; my $reverse = $param{'reverse'} eq 'yes'; my $mbox = $param{'mbox'} eq 'yes'; my $mime = $param{'mime'} eq 'yes'; -my $trim_headers = ($param{trim} || ($msg?'no':'yes')) eq 'yes'; +my $trim_headers = ($param{trim} || ((defined $msg and $msg)?'no':'yes')) eq 'yes'; my $mbox_status_message = $param{mboxstat} eq 'yes'; my $mbox_maint = $param{mboxmaint} eq 'yes'; @@ -69,307 +71,34 @@ my $archive = $param{'archive'} eq 'yes'; my $repeatmerged = $param{'repeatmerged'} eq 'yes'; my $buglog = buglog($ref); - -if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD' and not defined($att) and not $mbox) { - print "Content-Type: text/html; charset=utf-8\n"; - my @stat = stat $buglog; - if (@stat) { - my $mtime = strftime '%a, %d %b %Y %T GMT', gmtime($stat[9]); - print "Last-Modified: $mtime\n"; - } - print "\n"; - exit 0; -} - -sub display_entity ($$$$\$\@); -sub display_entity ($$$$\$\@) { - my $entity = shift; - my $ref = shift; - my $top = shift; - my $xmessage = shift; - my $this = shift; - my $attachments = shift; - - my $head = $entity->head; - my $disposition = $head->mime_attr('content-disposition'); - $disposition = 'inline' if not defined $disposition or $disposition eq ''; - my $type = $entity->effective_type; - my $filename = $entity->head->recommended_filename; - $filename = '' unless defined $filename; - $filename = decode_rfc1522($filename); - - if ($top and not $terse) { - my $header = $entity->head; - $$this .= "
    \n";
-	 if ($trim_headers) {
-	      my @headers;
-	      foreach (qw(From To Cc Subject Date)) {
-		   my $head_field = $head->get($_);
-		   next unless defined $head_field and $head_field ne '';
-		   push @headers, qq($_: ) . html_escape(decode_rfc1522($head_field));
-	      }
-	      $$this .= join(qq(), @headers) unless $terse;
-	 } else {
-	      $$this .= html_escape(decode_rfc1522($entity->head->stringify));
-	 }
-	 $$this .= "
    \n"; - } - - unless (($top and $type =~ m[^text(?:/plain)?(?:;|$)]) or - ($type =~ m[^multipart/])) { - push @$attachments, $entity; - my @dlargs = ($ref, msg=>$xmessage, att=>$#$attachments); - push @dlargs, (filename=>$filename) if $filename ne ''; - my $printname = $filename; - $printname = 'Message part ' . ($#$attachments + 1) if $filename eq ''; - $$this .= '
    [$printname } .
-		  "($type, $disposition)]
    \n"; - - if ($msg and defined($att) and $att == $#$attachments) { - my $head = $entity->head; - chomp(my $type = $entity->effective_type); - my $body = $entity->stringify_body; - print "Content-Type: $type"; - my ($charset) = $head->get('Content-Type:') =~ m/charset\s*=\s*\"?([\w-]+)\"?/i; - print qq(; charset="$charset") if defined $charset; - print "\n"; - if ($filename ne '') { - my $qf = $filename; - $qf =~ s/"/\\"/g; - $qf =~ s[.*/][]; - print qq{Content-Disposition: inline; filename="$qf"\n}; - } - print "\n"; - my $decoder = new MIME::Decoder($head->mime_encoding); - $decoder->decode(new IO::Scalar(\$body), \*STDOUT); - exit(0); - } - } - - return if not $top and $disposition eq 'attachment' and not defined($att); - return unless ($type =~ m[^text/?] and - $type !~ m[^text/(?:html|enriched)(?:;|$)]) or - $type =~ m[^application/pgp(?:;|$)] or - $entity->parts; - - if ($entity->is_multipart) { - my @parts = $entity->parts; - foreach my $part (@parts) { - display_entity($part, $ref, 0, $xmessage, - $$this, @$attachments); - $$this .= "\n"; - } - } elsif ($entity->parts) { - # We must be dealing with a nested message. - $$this .= "
    \n"; - my @parts = $entity->parts; - foreach my $part (@parts) { - display_entity($part, $ref, 1, $xmessage, - $$this, @$attachments); - $$this .= "\n"; - } - $$this .= "
    \n"; - } else { - if (not $terse) { - my $content_type = $entity->head->get('Content-Type:') || "text/html"; - my ($charset) = $content_type =~ m/charset\s*=\s*\"?([\w-]+)\"?/i; - my $body = $entity->bodyhandle->as_string; - $body = convert_to_utf8($body,$charset) if defined $charset; - $body = html_escape($body); - # Attempt to deal with format=flowed - if ($content_type =~ m/format\s*=\s*\"?flowed\"?/i) { - $body =~ s{^\ }{}mgo; - # we ignore the other things that you can do with - # flowed e-mails cause they don't really matter. - } - # Add links to URLs - $body =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),$1$3,go; - # Add links to bug closures - $body =~ s[(closes:\s*(?:bug)?\#?\s?\d+(?:,?\s*(?:bug)?\#?\s?\d+)*) - ][my $temp = $1; $temp =~ s{(\d+)}{qq($1)}ge; $temp;]gxie; - $$this .= qq(
    $body
    \n); - } - } -} - -my %maintainer = %{getmaintainers()}; -my %pkgsrc = %{getpkgsrc()}; - -my $indexentry; -my $showseverity; - -my $tpack; -my $tmain; - -my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime; -$tail_html = $gHTMLTail; -$tail_html =~ s/SUBSTITUTE_DTIME/$dtime/; - -my %status = %{get_bug_status(bug=>$ref)}; -unless (%status) { - print < - -$short - $gProject $gBug report logs - -

    $gProject $gBug report logs - $short

    -

    There is no record of $gBug $short. -Try the search page instead.

    -$tail_html -EOF - exit 0; -} - -$|=1; - -$tpack = lc $status{'package'}; -my @tpacks = splitpackages($tpack); - -if ($status{severity} eq 'normal') { - $showseverity = ''; -} elsif (isstrongseverity($status{severity})) { - $showseverity = "Severity: $status{severity};\n"; -} else { - $showseverity = "Severity: $status{severity};\n"; -} - -if (@{$status{found_versions}} or @{$status{fixed_versions}}) { - $indexentry.= q(
    version graph
    }; -} - - -$indexentry .= "
    \n"; -$indexentry .= htmlize_packagelinks($status{package}, 0) . ";\n"; - -foreach my $pkg (@tpacks) { - my $tmaint = defined($maintainer{$pkg}) ? $maintainer{$pkg} : '(unknown)'; - my $tsrc = defined($pkgsrc{$pkg}) ? $pkgsrc{$pkg} : '(unknown)'; - - $indexentry .= - htmlize_maintlinks(sub { $_[0] == 1 ? "Maintainer for $pkg is\n" - : "Maintainers for $pkg are\n" }, - $tmaint); - $indexentry .= ";\nSource for $pkg is\n". - '$tsrc" if ($tsrc ne "(unknown)"); - $indexentry .= ".\n"; -} - -$indexentry .= "
    "; -$indexentry .= htmlize_addresslinks("Reported by: ", \&submitterurl, - $status{originator}) . ";\n"; -$indexentry .= sprintf "Date: %s.\n", - (strftime "%a, %e %b %Y %T UTC", localtime($status{date})); - -$indexentry .= "
    Owned by: " . html_escape($status{owner}) . ".\n" - if length $status{owner}; - -$indexentry .= "
    \n"; - -my @descstates; - -$indexentry .= "

    $showseverity"; -$indexentry .= sprintf "Tags: %s;\n", - html_escape(join(", ", sort(split(/\s+/, $status{tags})))) - if length($status{tags}); -$indexentry .= "
    " if (length($showseverity) or length($status{tags})); - -my @merged= split(/ /,$status{mergedwith}); -if (@merged) { - my $descmerged = 'Merged with '; - my $mseparator = ''; - for my $m (@merged) { - $descmerged .= $mseparator."#$m"; - $mseparator= ",\n"; - } - push @descstates, $descmerged; -} - -if (@{$status{found_versions}}) { - my $foundtext = 'Found in '; - $foundtext .= (@{$status{found_versions}} == 1) ? 'version ' : 'versions '; - $foundtext .= join ', ', map html_escape($_), @{$status{found_versions}}; - push @descstates, $foundtext; -} -if (@{$status{fixed_versions}}) { - my $fixedtext = 'Fixed in '; - $fixedtext .= (@{$status{fixed_versions}} == 1) ? 'version ' : 'versions '; - $fixedtext .= join ', ', map html_escape($_), @{$status{fixed_versions}}; - if (length($status{done})) { - $fixedtext .= ' by ' . html_escape(decode_rfc1522($status{done})); - } - push @descstates, $fixedtext; -} - -if (@{$status{found_versions}} or @{$status{fixed_versions}}) { - push @descstates, 'Version Graph}; -} - -if (length($status{done})) { - push @descstates, "Done: ".html_escape(decode_rfc1522($status{done})); -} - -if (length($status{forwarded})) { - my $forward_link = html_escape($status{forwarded}); - $forward_link =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),$1$3,go; - push @descstates, "Forwarded to $forward_link"; -} - - -my @blockedby= split(/ /, $status{blockedby}); -if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) { - for my $b (@blockedby) { - my %s = %{get_bug_status($b)}; - next if $s{"pending"} eq 'fixed' || length $s{done}; - push @descstates, "Fix blocked by #$b: ".html_escape($s{subject}); - } -} - -my @blocks= split(/ /, $status{blocks}); -if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) { - for my $b (@blocks) { - my %s = %{get_bug_status($b)}; - next if $s{"pending"} eq 'fixed' || length $s{done}; - push @descstates, "Blocking fix for #$b: ".html_escape($s{subject}); - } +my @stat = stat $buglog; +my $mtime = ''; +if (@stat) { + $mtime = strftime '%a, %d %b %Y %T GMT', gmtime($stat[9]); } -if ($buglog !~ m#^\Q$gSpoolDir/db#) { - push @descstates, "Bug is archived. No further changes may be made"; +if ($q->request_method() eq 'HEAD' and not defined($att) and not $mbox) { + print $q->header(-type => "text/html", + -charset => 'utf-8', + (length $mtime)?(-last_modified => $mtime):(), + ); + exit 0; } -$indexentry .= join(";\n
    ", @descstates) . ".\n" if @descstates; -$indexentry .= "

    \n"; - -my $descriptivehead = $indexentry; my $buglogfh; if ($buglog =~ m/\.gz$/) { my $oldpath = $ENV{'PATH'}; $ENV{'PATH'} = '/bin:/usr/bin'; - $buglogfh = new IO::File "zcat $buglog |" or &quitcgi("open log for $ref: $!"); + $buglogfh = IO::File->new("zcat $buglog |") or quitcgi("open log for $ref: $!"); $ENV{'PATH'} = $oldpath; } else { - $buglogfh = new IO::File "<$buglog" or &quitcgi("open log for $ref: $!"); + $buglogfh = IO::File->new($buglog,'r') or quitcgi("open log for $ref: $!"); } +my %status = %{get_bug_status(bug=>$ref)}; + my @records; eval{ @records = read_log_records($buglogfh); @@ -379,123 +108,11 @@ if ($@) { } undef $buglogfh; -=head2 handle_email_message - - handle_email_message($record->{text}, - ref => $bug_number, - msg_number => $msg_number, - ); - -Returns a decoded e-mail message and displays entities/attachments as -appropriate. - - -=cut - -sub handle_email_message{ - my ($email,%options) = @_; - - my $output = ''; - my $parser = new MIME::Parser; - # Because we are using memory, not tempfiles, there's no need to - # clean up here like in Debbugs::MIME - $parser->tmp_to_core(1); - $parser->output_to_core(1); - my $entity = $parser->parse_data( $email); - my @attachments = (); - display_entity($entity, $options{ref}, 1, $options{msg_number}, $output, @attachments); - return $output; - -} - -=head2 handle_record - - push @log, handle_record($record,$ref,$msg_num); - -Deals with a record in a bug log as returned by -L; returns the log information that -should be output to the browser. - -=cut - -sub handle_record{ - my ($record,$bug_number,$msg_number,$seen_msg_ids) = @_; - - my $output = ''; - local $_ = $record->{type}; - if (/html/) { - my ($time) = $record->{text} =~ //; - my $class = $record->{text} =~ /^(?:Acknowledgement|Reply|Information|Report|Notification)/ ? 'infmessage':'msgreceived'; - $output .= decode_rfc1522($record->{text}); - # Link to forwarded http:// urls in the midst of the report - # (even though these links already exist at the top) - $output =~ s,((?:ftp|http|https)://[\S~-]+?/?)([\)\'\:\.\,]?(?:\s|\.<|$)),$1$2,go; - # Add links to the cloned bugs - $output =~ s{(Bug )(\d+)( cloned as bugs? )(\d+)(?:\-(\d+)|)}{$1.bug_links($2).$3.bug_links($4,$5)}eo; - # Add links to merged bugs - $output =~ s{(?<=Merged )([\d\s]+)(?=\.)}{join(' ',map {bug_links($_)} (split /\s+/, $1))}eo; - # Add links to blocked bugs - $output =~ s{(?<=Blocking bugs)(?:( of )(\d+))?( (?:added|set to|removed):\s+)([\d\s\,]+)} - {(defined $2?$1.bug_links($2):'').$3. - join(' ',map {bug_links($_)} (split /\,?\s+/, $4))}eo; - # Add links to reassigned packages - $output =~ s{(Bug reassigned from package \`)([^']+?)((?:'|\&\#39;) to \`)([^']+?)((?:'|\&\#39;))} - {$1.q($2).$3.q($4).$5}eo; - if (defined $time) { - $output .= ' ('.strftime('%a, %d %b %Y %T GMT',gmtime($time)).') '; - } - $output .= 'Full text and rfc822 format available.'; - - $output = qq(
    \n\n) . $output . "
    \n"; - } - elsif (/recips/) { - my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; - if (defined $msg_id and exists $$seen_msg_ids{$msg_id}) { - return (); - } - elsif (defined $msg_id) { - $$seen_msg_ids{$msg_id} = 1; - } - $output .= qq(

    \n); - $output .= 'View this message in rfc822 format

    '; - $output .= handle_email_message($record->{text}, - ref => $bug_number, - msg_number => $msg_number, - ); - } - elsif (/autocheck/) { - # Do nothing - } - elsif (/incoming-recv/) { - my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; - if (defined $msg_id and exists $$seen_msg_ids{$msg_id}) { - return (); - } - elsif (defined $msg_id) { - $$seen_msg_ids{$msg_id} = 1; - } - # Incomming Mail Message - my ($received,$hostname) = $record->{text} =~ m/Received: \(at (\S+)\) by (\S+)\;/; - $output .= qq|

    Message #$msg_number received at |. - html_escape("$received\@$hostname") . - q| (full text'. - q|, mbox)'.":

    \n"; - $output .= handle_email_message($record->{text}, - ref => $bug_number, - msg_number => $msg_number, - ); - } - else { - die "Unknown record type $_"; - } - return $output; -} my $log=''; my $msg_num = 0; my $skip_next = 0; -if (looks_like_number($msg) and ($msg-1) <= $#records) { +if (defined($msg) and ($msg-1) <= $#records) { @records = ($records[$msg-1]); $msg_num = $msg - 1; } @@ -570,6 +187,16 @@ END } else { + if (defined $att and defined $msg and @records) { + $msg_num++; + print handle_email_message($records[0]->{text}, + ref => $ref, + msg_num => $msg_num, + att => $att, + msg => $msg, + ); + exit 0; + } my %seen_msg_ids; for my $record (@records) { $msg_num++; @@ -586,67 +213,116 @@ else { $log = join("\n",@log); -print "Content-Type: text/html; charset=utf-8\n"; +# All of the below should be turned into a template -my @stat = stat $buglog; -if (@stat) { - my $mtime = strftime '%a, %d %b %Y %T GMT', gmtime($stat[9]); - print "Last-Modified: $mtime\n"; +my %maintainer = %{getmaintainers()}; +my %pkgsrc = %{getpkgsrc()}; + +my $indexentry; +my $showseverity; + +my $tpack; +my $tmain; + +my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime; + +unless (%status) { + print $q->header(-type => "text/html", + -charset => 'utf-8', + (length $mtime)?(-last_modified => $mtime):(), + ); + print fill_in_template(template=>'cgi/no_such_bug', + variables => {modify_time => $dtime, + bug_num => $ref, + }, + ); + exit 0; } -print "\n"; - -my $title = html_escape($status{subject}); - -my $dummy2 = $gWebHostBugDir; - -print "\n"; -print < -$short - $title - $gProject $gBug report logs - - - - - -END -print "

    " . "$gProject $gBug report logs - $short" . - "
    " . $title . "

    \n"; -print "$descriptivehead\n"; -if (looks_like_number($msg)) { - printf qq(

    Full log

    ),html_escape(bug_url($ref)); +# fixup various bits of the status +$status{tags_array} = [sort(split(/\s+/, $status{tags}))]; +$status{date_text} = strftime('%a, %e %b %Y %T UTC', gmtime($status{date})); +$status{mergedwith_array} = [split(/ /,$status{mergedwith})]; + + +my $version_graph = ''; +if (@{$status{found_versions}} or @{$status{fixed_versions}}) { + $version_graph = q(version graph}; } -else { - print qq(

    Reply ), - qq(or subscribe ), - qq(to this bug.

    \n); - print qq(

    Toggle useless messages

    ); - printf qq(

    View this report as an mbox folder, ). - qq(status mbox, maintainer mbox

    \n), - html_escape(bug_url($ref, mbox=>'yes')), - html_escape(bug_url($ref, mbox=>'yes',mboxstatus=>'yes')), - html_escape(bug_url($ref, mbox=>'yes',mboxmaint=>'yes')); + + + +my @blockedby= split(/ /, $status{blockedby}); +$status{blockedby_array} = []; +if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) { + for my $b (@blockedby) { + my %s = %{get_bug_status($b)}; + next if $s{"pending"} eq 'fixed' || length $s{done}; + push @{$status{blockedby_array}},{bug_num => $b, subject => $s{subject}, status => \%s}; + } } -print "$log"; -print "
    "; -print "

    Send a report that this bug log contains spam.

    \n
    \n"; -print $tail_html; -print "\n"; +my @blocks= split(/ /, $status{blocks}); +$status{blocks_array} = []; +if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) { + for my $b (@blocks) { + my %s = %{get_bug_status($b)}; + next if $s{"pending"} eq 'fixed' || length $s{done}; + push @{$status{blocks_array}}, {bug_num => $b, subject => $s{subject}, status => \%s}; + } +} + +if ($buglog !~ m#^\Q$gSpoolDir/db#) { + $status{archived} = 1; +} + +my $descriptivehead = $indexentry; -exit 0; +print $q->header(-type => "text/html", + -charset => 'utf-8', + (length $mtime)?(-last_modified => $mtime):(), + ); + +print fill_in_template(template => 'cgi/bugreport', + variables => {status => \%status, + package => \%package, + log => $log, + bug_num => $ref, + version_graph => $version_graph, + isstrongseverity => \&Debbugs::Status::isstrongseverity, + html_escape => \&Debbugs::CGI::html_escape, + looks_like_number => \&Scalar::Util::looks_like_number, + }, + hole_var => {'&package_links' => \&Debbugs::CGI::package_links, + '&bug_links' => \&Debbugs::CGI::bug_links, + '&version_url' => \&Debbugs::CGI::version_url, + '&bug_url' => \&Debbugs::CGI::bug_url, + '&strftime' => \&POSIX::strftime, + } + ); diff --git a/cgi/bugs.css b/cgi/bugs.css deleted file mode 100644 index ed42581..0000000 --- a/cgi/bugs.css +++ /dev/null @@ -1,184 +0,0 @@ -html { - color: #000; - background: #fefefe; - font-family: serif; - margin: 1em; - border: 0; - padding: 0; - line-height: 120%; -} - -body { - margin: 0; - border: 0; - padding: 0; -} - -h1, h2, h3 { - text-align: left; - font-family: sans-serif; -} - -h1 { - font-size: 150%; - line-height: 150%; -} - -h2 { - font-size: 130%; -} - -h3 { - font-size: 100%; -} - -a:link { - color: #1b56ce; - font-weight: bold; -} - -a:visited { - color:#1b56ce; -} - -a:link:active, a:link:visited { - color:#ff0000; -} - -a:link:hover, a:visited:hover { - color: #d81e1e; -} - -a.submitter:link { - color: #242424; - font-family: sans-serif; - font-size: 95%; - text-decoration: underline; - font-weight: normal; -} - -a.submitter:visited, a.submitter:active { - color: #6e6e6e; - font-family: sans-serif; - font-size: 95%; -} - -a.submitter:hover, a.submitter:visited:hover { - color: #d01414; - font-family: sans-serif; - font-size: 95%; -} - -pre.message { - font-family: monospace; - padding-top: 0; - margin-top: 0; - border-top: 0; -} - -.sparse li { - padding-top: 1ex; - margin-top: 1ex; - border-top: 1ex; -} - -a.bugtitle { - font-weight: bold; - font-size: 110%; -} - - -pre.headers { - font-family: sans-serif; - font-size: 95%; - color: #3c3c3c; - background-color: #f0f0f0; - padding: 2px; - border: #a7a7a7 1px solid; - line-height: 120% -} - -pre.mime { - font-family: monospace; - font-size: 95%; - color: #797979; -} - -/* This must be separate from the other CSS to make the showing of - unimportant messages work in bugreport.cgi. */ -.infmessage { display: none; } - -.infmessage { - font-family: sans-serif; - font-size: 90%; - color: #686868; -} - -.msgreceived { - font-family: sans-serif; - font-size: 90%; - color: #686868; -} - -pre.tags { - color: #a3a3a3; - font-size: 90%; -} - -hr.thin { - color: #a1a1a1; -} - -em.severity { - color: #c31212; -} - -code, address { - font-family: sans-serif; -} - -p { - font-family: sans-serif; - font-size: 95%; -} - -h2.outstanding { - font-family: sans-serif; - background-color: #f0f0f0; - color: #3c3c3c; - border: #a7a7a7 1px solid; - padding: 10px; -} - -a.options:link, a.options:visited { - font-family: sans-serif; - background-color: #f0f0f0; - color: #3c3c3c; - text-decoration: none; - border-bottom: #3c3c3c 1px dotted; -} - -li { - list-style-type: square; -} - -.bugs li { - margin-top: 5px; -} - -input { - border: #000 1px solid; - margin: 3px; -} - -table.forms { - font-size: 95%; - font-family: sans-serif; - margin-left: 10px; -} - -select { - margin: 3px; - border: #000 1px solid; -} - diff --git a/cgi/pkgreport.cgi b/cgi/pkgreport.cgi index c61bc01..3750949 100755 --- a/cgi/pkgreport.cgi +++ b/cgi/pkgreport.cgi @@ -10,45 +10,77 @@ # Copyright 2007 by Don Armstrong . -package debbugs; - use warnings; use strict; + use POSIX qw(strftime nice); use Debbugs::Config qw(:globals :text :config); + use Debbugs::User; -use Debbugs::CGI qw(version_url maint_decode); -use Debbugs::Common qw(getparsedaddrs :date make_list getmaintainers getpseudodesc); + +use Debbugs::Common qw(getparsedaddrs make_list getmaintainers getpseudodesc); + use Debbugs::Bugs qw(get_bugs bug_filter newest_bug); use Debbugs::Packages qw(getsrcpkgs getpkgsrc get_versions); -use Debbugs::Status qw(:status); -use Debbugs::CGI qw(:all); -use vars qw($gPackagePages $gWebDomain %gSeverityDisplay @gSeverityList); +use Debbugs::CGI qw(:all); -if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD') { - print "Content-Type: text/html; charset=utf-8\n\n"; - exit 0; -} +use Debbugs::CGI::Pkgreport qw(:all); -nice(5); +use Debbugs::Text qw(:templates); use CGI::Simple; my $q = new CGI::Simple; +if ($q->request_method() eq 'HEAD') { + print $q->header(-type => "text/html", + -charset => 'utf-8', + ); + exit 0; +} + +my $default_params = {ordering => 'normal', + archive => 0, + repeatmerged => 0, + include => [], + exclude => [], + }; + our %param = cgi_parameters(query => $q, single => [qw(ordering archive repeatmerged), qw(bug-rev pend-rev sev-rev), qw(maxdays mindays version), qw(data which dist newest), ], - default => {ordering => 'normal', - archive => 0, - repeatmerged => 1, - }, + default => $default_params, ); +my ($form_options,$param) = ({},undef); +($form_options,$param)= form_options_and_normal_param(\%param) + if $param{form_options}; + +%param = %{$param} if defined $param; + +if (exists $param{form_options} and defined $param{form_options}) { + delete $param{form_options}; + delete $param{submit} if exists $param{submit}; + for my $default (keys %{$default_params}) { + if (exists $param{$default} and + not ref($default_params->{$default}) and + $default_params->{$default} eq $param{$default} + ) { + delete $param{$default}; + } + } + for my $incexc (qw(include exclude)) { + next unless exists $param{$incexc}; + $param{$incexc} = [grep /\S\:\S/, make_list($param{$incexc})]; + } + print $q->redirect(munge_url('pkgreport.cgi?',%param)); + exit 0; +} + # map from yes|no to 1|0 for my $key (qw(repeatmerged bug-rev pend-rev sev-rev)) { if (exists $param{$key}){ @@ -69,7 +101,6 @@ elsif (lc($param{archive}) eq 'yes') { } -my $archive = ($param{'archive'} || "no") eq "yes"; my $include = $param{'&include'} || $param{'include'} || ""; my $exclude = $param{'&exclude'} || $param{'exclude'} || ""; @@ -85,6 +116,8 @@ unless (defined $ordering) { $ordering = "raw" if $raw_sort; $ordering = 'age' if $age_sort; } +$param{ordering} = $ordering; + our ($bug_order) = $ordering =~ /(age(?:rev)?)/; $bug_order = '' if not defined $bug_order; @@ -124,6 +157,7 @@ for my $incexcmap (@inc_exc_mapping) { delete $param{$incexcmap->{key}}; } + my $maxdays = ($param{'maxdays'} || -1); my $mindays = ($param{'mindays'} || 0); my $version = $param{'version'} || undef; @@ -164,10 +198,6 @@ our %cats = ( "normal" => [ qw(status severity classification) ], ); -my @select_key = (qw(submitter maint pkg package src usertag), - qw(status tag maintenc owner severity newest) - ); - if (exists $param{which} and exists $param{data}) { $param{$param{which}} = [exists $param{$param{which}}?(make_list($param{$param{which}})):(), make_list($param{data}), @@ -182,12 +212,10 @@ if (defined $param{maintenc}) { } -if (not grep {exists $param{$_}} @select_key and exists $param{users}) { +if (not grep {exists $param{$_}} keys %package_search_keys and exists $param{users}) { $param{usertag} = [make_list($param{users})]; } -quitcgi("You have to choose something to select by") unless grep {exists $param{$_}} @select_key; - if (exists $param{pkg}) { $param{package} = $param{pkg}; delete $param{pkg}; @@ -213,9 +241,12 @@ if (defined $param{usertag}) { } } -my $Archived = $archive ? " Archived" : ""; +quitcgi("You have to choose something to select by") unless grep {exists $param{$_}} keys %package_search_keys; -our $this = munge_url('pkgreport.cgi?', + +my $Archived = $param{archive} ? " Archived" : ""; + +my $this = munge_url('pkgreport.cgi?', %param, ); @@ -223,8 +254,8 @@ my %indexentry; my %strings = (); my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime; -my $tail_html = $debbugs::gHTMLTail; -$tail_html = $debbugs::gHTMLTail; +my $tail_html = $gHTMLTail; +$tail_html = $gHTMLTail; $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/; our %seen_users; @@ -284,20 +315,13 @@ for my $package (# For binary packages, add the binary package # walk through the keys and make the right get_bugs query. -my @search_key_order = (package => 'in package', - tag => 'tagged', - severity => 'with severity', - src => 'in source package', - maint => 'in packages maintained by', - submitter => 'submitted by', - owner => 'owned by', - status => 'with status', - ); -my %search_keys = @search_key_order; +my $form_option_variables = {}; +$form_option_variables->{search_key_order} = [@package_search_key_order]; # Set the title sanely and clean up parameters my @title; -while (my ($key,$value) = splice @search_key_order, 0, 2) { +my @temp = @package_search_key_order; +while (my ($key,$value) = splice @temp, 0, 2) { next unless exists $param{$key}; my @entries = (); $param{$key} = [map {split /\s*,\s*/} make_list($param{$key})]; @@ -339,7 +363,7 @@ if (defined $param{maint} and $param{maint} eq "" or ref($param{maint}) and not @bugs = get_bugs(function => sub {my %d=@_; foreach my $try (splitpackages($d{"pkg"})) { - return 1 if !getparsedaddrs($maintainers{$try}); + return 1 if not exists $maintainers{$try}; } return 0; } @@ -354,7 +378,7 @@ elsif (defined $param{newest}) { else { #yeah for magick! @bugs = get_bugs((map {exists $param{$_}?($_,$param{$_}):()} - keys %search_keys, 'archive'), + keys %package_search_keys, 'archive'), usertags => \%ut, ); } @@ -369,14 +393,35 @@ elsif (defined $param{dist}) { $title = html_escape($title); my @names; my @prior; my @order; -determine_ordering(); +determine_ordering(cats => \%cats, + param => \%param, + ordering => \$ordering, + names => \@names, + prior => \@prior, + title => \@title, + order => \@order, + ); # strip out duplicate bugs my %bugs; @bugs{@bugs} = @bugs; @bugs = keys %bugs; -my $result = pkg_htmlizebugs(\@bugs); +my $result = pkg_htmlizebugs(bugs => \@bugs, + names => \@names, + title => \@title, + order => \@order, + prior => \@prior, + ordering => $ordering, + bugusertags => \%bugusertags, + bug_rev => $bug_rev, + bug_order => $bug_order, + repeatmerged => $param{repeatmerged}, + include => $include, + exclude => $exclude, + this => $this, + options => \%param, + ); print "Content-Type: text/html; charset=utf-8\n\n"; @@ -403,82 +448,18 @@ if (defined $pseudodesc and defined $pkg and exists $pseudodesc->{$pkg}) { # output infomration about the packages for my $package (make_list($param{package}||[])) { - output_package_info('binary',$package); + print generate_package_info(binary => 1, + package => $package, + options => \%param, + bugs => \@bugs, + ); } for my $package (make_list($param{src}||[])) { - output_package_info('source',$package); -} - -sub output_package_info{ - my ($srcorbin,$package) = @_; - - my %pkgsrc = %{getpkgsrc()}; - my $srcforpkg = $package; - if ($srcorbin eq 'binary') { - $srcforpkg = $pkgsrc{$package}; - defined $srcforpkg or $srcforpkg = $package; - } - - my $showpkg = html_escape($package); - my $maintainers = getmaintainers(); - my $maint = $maintainers->{$srcforpkg}; - if (defined $maint) { - print '

    '; - print htmlize_maintlinks(sub { $_[0] == 1 ? "Maintainer for $showpkg is " - : "Maintainers for $showpkg are " - }, - $maint); - print ".

    \n"; - } else { - print "

    No maintainer for $showpkg. Please do not report new bugs against this package.

    \n"; - } - my @pkgs = getsrcpkgs($srcforpkg); - @pkgs = grep( !/^\Q$package\E$/, @pkgs ); - if ( @pkgs ) { - @pkgs = sort @pkgs; - if ($srcorbin eq 'binary') { - print "

    You may want to refer to the following packages that are part of the same source:\n"; - } else { - print "

    You may want to refer to the following individual bug pages:\n"; - } - #push @pkgs, $src if ( $src && !grep(/^\Q$src\E$/, @pkgs) ); - print join( ", ", map( "$_,src=>[],newest=>[])) . "\">$_", @pkgs ) ); - print ".\n"; - } - my @references; - my $pseudodesc = getpseudodesc(); - if ($package and defined($pseudodesc) and exists($pseudodesc->{$package})) { - push @references, "to the ". - "list of other pseudo-packages"; - } else { - if ($package and defined $gPackagePages) { - push @references, sprintf "to the %s package page", - html_escape("http://${debbugs::gPackagePages}/$package"), html_escape("$package"); - } - if (defined $gSubscriptionDomain) { - my $ptslink = $package ? $srcforpkg : $src; - push @references, q(to the Package Tracking System); - } - # Only output this if the source listing is non-trivial. - if ($srcorbin eq 'binary' and $srcforpkg) { - push @references, sprintf "to the source package %s's bug page", html_escape(munge_url($this,src=>$srcforpkg,package=>[],newest=>[])), html_escape($srcforpkg); - } - } - if (@references) { - $references[$#references] = "or $references[$#references]" if @references > 1; - print "

    You might like to refer ", join(", ", @references), ".

    \n"; - } - if (defined $param{maint} || defined $param{maintenc}) { - print "

    If you find a bug not listed here, please\n"; - printf "report it.

    \n", - html_escape("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}"); - } - if (not $maint and not @bugs) { - print "

    There is no record of the " . html_escape($package) . - ($srcorbin eq 'binary' ? " package" : " source package") . - ", and no bugs have been filed against it.

    "; - $showresult = 0; - } + print generate_package_info(binary => 0, + package => $package, + options => \%param, + bugs => \@bugs, + ); } if (exists $param{maint} or exists $param{maintenc}) { @@ -492,682 +473,145 @@ if (exists $param{submitter}) { print "different addresses.\n"; } -my $archive_links; -my @archive_links; -my %archive_values = (both => 'archived and unarchived', - 0 => 'not archived', - 1 => 'archived', - ); -while (my ($key,$value) = each %archive_values) { - next if $key eq lc($param{archive}); - push @archive_links, qq($value reports ); -} -print '

    See the '.join (' or ',@archive_links)."

    \n"; - -print $result if $showresult; +# my $archive_links; +# my @archive_links; +# my %archive_values = (both => 'archived and unarchived', +# 0 => 'not archived', +# 1 => 'archived', +# ); +# while (my ($key,$value) = each %archive_values) { +# next if $key eq lc($param{archive}); +# push @archive_links, qq($value reports ); +# } +# print '

    See the '.join (' or ',@archive_links)."

    \n"; + +print $result; print pkg_javascript() . "\n"; -print "

    Options

    \n"; -print "
    \n"; -printf "
    \n", myurl(); - -print "\n"; - -my ($checked_any, $checked_sui, $checked_ver) = ("", "", ""); -if (defined $dist) { - $checked_sui = "CHECKED"; -} elsif (defined $version) { - $checked_ver = "CHECKED"; -} else { - $checked_any = "CHECKED"; -} -print "\n"; -print " \n"; -print ""; -print " \n"; - -if (defined $pkg) { - my $v = html_escape($version) || ""; - my $pkgsane = html_escape($pkg->[0]); - print ""; - print " \n"; -} elsif (defined $src) { - my $v = html_escape($version) || ""; - my $srcsane = html_escape($src->[0]); - print ""; - print " \n"; -} -print "\n"; - -my $includetags = html_escape(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include)); -my $excludetags = html_escape(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude)); -my $includesubj = html_escape(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include)); -my $excludesubj = html_escape(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude)); -my $vismindays = ($mindays == 0 ? "" : $mindays); -my $vismaxdays = ($maxdays == -1 ? "" : $maxdays); - -my $sel_rmy = ($param{repeatmerged} ? " selected" : ""); -my $sel_rmn = ($param{repeatmerged} ? "" : " selected"); -my $sel_ordraw = ($ordering eq "raw" ? " selected" : ""); -my $sel_ordold = ($ordering eq "oldview" ? " selected" : ""); -my $sel_ordnor = ($ordering eq "normal" ? " selected" : ""); -my $sel_ordage = ($ordering eq "age" ? " selected" : ""); - -my $chk_bugrev = ($bug_rev ? " checked" : ""); -my $chk_pendrev = ($pend_rev ? " checked" : ""); -my $chk_sevrev = ($sev_rev ? " checked" : ""); - -print < - - - - - -\n"; - -printf "\n", - pkg_htmlselectyesno("pend-rev", "outstanding bugs first", "done bugs first", $pend_rev); -printf "\n", - pkg_htmlselectyesno("sev-rev", "highest severity first", "lowest severity first", $sev_rev); -printf "\n", - pkg_htmlselectyesno("bug-rev", "oldest bugs first", "newest bugs first", $bug_rev); - -print < - -EOF +print option_form(template => 'cgi/pkgreport_options', + param => \%param, + form_options => $form_options, + variables => $form_option_variables, + ); -print "
    Show bugs applicable toanything
    " . pkg_htmlselectsuite(1,2,1) . " for " . pkg_htmlselectarch(1,2,2) . "
    $pkgsane version
    $srcsane version
     
    Only include bugs tagged with or that have in their subject
    Exclude bugs tagged with or that have in their subject
    Only show bugs older than days, and younger than days
     
    Merged bugs should be - -
    Categorise bugs by -
    Order bugs by%s
    %s
    %s
     
    with new settings
    \n"; +# print "

    Options

    \n"; +# print "
    \n"; +# printf "
    \n", myurl(); +# +# print "\n"; +# +# my ($checked_any, $checked_sui, $checked_ver) = ("", "", ""); +# if (defined $dist) { +# $checked_sui = "CHECKED"; +# } elsif (defined $version) { +# $checked_ver = "CHECKED"; +# } else { +# $checked_any = "CHECKED"; +# } +# +# print "\n"; +# print " \n"; +# print ""; +# print " \n"; +# +# if (defined $pkg) { +# my $v = html_escape($version) || ""; +# my $pkgsane = html_escape($pkg->[0]); +# print ""; +# print " \n"; +# } elsif (defined $src) { +# my $v = html_escape($version) || ""; +# my $srcsane = html_escape($src->[0]); +# print ""; +# print " \n"; +# } +# print "\n"; +# +# my $includetags = html_escape(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include)); +# my $excludetags = html_escape(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude)); +# my $includesubj = html_escape(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include)); +# my $excludesubj = html_escape(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude)); +# my $vismindays = ($mindays == 0 ? "" : $mindays); +# my $vismaxdays = ($maxdays == -1 ? "" : $maxdays); +# +# my $sel_rmy = ($param{repeatmerged} ? " selected" : ""); +# my $sel_rmn = ($param{repeatmerged} ? "" : " selected"); +# my $sel_ordraw = ($ordering eq "raw" ? " selected" : ""); +# my $sel_ordold = ($ordering eq "oldview" ? " selected" : ""); +# my $sel_ordnor = ($ordering eq "normal" ? " selected" : ""); +# my $sel_ordage = ($ordering eq "age" ? " selected" : ""); +# +# my $chk_bugrev = ($bug_rev ? " checked" : ""); +# my $chk_pendrev = ($pend_rev ? " checked" : ""); +# my $chk_sevrev = ($sev_rev ? " checked" : ""); +# +# print < +# +# +# +# +# +# \n"; +# +# printf "\n", +# pkg_htmlselectyesno("pend-rev", "outstanding bugs first", "done bugs first", $pend_rev); +# printf "\n", +# pkg_htmlselectyesno("sev-rev", "highest severity first", "lowest severity first", $sev_rev); +# printf "\n", +# pkg_htmlselectyesno("bug-rev", "oldest bugs first", "newest bugs first", $bug_rev); +# +# print < +# +# EOF +# +# print "
    Show bugs applicable toanything
    " . pkg_htmlselectsuite(1,2,1) . " for " . pkg_htmlselectarch(1,2,2) . "
    $pkgsane version
    $srcsane version
     
    Only include bugs tagged with or that have in their subject
    Exclude bugs tagged with or that have in their subject
    Only show bugs older than days, and younger than days
     
    Merged bugs should be +# +#
    Categorise bugs by +#
    Order bugs by%s
    %s
    %s
     
    with new settings
    \n"; print "
    \n"; print "

    $tail_html"; print "\n"; -sub pkg_htmlindexentrystatus { - my $s = shift; - my %status = %{$s}; - - my $result = ""; - - my $showseverity; - if ($status{severity} eq 'normal') { - $showseverity = ''; - } elsif (isstrongseverity($status{severity})) { - $showseverity = "Severity: $status{severity};\n"; - } else { - $showseverity = "Severity: $status{severity};\n"; - } - - $result .= pkg_htmlpackagelinks($status{"package"}, 1); - - my $showversions = ''; - if (@{$status{found_versions}}) { - my @found = @{$status{found_versions}}; - $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @found; - } - if (@{$status{fixed_versions}}) { - $showversions .= '; ' if length $showversions; - $showversions .= 'fixed: '; - my @fixed = @{$status{fixed_versions}}; - $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @fixed; - } - $result .= ' ($showversions)} if length $showversions; - $result .= ";\n"; - - $result .= $showseverity; - $result .= pkg_htmladdresslinks("Reported by: ", \&submitterurl, - $status{originator}); - $result .= ";\nOwned by: " . html_escape($status{owner}) - if length $status{owner}; - $result .= ";\nTags: " - . html_escape(join(", ", sort(split(/\s+/, $status{tags})))) - . "" - if (length($status{tags})); - - $result .= buglinklist(";\nMerged with ", ", ", - split(/ /,$status{mergedwith})); - $result .= buglinklist(";\nBlocked by ", ", ", - split(/ /,$status{blockedby})); - $result .= buglinklist(";\nBlocks ", ", ", - split(/ /,$status{blocks})); - - if (length($status{done})) { - $result .= "
    Done: " . html_escape($status{done}); - my $days = bug_archiveable(bug => $status{id}, - status => \%status, - days_until => 1, - ); - if ($days >= 0 and defined $status{location} and $status{location} ne 'archive') { - $result .= ";\nCan be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . ""; - } - elsif (defined $status{location} and $status{location} eq 'archived') { - $result .= ";\nArchived."; - } - } - - unless (length($status{done})) { - if (length($status{forwarded})) { - $result .= ";\nForwarded to " - . join(', ', - map {maybelink($_)} - split /\,\s+/,$status{forwarded} - ); - } - # Check the age of the logfile - my ($days_last,$eng_last) = secs_to_english(time - $status{log_modified}); - my ($days,$eng) = secs_to_english(time - $status{date}); - - if ($days >= 7) { - my $font = ""; - my $efont = ""; - $font = "em" if ($days > 30); - $font = "strong" if ($days > 60); - $efont = "" if ($font); - $font = "<$font>" if ($font); - - $result .= ";\n ${font}$eng old$efont"; - } - if ($days_last > 7) { - my $font = ""; - my $efont = ""; - $font = "em" if ($days_last > 30); - $font = "strong" if ($days_last > 60); - $efont = "" if ($font); - $font = "<$font>" if ($font); - - $result .= ";\n ${font}Modified $eng_last ago$efont"; - } - } - - $result .= "."; - - return $result; -} - - -sub pkg_htmlizebugs { - $b = $_[0]; - my @bugs = @$b; - - my @status = (); - my %count; - my $header = ''; - my $footer = "

    Summary

    \n"; - - my @dummy = ($gRemoveAge); #, @gSeverityList, @gSeverityDisplay); #, $gHTMLExpireNote); - - if (@bugs == 0) { - return "

    No reports found!

    \n"; - } - - if ( $bug_rev ) { - @bugs = sort {$b<=>$a} @bugs; - } else { - @bugs = sort {$a<=>$b} @bugs; - } - my %seenmerged; - - my %common = ( - 'show_list_header' => 1, - 'show_list_footer' => 1, - ); - - my %section = (); - # Make the include/exclude map - my %include; - my %exclude; - for my $include (make_list($param{include})) { - next unless defined $include; - my ($key,$value) = split /\s*:\s*/,$include,2; - unless (defined $value) { - $key = 'tags'; - $value = $include; - } - push @{$include{$key}}, split /\s*,\s*/, $value; - } - for my $exclude (make_list($param{exclude})) { - next unless defined $exclude; - my ($key,$value) = split /\s*:\s*/,$exclude,2; - unless (defined $value) { - $key = 'tags'; - $value = $exclude; - } - push @{$exclude{$key}}, split /\s*,\s*/, $value; - } - - foreach my $bug (@bugs) { - my %status = %{get_bug_status(bug=>$bug, - (exists $param{dist}?(dist => $param{dist}):()), - bugusertags => \%bugusertags, - (exists $param{version}?(version => $param{version}):()), - (exists $param{arch}?(arch => $param{arch}):(arch => $config{default_architectures})), - )}; - next unless %status; - next if bug_filter(bug => $bug, - status => \%status, - (exists $param{repeatmerged}?(repeat_merged => $param{repeatmerged}):()), - seen_merged => \%seenmerged, - (keys %include ? (include => \%include):()), - (keys %exclude ? (exclude => \%exclude):()), - ); - - my $html = sprintf "
  • #%d: %s\n
    ", - bug_url($bug), $bug, html_escape($status{subject}); - $html .= pkg_htmlindexentrystatus(\%status) . "\n"; - push @status, [ $bug, \%status, $html ]; - } - if ($bug_order eq 'age') { - # MWHAHAHAHA - @status = sort {$a->[1]{log_modified} <=> $b->[1]{log_modified}} @status; - } - elsif ($bug_order eq 'agerev') { - @status = sort {$b->[1]{log_modified} <=> $a->[1]{log_modified}} @status; - } - for my $entry (@status) { - my $key = ""; - for my $i (0..$#prior) { - my $v = get_bug_order_index($prior[$i], $entry->[1]); - $count{"g_${i}_${v}"}++; - $key .= "_$v"; - } - $section{$key} .= $entry->[2]; - $count{"_$key"}++; - } - - my $result = ""; - if ($ordering eq "raw") { - $result .= "
      \n" . join("", map( { $_->[ 2 ] } @status ) ) . "
    \n"; - } else { - $header .= "
    \n
      \n"; - my @keys_in_order = (""); - for my $o (@order) { - push @keys_in_order, "X"; - while ((my $k = shift @keys_in_order) ne "X") { - for my $k2 (@{$o}) { - $k2+=0; - push @keys_in_order, "${k}_${k2}"; - } - } - } - for my $order (@keys_in_order) { - next unless defined $section{$order}; - my @ttl = split /_/, $order; shift @ttl; - my $title = $title[0]->[$ttl[0]] . " bugs"; - if ($#ttl > 0) { - $title .= " -- "; - $title .= join("; ", grep {($_ || "") ne ""} - map { $title[$_]->[$ttl[$_]] } 1..$#ttl); - } - $title = html_escape($title); - - my $count = $count{"_$order"}; - my $bugs = $count == 1 ? "bug" : "bugs"; - - $header .= "
    • $title ($count $bugs)
      • \n"; - if ($common{show_list_header}) { - my $count = $count{"_$order"}; - my $bugs = $count == 1 ? "bug" : "bugs"; - $result .= "

      $title ($count $bugs)

      \n"; - } else { - $result .= "

      $title

      \n"; - } - $result .= "
      \n
        \n"; - $result .= "\n\n\n\n"; - $result .= $section{$order}; - $result .= "\n\n\n\n"; - $result .= "
      \n
      \n"; - } - $header .= "
    \n"; - - $footer .= "
    \n
      \n"; - for my $i (0..$#prior) { - my $local_result = ''; - foreach my $key ( @{$order[$i]} ) { - my $count = $count{"g_${i}_$key"}; - next if !$count or !$title[$i]->[$key]; - $local_result .= "
    • $count $title[$i]->[$key]
      • \n"; - } - if ( $local_result ) { - $footer .= "
    • $names[$i]
        \n$local_result
      • \n"; - } - } - $footer .= "
    \n
    \n"; - } - - $result = $header . $result if ( $common{show_list_header} ); - $result .= $footer if ( $common{show_list_footer} ); - return $result; -} - -sub pkg_htmlpackagelinks { - my $pkgs = shift; - return unless defined $pkgs and $pkgs ne ''; - my $strong = shift; - my @pkglist = splitpackages($pkgs); - - $strong = 0; - my $openstrong = $strong ? '' : ''; - my $closestrong = $strong ? '' : ''; - - return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' . - join(', ', - map { - '' . - $openstrong . html_escape($_) . $closestrong . '' - } @pkglist - ); -} - -sub pkg_htmladdresslinks { - htmlize_addresslinks(@_,'submitter'); -} - -sub pkg_javascript { - return < - - -EOF -} - -sub pkg_htmlselectyesno { - my ($name, $n, $y, $default) = @_; - return sprintf('', $name, ($default ? "" : " selected"), $n, ($default ? " selected" : ""), $y); -} - -sub pkg_htmlselectsuite { - my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2]; - my @suites = ("stable", "testing", "unstable", "experimental"); - my %suiteaka = ("stable", "etch", "testing", "lenny", "unstable", "sid"); - my $defaultsuite = "unstable"; - - my $result = sprintf ''; - return $result; -} - -sub pkg_htmlselectarch { - my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2]; - my @arches = qw(alpha amd64 arm hppa i386 ia64 m68k mips mipsel powerpc s390 sparc); - - my $result = sprintf ''; - return $result; -} - -sub myurl { - return html_escape(pkg_url(map {exists $param{$_}?($_,$param{$_}):()} - qw(archive repeatmerged mindays maxdays), - qw(version dist arch pkg src tag maint submitter) - ) - ); -} - -sub make_order_list { - my $vfull = shift; - my @x = (); - - if ($vfull =~ m/^([^:]+):(.*)$/) { - my $v = $1; - for my $vv (split /,/, $2) { - push @x, "$v=$vv"; - } - } else { - for my $v (split /,/, $vfull) { - next unless $v =~ m/.=./; - push @x, $v; - } - } - push @x, ""; # catch all - return @x; -} - -sub get_bug_order_index { - my $order = shift; - my $status = shift; - my $pos = -1; - - my %tags = (); - %tags = map { $_, 1 } split / /, $status->{"tags"} - if defined $status->{"tags"}; - - for my $el (@${order}) { - $pos++; - my $match = 1; - for my $item (split /[+]/, $el) { - my ($f, $v) = split /=/, $item, 2; - next unless (defined $f and defined $v); - my $isokay = 0; - $isokay = 1 if (defined $status->{$f} and $v eq $status->{$f}); - $isokay = 1 if ($f eq "tag" && defined $tags{$v}); - unless ($isokay) { - $match = 0; - last; - } - } - if ($match) { - return $pos; - last; - } - } - return $pos + 1; -} - -sub buglinklist { - my ($prefix, $infix, @els) = @_; - return '' if not @els; - return $prefix . bug_linklist($infix,'submitter',@els); -} - - -# sets: my @names; my @prior; my @title; my @order; - -sub determine_ordering { - $cats{status}[0]{ord} = [ reverse @{$cats{status}[0]{ord}} ] - if ($pend_rev); - $cats{severity}[0]{ord} = [ reverse @{$cats{severity}[0]{ord}} ] - if ($sev_rev); - - my $i; - if (defined $param{"pri0"}) { - my @c = (); - $i = 0; - while (defined $param{"pri$i"}) { - my $h = {}; - - my ($pri) = make_list($param{"pri$i"}); - if ($pri =~ m/^([^:]*):(.*)$/) { - $h->{"nam"} = $1; # overridden later if necesary - $h->{"pri"} = [ map { "$1=$_" } (split /,/, $2) ]; - } else { - $h->{"pri"} = [ split /,/, $pri ]; - } - - ($h->{"nam"}) = make_list($param{"nam$i"}) - if (defined $param{"nam$i"}); - $h->{"ord"} = [ map {split /\s*,\s*/} make_list($param{"ord$i"}) ] - if (defined $param{"ord$i"}); - $h->{"ttl"} = [ map {split /\s*,\s*/} make_list($param{"ttl$i"}) ] - if (defined $param{"ttl$i"}); - - push @c, $h; - $i++; - } - $cats{"_"} = [@c]; - $ordering = "_"; - } - - $ordering = "normal" unless defined $cats{$ordering}; - - sub get_ordering { - my @res; - my $cats = shift; - my $o = shift; - for my $c (@{$cats->{$o}}) { - if (ref($c) eq "HASH") { - push @res, $c; - } else { - push @res, get_ordering($cats, $c); - } - } - return @res; - } - my @cats = get_ordering(\%cats, $ordering); - - sub toenglish { - my $expr = shift; - $expr =~ s/[+]/ and /g; - $expr =~ s/[a-z]+=//g; - return $expr; - } - - $i = 0; - for my $c (@cats) { - $i++; - push @prior, $c->{"pri"}; - push @names, ($c->{"nam"} || "Bug attribute #" . $i); - if (defined $c->{"ord"}) { - push @order, $c->{"ord"}; - } else { - push @order, [ 0..$#{$prior[-1]} ]; - } - my @t = @{ $c->{"ttl"} } if defined $c->{ttl}; - if (@t < $#{$prior[-1]}) { - push @t, map { toenglish($prior[-1][$_]) } @t..($#{$prior[-1]}); - } - push @t, $c->{"def"} || ""; - push @title, [@t]; - } -} diff --git a/cgi/soap.cgi b/cgi/soap.cgi index b5766d7..1ca87b9 100755 --- a/cgi/soap.cgi +++ b/cgi/soap.cgi @@ -16,5 +16,13 @@ my $soap = Debbugs::SOAP::Server # soapy is stupid, and is using the 1999 schema; override it. *SOAP::XMLSchema1999::Serializer::as_base64Binary = \&SOAP::XMLSchema2001::Serializer::as_base64Binary; *SOAP::Serializer::as_anyURI = \&SOAP::XMLSchema2001::Serializer::as_string; -$soap-> handle; +# to work around the serializer improperly using date/time stuff +# (Nothing in Debbugs should be looked at as if it were date/time) we +# kill off all of the date/time related bits in the serializer. +my $typelookup = $soap->serializer()->{_typelookup}; +for my $key (keys %{$typelookup}) { + next unless /Month|Day|Year|date|time|duration/i; + delete $typelookup->{$key}; +} +$soap->handle; diff --git a/cgi/version.cgi b/cgi/version.cgi index 7e19e9e..d1e8960 100755 --- a/cgi/version.cgi +++ b/cgi/version.cgi @@ -14,9 +14,15 @@ BEGIN{ use CGI::Simple; -use CGI::Alert 'don@donarmstrong.com'; +# by default send this message nowhere +use CGI::Alert q(nobody@example.com); use Debbugs::Config qw(:config); + +BEGIN{ + $CGI::Alert::Maintainer = $config{maintainer}; +} + use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters munge_url); use Debbugs::Versions; use Debbugs::Versions::Dpkg; @@ -31,7 +37,7 @@ my %img_types = (svg => 'image/svg+xml', png => 'image/png', ); -my $q = new CGI::Simple; +my $q = CGI::Simple->new(); my %cgi_var = cgi_parameters(query => $q, single => [qw(package format ignore_boring width height collapse info)], @@ -118,7 +124,9 @@ my %sources; my $version = Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp); foreach my $source (keys %sources) { my $srchash = substr $source, 0, 1; - my $version_fh = new IO::File "$config{version_packages_dir}/$srchash/$source", 'r'; + next unless -e "$config{version_packages_dir}/$srchash/$source"; + my $version_fh = IO::File->new("$config{version_packages_dir}/$srchash/$source", 'r') or + warn "Unable to open $config{version_packages_dir}/$srchash/$source for reading: $!"; $version->load($version_fh); } # Here, we need to generate a short version to full version map @@ -186,7 +194,7 @@ if ($cgi_var{collapse}) { # are in the same state as their parent, and are not in a suite foreach my $key (keys %reversed_nodes) { my ($short_version) = $key =~ m{/(.+)$}; - if (not exists $version_to_dist{$short_version} + if (not exists $version_to_dist{$key} and @{$reversed_nodes{$key}} <= 1 and defined $version->{parent}{$key} and $all_states{$key} eq $all_states{$version->{parent}{$key}} @@ -241,8 +249,8 @@ foreach my $key (keys %all_states) { or $all_states{$key} eq 'absent'); next if $cgi_var{ignore_boring} and not version_relevant($version,$key,\@interesting_versions); my @attributes = @{$state{$all_states{$key}}}; - if (length $short_version and exists $version_to_dist{$short_version}) { - push @attributes, 'label="'.$key.'\n'."(".join(', ',@{$version_to_dist{$short_version}}).")\""; + if (exists $version_to_dist{$key}) { + push @attributes, 'label="'.$key.'\n'."(".join(', ',@{$version_to_dist{$key}}).")\""; } my $node_attributes = qq("$key" [).join(',',@attributes).qq(]\n); $dot .= $node_attributes; @@ -278,13 +286,13 @@ $dot .= "}\n"; my $temp_dir = tempdir(CLEANUP => 1); if (not defined $cgi_var{dot}) { - my $dot_fh = new IO::File "$temp_dir/temp.dot",'w' or + my $dot_fh = IO::File->new("$temp_dir/temp.dot",'w') or die "Unable to open $temp_dir/temp.dot for writing: $!"; print {$dot_fh} $dot or die "Unable to print output to the dot file: $!"; close $dot_fh or die "Unable to close the dot file: $!"; system('dot','-T'.$cgi_var{format},"$temp_dir/temp.dot",'-o',"$temp_dir/temp.$cgi_var{format}") == 0 or print "Content-Type: text\n\nDot failed." and die "Dot failed: $?"; - my $img_fh = new IO::File "$temp_dir/temp.$cgi_var{format}", 'r' or + my $img_fh = IO::File->new("$temp_dir/temp.$cgi_var{format}", 'r') or die "Unable to open $temp_dir/temp.$cgi_var{format} for reading: $!"; print "Content-Type: $img_types{$cgi_var{format}}\n\n"; print <$img_fh>; diff --git a/debian/changelog b/debian/changelog index 339779a..11c7df8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,219 +1,222 @@ debbugs (2.4.2) UNRELEASED; urgency=low - * Anthony Towns: - - Add "package" command to service (control@) to limit the bugs that - the following commands apply to. - - * Colin Watson: - - Add (slightly) fancy CGI decoding of message/* MIME types. - - CGI scripts now support multiple maintainers for a single package. - - Add support for an X-Debbugs-No-Ack: mail header to suppress - acknowledgements. - - Document how to deliver mail to debbugs via procmail and SpamAssassin. - - Implement new .status format that's extensible and easier to read; it - now lives in .summary rather than .status. Use debbugs-upgradestatus - to convert existing bug databases. - - Implement bug ownership, with new 'owner' and 'noowner' commands and - Owner: pseudo-header (closes: #133453). - - Install Debian configuration in the binary package's examples - directory (closes: #222118). - - New standalone SpamAssassin queue runner, spamscan. - - Allow # prefix on bug numbers in 'merge' command. - - Fix some ordering issues in old-style package pages and summaries. - - Add X-$gProject-PR-Message: headers to all mails sent by service. - - debbugsconfig creates required directories in $gSpoolDir - (closes: #222077). - - Decode RFC1522 mail headers for display in the web interface. - bugreport.cgi and pkgreport.cgi now output UTF-8. - - Properly support multiple submitter addresses on a single bug. - - Add a number of extra htmlsanit() calls to prevent cross-site - scripting attacks. - - * Adam Heath: - - Rewrite filtering in cgi's common.pl, to make it completely generic. - Filtering can now work against any field. - - Rewrite grouping logic in cgi's common.pl, to make it completely - generic. There is now no longer 2 nested loops, to do the grouping. - This makes adding new grouping levels simpler for the future. - - Add in a Table of Contents to pkgreport.cgi. - - Display how long until a resolved bug will be archived in - pkgreport.cgi. - - Add user-agent detection. This currently doesn't change anything, - however. - - Add options show_list_(head|foot)er. - - * Don Armstrong: - - - Don't remove the maintainer address if the message was sent by the - maintainer and we're submitting to maintonly (closes: #140061) - - Use uri_escape to escape URI's before sending them back out so the - name of the file doesn't munge the query string. [#301606 pt. 1] - - call decode_rfc1522 on the filename returned so that encoded - filenames get decoded to something "reasonable." (closes: #301606) - - We now require URI::Escape - - Added apache.conf to examples, which is a sample apache - configuration file which implements the rewrite rules that are - currently used on bugs.debian.org. (closes: #222264) - - Change spamscan.in to work with SA 3.0; This is an incompatible - change with SA 2.6, and as such, we now Suggests: spamassassin - (>=3.0) (closes: #290501) - - Update MTA to exim4 (closes: #228597) and add instructions on using - exim 4 (thanks to Marc Haber) (closes: #248335) - - Added per bug subscription support to debbugs, which relies on an - external MLM to actually deal with the requests; currently works with - eoc and sends messages to bugnum\@$gListDomain. (closes: #34071) - - Change bugreport.cgi to use Debbugs::Log and greately simplify the - process of outputing the bug log. - - All RFC1522 subject lines are decoded, both in the html information - and the message headers. All messages are converted to UTF-8 whereever - possible; all bugreport.cgi pages are now completely in UTF-8 to the - degree possible using Encode.pm (closes: #46848,#238984) - - Add a convert_to_utf8 function to Debbugs::Mime to make the above - possible; abstracts functionality that was already present in the - decode_rfc1522 fucntionality. - - Individual messages can now be downloaded from each bug report - (closes: #95373) - - Uninteresting headers are now hidden by default, can be renabled - with &trim=no (closes: #188561) - - Fix postfix instructions in README.mail (thanks to Jeff Teunissen) - (closes: #134166) - - Display old severity when changing severity (closes: #196947) - - All messages that originate from the BTS and either go to .log files - or out to users are now properly RFC1522 encoded. (closes: #306068) - - Add links to cloned bugs (closes: #217960) and forwarded records - that look like urls in the html records output by bugreport.cgi. - - Things that look like urls in message bodies are now linked - (closes: #168962) - - Add Debbugs::Mail module that has two important functions: - send_mail_message and encode_headers. All mail handling in service.in - and process.in now uses send_mail_message to send mail messages which - tries as hard as possible to send a message; if it fails, only - warnings are returned. This fixes bad addresses causing sendmail to - exit and destroying the bug log. (closes: #191306) - - Add rudimentary Test::More modules for testing Debbugs::Mime and - Debbugs::Mail. - - Allow X-debbugs-* to be set in pseudo headers. (closes: #179340) - - Obey X-Debbugs-No-Ack in control@ messages. (closes: #201825) - - Allow forwarded: and owner to be set at submit@ time. - (closes:#128320) - - Fix example rewrite rules to allow for #1234 and foo+bar@baz.com - (closes: #321925) - - Output proper charset for attachments (closes: #335813) - - Use MIME encodings to attach messages in close and done. - (closes: #136654) - - Add a forcemerge command to service.in to allow forcibly merging - bugs which are in the same package. (closes: #286792) - - Make all packages lowercase to support packages with uppercase - names, even though that's insane. (closes: #67067) - - Change acknowledged to close (closes: #61341) and indicate who - actually closed the bug (closes: #355968, #132274) - - Fix the documentation of clone to indicate that you need at least - one newID (closes: #276747) - - Use create_mime_message to send all of the mails which may contain - UTF8 material. (closes: #364026) - - Add links to Closes: text for closed bugs. (closes: #320986) - - Add X-$gProject-PR-Source: line (closes: #219230) - - Use the %cats data structure properly in pkgreport.cgi - (closes: #367514) - - Document nnn.*@foobar addresses (closes: #188670) - - Support cloned bugs in control blocking (closes: #337329) - - Indicate which bugs are blocked after blocking (closes: #367496) - - Obey package for usertags (closes: #376528) - - Add link to subscribe to a bug (closes: #353260) - - Don't lc owner or forwarded at submit time (closes: #288384) - - Explain how to close bugs in the ack message (closes: #37605) - - Make the moreinfo ack more general (closes: #70810) - - Use RFC compliant dates in headers (closes: #362935) - - Add SOAP support (closes: #377520) Thanks to Raphael Hertzog. - - Split forwarded on commas for linking (closes: #367813,#473272) - - Don't display duplicate bugs (closes: #348116) - - Display links to archived bugs for all searches (closes: #53710) - - Link to blocked bugs in the bugreport.cgi output (closes: #326077) - - Don't ask for more bugs if there is no maintainer (closes: #355190) - - Stop refering to developers on the index page (closes: #355786) - - Change control@ stop regex and documentation to match eachother - (closes: #366093) - - Make it obvious when commands to control have failed - (closes: #344184) - - Fix javascript error in pkgreport.cgi (closes: #346043) - - When a bug can't be found in control@; indicate to user that it may - be archived. (closes: #153536) - - my_url in pkgreport.cgi now returns the complete url (closes: #378566) - - Document precisely how forwarded works (closes: #228049) - - Dissallow forwarded being set to a $gEmailDomain address - (closes: #397486) - - Fix broken sorting by usertags by forcing numeric (closes: #395027) - - Add support for hiding useless messages; thanks to Sune Vuorela. - (closes: #406020) - - Fix arrayrefs leaking into the myurl function (closes: #397344) - - List bugs being blocked (closes: #356680) - - Fix multiple submitters for a single bug in the index - (closes: #402362) - - Marking a bug as fixed now overrides a found at that exact version - (closes: #395865) - - When searching by source package, include the source package itself - in the list of packages to search for, even if there is no binary - package called that. (closes: #414825) - - Add link from singlemsg page to main page; remove useless links - (closes: #404806) - - Support usertagging cloned bugs (closes: #375697) - - List previous/new title when retitling, and show date of control - actions (closes: #127354) - - Add searching by owner (closes: #345407) - - Accept colon after package in control mails (closes: #319720) - - Make e-mail addresses case insensitive for searching - (closes: #89569) - - pkgindex.cgi limits its output with pagination (closes: #23018) - - lc submitter address for comparsion in pkgreport.cgi - (closes: #415628) - - Add quotes around retitle'd titles (closes: #419202) - - Don't automatically make categories hidden (closes: #415932) - - Don't duplicate ordering (closes: #415931) - - Make file locking portable (closes: #293277) - - Allow the package pages to be optional (closes: #234362) - - Fix package link code and link both packages (closes: #419553) - - Save leading space when we unmime (closes: #416321) - - Make the version regex correct (closes: #425614) - - Indicate the selected user (closes: #422934) - - Use source package for usertags where possible (closes: #415933) - - Add PR-Package header for control messages (closes: #414023) - - Fix double leading spaces of format=flowed messages - (closes: #428056) - - Don't doubly select users - - Implement versioning aware archiving support (closes: #339141) - - Split out packages so that you don't have to install the mail stuff - unless you want it. - - Only mail duplicated recipients once (closes: #172635) - - Indicate date of last activity (closes: #207065) - - Reorder title (closes: #265267) - - Reopen bugs when a bug is found with a version greater than any - fixed version (closes: #365352) - - Allow ordering bugs by last action (closes: #318898) - - Add notfixed/notfound commands (closes: #389634) - - Fix soapy insanity (closes: #422062) - - Add script to split index.db by severities (closes: #422062) - - Add bugspam.cgi with confirm string (closes: #348225) - - Allow selecting both archived and unarchived bugs (closes: #320175) - - Support intersecting sets of bugs (closes: #164421) - - Allow selecting the newest N bugs (closes: #84681) - - Add anchor links to specific messages (closes: #431450) - - Add missing newline after indicating what the user is (closes: #432466) - - Handle src/binary packages with the same name (but different src - packages) correctly. (closes: #435926) - - Make sendmail binary location configurable, and use flock instead of - fcntl. (closes: #260791) - - Make notfound/notfixed log verbiage more clear (closes: #434953) - - Verify submitter is a valid email according to RFC822 - (closes: #182419) - - Indicate what message number a message is (closes: #462653,#454248) - - Fix casing of versions (closes: #441022) - - Output last-modified in bugreport.cgi (closes: #459709) - - Fix various html syntax errors in pkgreport.cgi (closes: #462322) - - Make search case insensitive (closes: #448861) - - Add the ability to return source/package mapping - (closes: #465332,#458822) - - Deal properly with \r line endings (closes: #467190) - - Distinguish between reports and followups (closes: #459866) + [ Anthony Towns ] + * Add "package" command to service (control@) to limit the bugs that + the following commands apply to. + + [ Colin Watson ] + * Add (slightly) fancy CGI decoding of message/* MIME types. + * CGI scripts now support multiple maintainers for a single package. + * Add support for an X-Debbugs-No-Ack: mail header to suppress + acknowledgements. + * Document how to deliver mail to debbugs via procmail and SpamAssassin. + * Implement new .status format that's extensible and easier to read; it + now lives in .summary rather than .status. Use debbugs-upgradestatus + to convert existing bug databases. + * Implement bug ownership, with new 'owner' and 'noowner' commands and + Owner: pseudo-header (closes: #133453). + * Install Debian configuration in the binary package's examples + directory (closes: #222118). + * New standalone SpamAssassin queue runner, spamscan. + * Allow # prefix on bug numbers in 'merge' command. + * Fix some ordering issues in old-style package pages and summaries. + * Add X-$gProject-PR-Message: headers to all mails sent by service. + * debbugsconfig creates required directories in $gSpoolDir + (closes: #222077). + * Decode RFC1522 mail headers for display in the web interface. + bugreport.cgi and pkgreport.cgi now output UTF-8. + * Properly support multiple submitter addresses on a single bug. + * Add a number of extra htmlsanit() calls to prevent cross-site + scripting attacks. + + [ Adam Heath ] + * Rewrite filtering in cgi's common.pl, to make it completely generic. + Filtering can now work against any field. + * Rewrite grouping logic in cgi's common.pl, to make it completely + generic. There is now no longer 2 nested loops, to do the grouping. + This makes adding new grouping levels simpler for the future. + * Add in a Table of Contents to pkgreport.cgi. + * Display how long until a resolved bug will be archived in + pkgreport.cgi. + * Add user-agent detection. This currently doesn't change anything, + however. + * Add options show_list_(head|foot)er. + + [ Don Armstrong ] + * Don't remove the maintainer address if the message was sent by the + maintainer and we're submitting to maintonly (closes: #140061) + * Use uri_escape to escape URI's before sending them back out so the + name of the file doesn't munge the query string. [#301606 pt. 1] + * call decode_rfc1522 on the filename returned so that encoded + filenames get decoded to something "reasonable." (closes: #301606) + * We now require URI::Escape + * Added apache.conf to examples, which is a sample apache + configuration file which implements the rewrite rules that are + currently used on bugs.debian.org. (closes: #222264) + * Change spamscan.in to work with SA 3.0; This is an incompatible + change with SA 2.6, and as such, we now Suggests: spamassassin + (>=3.0) (closes: #290501) + * Update MTA to exim4 (closes: #228597) and add instructions on using + exim 4 (thanks to Marc Haber) (closes: #248335) + * Added per bug subscription support to debbugs, which relies on an + external MLM to actually deal with the requests; currently works with + eoc and sends messages to bugnum\@$gListDomain. (closes: #34071) + * Change bugreport.cgi to use Debbugs::Log and greately simplify the + process of outputing the bug log. + * All RFC1522 subject lines are decoded, both in the html information + and the message headers. All messages are converted to UTF-8 whereever + possible; all bugreport.cgi pages are now completely in UTF-8 to the + degree possible using Encode.pm (closes: #46848,#238984) + * Add a convert_to_utf8 function to Debbugs::Mime to make the above + possible; abstracts functionality that was already present in the + decode_rfc1522 fucntionality. + * Individual messages can now be downloaded from each bug report + (closes: #95373) + * Uninteresting headers are now hidden by default, can be renabled + with &trim=no (closes: #188561) + * Fix postfix instructions in README.mail (thanks to Jeff Teunissen) + (closes: #134166) + * Display old severity when changing severity (closes: #196947) + * All messages that originate from the BTS and either go to .log files + or out to users are now properly RFC1522 encoded. (closes: #306068) + * Add links to cloned bugs (closes: #217960) and forwarded records + that look like urls in the html records output by bugreport.cgi. + * Things that look like urls in message bodies are now linked + (closes: #168962) + * Add Debbugs::Mail module that has two important functions: + send_mail_message and encode_headers. All mail handling in service.in + and process.in now uses send_mail_message to send mail messages which + tries as hard as possible to send a message; if it fails, only + warnings are returned. This fixes bad addresses causing sendmail to + exit and destroying the bug log. (closes: #191306) + * Add rudimentary Test::More modules for testing Debbugs::Mime and + Debbugs::Mail. + * Allow X-debbugs-* to be set in pseudo headers. (closes: #179340) + * Obey X-Debbugs-No-Ack in control@ messages. (closes: #201825) + * Allow forwarded: and owner to be set at submit@ time. + (closes:#128320) + * Fix example rewrite rules to allow for #1234 and foo+bar@baz.com + (closes: #321925) + * Output proper charset for attachments (closes: #335813) + * Use MIME encodings to attach messages in close and done. + (closes: #136654) + * Add a forcemerge command to service.in to allow forcibly merging + bugs which are in the same package. (closes: #286792) + * Make all packages lowercase to support packages with uppercase + names, even though that's insane. (closes: #67067) + * Change acknowledged to close (closes: #61341) and indicate who + actually closed the bug (closes: #355968, #132274) + * Fix the documentation of clone to indicate that you need at least + one newID (closes: #276747) + * Use create_mime_message to send all of the mails which may contain + UTF8 material. (closes: #364026) + * Add links to Closes: text for closed bugs. (closes: #320986) + * Add X-$gProject-PR-Source: line (closes: #219230) + * Use the %cats data structure properly in pkgreport.cgi + (closes: #367514) + * Document nnn.*@foobar addresses (closes: #188670) + * Support cloned bugs in control blocking (closes: #337329) + * Indicate which bugs are blocked after blocking (closes: #367496) + * Obey package for usertags (closes: #376528) + * Add link to subscribe to a bug (closes: #353260) + * Don't lc owner or forwarded at submit time (closes: #288384) + * Explain how to close bugs in the ack message (closes: #37605) + * Make the moreinfo ack more general (closes: #70810) + * Use RFC compliant dates in headers (closes: #362935) + * Add SOAP support (closes: #377520) Thanks to Raphael Hertzog. + * Split forwarded on commas for linking (closes: #367813,#473272) + * Don't display duplicate bugs (closes: #348116) + * Display links to archived bugs for all searches (closes: #53710) + * Link to blocked bugs in the bugreport.cgi output (closes: #326077) + * Don't ask for more bugs if there is no maintainer (closes: #355190) + * Stop refering to developers on the index page (closes: #355786) + * Change control@ stop regex and documentation to match eachother + (closes: #366093) + * Make it obvious when commands to control have failed + (closes: #344184) + * Fix javascript error in pkgreport.cgi (closes: #346043) + * When a bug can't be found in control@; indicate to user that it may + be archived. (closes: #153536) + * my_url in pkgreport.cgi now returns the complete url (closes: #378566) + * Document precisely how forwarded works (closes: #228049) + * Dissallow forwarded being set to a $gEmailDomain address + (closes: #397486) + * Fix broken sorting by usertags by forcing numeric (closes: #395027) + * Add support for hiding useless messages; thanks to Sune Vuorela. + (closes: #406020) + * Fix arrayrefs leaking into the myurl function (closes: #397344) + * List bugs being blocked (closes: #356680) + * Fix multiple submitters for a single bug in the index + (closes: #402362) + * Marking a bug as fixed now overrides a found at that exact version + (closes: #395865) + * When searching by source package, include the source package itself + in the list of packages to search for, even if there is no binary + package called that. (closes: #414825) + * Add link from singlemsg page to main page; remove useless links + (closes: #404806) + * Support usertagging cloned bugs (closes: #375697) + * List previous/new title when retitling, and show date of control + actions (closes: #127354) + * Add searching by owner (closes: #345407) + * Accept colon after package in control mails (closes: #319720) + * Make e-mail addresses case insensitive for searching + (closes: #89569) + * pkgindex.cgi limits its output with pagination (closes: #23018) + * lc submitter address for comparsion in pkgreport.cgi + (closes: #415628) + * Add quotes around retitle'd titles (closes: #419202) + * Don't automatically make categories hidden (closes: #415932) + * Don't duplicate ordering (closes: #415931) + * Make file locking portable (closes: #293277) + * Allow the package pages to be optional (closes: #234362) + * Fix package link code and link both packages (closes: #419553) + * Save leading space when we unmime (closes: #416321) + * Make the version regex correct (closes: #425614) + * Indicate the selected user (closes: #422934) + * Use source package for usertags where possible (closes: #415933) + * Add PR-Package header for control messages (closes: #414023) + * Fix double leading spaces of format=flowed messages + (closes: #428056) + * Don't doubly select users + * Implement versioning aware archiving support (closes: #339141) + * Split out packages so that you don't have to install the mail stuff + unless you want it. + * Only mail duplicated recipients once (closes: #172635) + * Indicate date of last activity (closes: #207065) + * Reorder title (closes: #265267) + * Reopen bugs when a bug is found with a version greater than any + fixed version (closes: #365352) + * Allow ordering bugs by last action (closes: #318898) + * Add notfixed/notfound commands (closes: #389634) + * Fix soapy insanity (closes: #422062) + * Add script to split index.db by severities (closes: #422062) + * Add bugspam.cgi with confirm string (closes: #348225) + * Allow selecting both archived and unarchived bugs (closes: #320175) + * Support intersecting sets of bugs (closes: #164421) + * Allow selecting the newest N bugs (closes: #84681) + * Add anchor links to specific messages (closes: #431450) + * Add missing newline after indicating what the user is (closes: #432466) + * Handle src/binary packages with the same name (but different src + packages) correctly. (closes: #435926) + * Make sendmail binary location configurable, and use flock instead of + fcntl. (closes: #260791) + * Make notfound/notfixed log verbiage more clear (closes: #434953) + * Verify submitter is a valid email according to RFC822 + (closes: #182419) + * Indicate what message number a message is (closes: #462653,#454248) + * Fix casing of versions (closes: #441022) + * Output last-modified in bugreport.cgi (closes: #459709) + * Fix various html syntax errors in pkgreport.cgi (closes: #462322) + * Make search case insensitive (closes: #448861) + * Add the ability to return source/package mapping + (closes: #465332,#458822) + * Deal properly with \r line endings (closes: #467190) + * Distinguish between reports and followups (closes: #459866) + * Allow for the archiving of bugs in removed packages (closes: #475622) + * Add Text::Template based templating system (closes: #36814) + * Add new uservalue feature to Debbugs::User + * Don't serialize things as date/time in soap (closes: #484789) -- Colin Watson Fri, 20 Jun 2003 18:57:25 +0100 diff --git a/html/bugs.css b/html/bugs.css index ed42581..43f58cb 100644 --- a/html/bugs.css +++ b/html/bugs.css @@ -2,14 +2,14 @@ html { color: #000; background: #fefefe; font-family: serif; - margin: 1em; + margin: 0; border: 0; padding: 0; line-height: 120%; } body { - margin: 0; + margin: 10px; border: 0; padding: 0; } @@ -120,6 +120,42 @@ pre.mime { color: #686868; } +.buginfo p +{ + font-family: sans-serif; + font-size: 110%; + margin-bottom: 0px +} + +.buginfo p + p +{ + margin: 0; + margin-top: 0px; + border: 0; +} + + +.pkginfo p +{ font-family: sans-serif; + font-size: 110%; + margin-bottom: 0px +} + +.pkginfo p + p +{ + margin: 0; + margin-top: 0px; + padding: 0; + border: 0; +} + + +.versiongraph +{ + float: right + +} + pre.tags { color: #a3a3a3; font-size: 90%; @@ -162,6 +198,36 @@ li { list-style-type: square; } +.shortbugstatus +{ + font-family: sans-serif; + + } + +.shortbugstatusextra +{ font-family: sans-serif; + margin: 5px; + margin-top: 2px; + padding: 5px; + /* display: none; */ + /* z-index: 1; */ + /* position: absolute; */ + left: 120px; + background-color: #ffffff; +/* border: #000 1px solid; */ + position: static; + display: block; + border: 0; + } + +.shortbugstatusextra span +{ margin: 0; + margin-top: 0px; + padding: 0; + border: 0; + display: block; + } + .bugs li { margin-top: 5px; } diff --git a/scripts/age-1 b/scripts/age-1 new file mode 100755 index 0000000..cc2e72d --- /dev/null +++ b/scripts/age-1 @@ -0,0 +1,8 @@ +#!/bin/sh +# $Id: age-1.in,v 1.3 2002/01/06 10:46:24 ajt Exp $ +set -e +cd /var/lib/debbugs/spool/db-h +test -f ./-3.log && rm ./-3.log +test -f ./-2.log && mv ./-2.log ./-3.log +test -f ./-1.log && mv ./-1.log ./-2.log +#rm -f ../stamp.html diff --git a/scripts/age-1.in b/scripts/age-1.in deleted file mode 100755 index cc2e72d..0000000 --- a/scripts/age-1.in +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh -# $Id: age-1.in,v 1.3 2002/01/06 10:46:24 ajt Exp $ -set -e -cd /var/lib/debbugs/spool/db-h -test -f ./-3.log && rm ./-3.log -test -f ./-2.log && mv ./-2.log ./-3.log -test -f ./-1.log && mv ./-1.log ./-2.log -#rm -f ../stamp.html diff --git a/scripts/config b/scripts/config new file mode 100644 index 0000000..4767f6a --- /dev/null +++ b/scripts/config @@ -0,0 +1,83 @@ +# -*- mode: cperl -*- +# This is the template debbugs configuration file. +# You *must* edit it in order for debbugs to work. +# $Id: config.in,v 1.23 2005/07/17 19:07:01 cjwatson Exp $ + +# Domains +$gEmailDomain = "bugs.something"; # e.g. bugs.debian.org +$gListDomain = "lists.something"; # e.g. lists.debian.org +$gWebHost = "localhost"; # e.g. www.debian.org +$gWebHostBugDir = "Bugs"; # e.g. Bugs +# For now, don't change this one manually! +$gWebDomain = "$gWebHost/$gWebHostBugDir"; +$gHTMLSuffix = ".html"; +$gCGIDomain = "$gWebDomain/cgi"; # e.g. cgi.debian.org +$gMirrors = ""; # comma separated list +$gPackagePages = "packages.debian.org"; # e.g. packages.debian.org +$gSubscriptionDomain = "packages.something"; # e.g. packages.qa.debian.org + +# Project identification +$gProject = "Something"; # e.g. Debian +$gProjectTitle = "Something DebBugs Test"; # e.g. Debian GNU/Linux +# Person(s) responsible for this installation +$gMaintainer = "Local DebBugs Owner"; # e.g. Ian Jackson +$gMaintainerWebpage = "http://localhost/~owner"; # e.g. http://www.debian.org/~iwj +$gMaintainerEmail = "root\@something"; # e.g. owner@bugs.debian.org +$gUnknownMaintainerEmail = "$gMaintainerEmail"; # e.g. unknown-package@qa.debian.org + +# BTS mailing lists, at $gListDomain +# if you don't want lists, set them all to $gMaintainerEmail +# if you don't want that mail at all, filter it out somehow :) +$gSubmitList = "bug-submit-list"; # e.g. debian-bugs-dist +$gMaintList = "bug-maint-list"; # e.g. debian-bugs-dist +$gQuietList = "bug-quiet-list"; # e.g. debian-bugs-dist +$gForwardList = "bug-forward-list"; # e.g. debian-bugs-forwarded +$gDoneList = "bug-done-list"; # e.g. debian-bugs-closed +$gRequestList = "bug-request-list"; # e.g. debian-bugs-dist +$gSubmitterList = "bug-submitter-list"; # e.g. debian-bugs-dist +$gControlList = "bug-control-list"; # e.g. debian-bugs-dist +$gSummaryList = "bug-summary-list"; # e.g. debian-bugs-reports +$gMirrorList = "bug-mirrors-list"; # sends to all mirrors + +# Various configurable options +$gMailer = "exim"; # valid: exim, qmail and sendmail +$gBug = "bug"; # how to spell `bug' +$gBugs = "bugs"; # how to spell `bugs' +$gRemoveAge = 28; # days after closed bugs are cleaned out, + # 0 disables +$gSaveOldBugs = 1; # whether to archive such bugs +$gDefaultSeverity = "normal"; +$gShowSeverities = "critical, grave, normal, minor, wishlist"; +@gStrongSeverities = ( 'critical', 'grave' ); +@gSeverityList = ( 'critical', 'grave', 'normal', 'wishlist' ); +%gSeverityDisplay = ( 'critical', "Critical $gBugs", + 'grave', "Grave $gBugs", + 'normal', "Normal $gBugs", + 'wishlist', "Wishlist items" ); +@gTags = ( 'patch', 'wontfix', 'moreinfo', 'unreproducible', 'fixed', 'stable' ); + +# better don't change this +$gBounceFroms = "^mailer|^da?emon|^post.*mast|^root|^wpuser|^mmdf|^smt.*|^mrgate|^vmmail|^mail.*system|^uucp|-maiser-|^mal\@|^mail.*agent|^tcpmail|^bitmail|^mailman"; + +# Directories -- do _not_ change their locations. +# They are currently hardcoded, variables are here for future expansion. +$gConfigDir = "/etc/debbugs"; # directory where this file is +$gSpoolDir = "/var/lib/debbugs/spool"; # working directory +$gIncomingDir = "incoming"; # unprocessed e-mails +$gWebDir = "/var/lib/debbugs/www"; # base location of web pages +$gDocDir = "/var/lib/debbugs/www/txt"; # location of text doc files + +# Required data files +$gMaintainerFile = "$gConfigDir/Maintainers"; +$gMaintainerFileOverride = "$gConfigDir/Maintainers.override"; +$gPseudoDescFile = "$gConfigDir/pseudo-packages.description"; +$gPackageSource = "$gConfigDir/indices/sources"; + + +# Estraier Configuration +%gSearchEstraier = (url => 'http://localhost:1978/node/bts1', + user => 'user', + pass => 'pass', + ); + +1; diff --git a/scripts/config.in b/scripts/config.in deleted file mode 100644 index 4767f6a..0000000 --- a/scripts/config.in +++ /dev/null @@ -1,83 +0,0 @@ -# -*- mode: cperl -*- -# This is the template debbugs configuration file. -# You *must* edit it in order for debbugs to work. -# $Id: config.in,v 1.23 2005/07/17 19:07:01 cjwatson Exp $ - -# Domains -$gEmailDomain = "bugs.something"; # e.g. bugs.debian.org -$gListDomain = "lists.something"; # e.g. lists.debian.org -$gWebHost = "localhost"; # e.g. www.debian.org -$gWebHostBugDir = "Bugs"; # e.g. Bugs -# For now, don't change this one manually! -$gWebDomain = "$gWebHost/$gWebHostBugDir"; -$gHTMLSuffix = ".html"; -$gCGIDomain = "$gWebDomain/cgi"; # e.g. cgi.debian.org -$gMirrors = ""; # comma separated list -$gPackagePages = "packages.debian.org"; # e.g. packages.debian.org -$gSubscriptionDomain = "packages.something"; # e.g. packages.qa.debian.org - -# Project identification -$gProject = "Something"; # e.g. Debian -$gProjectTitle = "Something DebBugs Test"; # e.g. Debian GNU/Linux -# Person(s) responsible for this installation -$gMaintainer = "Local DebBugs Owner"; # e.g. Ian Jackson -$gMaintainerWebpage = "http://localhost/~owner"; # e.g. http://www.debian.org/~iwj -$gMaintainerEmail = "root\@something"; # e.g. owner@bugs.debian.org -$gUnknownMaintainerEmail = "$gMaintainerEmail"; # e.g. unknown-package@qa.debian.org - -# BTS mailing lists, at $gListDomain -# if you don't want lists, set them all to $gMaintainerEmail -# if you don't want that mail at all, filter it out somehow :) -$gSubmitList = "bug-submit-list"; # e.g. debian-bugs-dist -$gMaintList = "bug-maint-list"; # e.g. debian-bugs-dist -$gQuietList = "bug-quiet-list"; # e.g. debian-bugs-dist -$gForwardList = "bug-forward-list"; # e.g. debian-bugs-forwarded -$gDoneList = "bug-done-list"; # e.g. debian-bugs-closed -$gRequestList = "bug-request-list"; # e.g. debian-bugs-dist -$gSubmitterList = "bug-submitter-list"; # e.g. debian-bugs-dist -$gControlList = "bug-control-list"; # e.g. debian-bugs-dist -$gSummaryList = "bug-summary-list"; # e.g. debian-bugs-reports -$gMirrorList = "bug-mirrors-list"; # sends to all mirrors - -# Various configurable options -$gMailer = "exim"; # valid: exim, qmail and sendmail -$gBug = "bug"; # how to spell `bug' -$gBugs = "bugs"; # how to spell `bugs' -$gRemoveAge = 28; # days after closed bugs are cleaned out, - # 0 disables -$gSaveOldBugs = 1; # whether to archive such bugs -$gDefaultSeverity = "normal"; -$gShowSeverities = "critical, grave, normal, minor, wishlist"; -@gStrongSeverities = ( 'critical', 'grave' ); -@gSeverityList = ( 'critical', 'grave', 'normal', 'wishlist' ); -%gSeverityDisplay = ( 'critical', "Critical $gBugs", - 'grave', "Grave $gBugs", - 'normal', "Normal $gBugs", - 'wishlist', "Wishlist items" ); -@gTags = ( 'patch', 'wontfix', 'moreinfo', 'unreproducible', 'fixed', 'stable' ); - -# better don't change this -$gBounceFroms = "^mailer|^da?emon|^post.*mast|^root|^wpuser|^mmdf|^smt.*|^mrgate|^vmmail|^mail.*system|^uucp|-maiser-|^mal\@|^mail.*agent|^tcpmail|^bitmail|^mailman"; - -# Directories -- do _not_ change their locations. -# They are currently hardcoded, variables are here for future expansion. -$gConfigDir = "/etc/debbugs"; # directory where this file is -$gSpoolDir = "/var/lib/debbugs/spool"; # working directory -$gIncomingDir = "incoming"; # unprocessed e-mails -$gWebDir = "/var/lib/debbugs/www"; # base location of web pages -$gDocDir = "/var/lib/debbugs/www/txt"; # location of text doc files - -# Required data files -$gMaintainerFile = "$gConfigDir/Maintainers"; -$gMaintainerFileOverride = "$gConfigDir/Maintainers.override"; -$gPseudoDescFile = "$gConfigDir/pseudo-packages.description"; -$gPackageSource = "$gConfigDir/indices/sources"; - - -# Estraier Configuration -%gSearchEstraier = (url => 'http://localhost:1978/node/bts1', - user => 'user', - pass => 'pass', - ); - -1; diff --git a/scripts/db2html b/scripts/db2html new file mode 100755 index 0000000..f39ea98 --- /dev/null +++ b/scripts/db2html @@ -0,0 +1,653 @@ +#!/usr/bin/perl +# $Id: db2html.in,v 1.22 2004/04/19 10:03:53 cjwatson Exp $ +# usage: db2html [-diff] [-stampfile=] [-lastrun=] + +#load the necessary libraries/configuration +$config_path = '/etc/debbugs'; +$lib_path = '/usr/lib/debbugs'; + +require("$config_path/config"); +require("$config_path/text"); +require("$lib_path/errorlib"); +$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'}; + +use POSIX qw(strftime tzset); +$ENV{"TZ"} = 'UTC'; +tzset(); + +#set current working directory +chdir("$gSpoolDir") || die "chdir spool: $!\n"; + +#setup variables +$diff = 0; +$stampfile = 'stamp.html'; +$tail_html = $gHTMLTail; +$expirynote_html = ''; +$expirynote_html = $gHTMLExpireNote if $gRemoveAge; +$shorthead = ' Ref * Package Keywords/Subject Submitter'; +$shortindex = ''; +$amonths = -1; +$indexunmatched = ''; +%displayshowpendings = ('pending','outstanding', + 'done','resolved', + 'forwarded','forwarded to upstream software authors'); + +#set timestamp for html files +$dtime = strftime "%a, %e %b %Y %T UTC", localtime; +$tail_html =~ s/SUBSTITUTE_DTIME/$dtime/; + +#check for commandline switches +while (@ARGV && $ARGV[0] =~ m/^-/) +{ if ($ARGV[0] eq '-diff') { $diff=1; } + elsif ($ARGV[0] =~ m/^-lastrun\=([0-9.]+)$/) { $lastrun= $1; undef $stampfile; } + elsif ($ARGV[0] =~ m/^-full$/) { undef $lastrun; undef $stampfile; } + elsif ($ARGV[0] =~ m/^-stampfile\=(\S+)$/) { $stampfile= $1; } + else { die "bad usage"; } + shift; +} + +#check for remaing argument, only one... +@ARGV==1 or die; +$wwwbase= shift(@ARGV); + +#get starting time +defined($startdate= time) || die "failed to get time: $!"; + +$|=1; + +#if stamp file was given, +if (defined($stampfile)) +{ if (open(X,"< $stampfile")) + { $lastrun= -M X; + close(X); + printf "progress last run %.7f days\n",$lastrun; + } else { print "progress stamp file $stampfile: $! - full\n"; } +} + +#only process file if greater than last run... +if (defined($lastrun) && -M "db-h" > $lastrun) +{ $_= $gHTMLStamp; + s/SUBSTITUTE_DTIME/$dtime/o; + s/\<\!\-\-updateupdate\-\-\>.*\<\!\-\-\/updateupdate\-\-\>/check/; + &file('ix/zstamp.html','non',$_."\n"); + print "noremoves"; +# print "db2html: no changes since last run\n"; + exit 0; +} + +#parse maintainer file +open(MM,"$gMaintainerFile") || die "open $gMaintainerFile: $!"; +while() +{ m/^(\S+)\s+(\S.*\S)\s*$/ || die "$gMaintainerFile: \`$_'"; + ($a,$b)=($1,$2); + $a =~ y/A-Z/a-z/; + $maintainer{$a}= $b; +} +close(MM); + +#load all database files +opendir(D,'db-h') || die "opendir db-h: $!"; +@dirs = grep(s#^#db-h/#,grep(/^\d+$/,readdir(D))); +closedir(D); +foreach my $dir (@dirs) { + opendir(D,$dir); + push @files, grep(/^-?\d+\.log$/,readdir(D)); + closedir(D); +} +@files = sort { $a <=> $b } @files; + +for $pending (qw(pending done forwarded)) +{ for $severity (@showseverities) + { eval "\$index${pending}${severity}= \$iiindex${pending}${severity}= ''; 1;" + or die "reset \$index${pending}${severity}: $@"; + } +} + +for $f (@files) +{ next unless $f =~ m/^(-?\d+)\.log$/; + $ref= $1; + #((print STDERR "$ref\n"), + #next + #) + # unless $ref =~ m/^-/ || $ref =~ m/^124/; + &filelock("lock/$ref"); + $preserveonly= defined($lastrun) && -M "db-h/".get_hashname($ref)."/$ref.log" > $lastrun; + if ($ref =~ m/^-\d$/) + { $week= $ref eq '-1' ? 'this week' : + $ref eq '-2' ? 'last week' : + $ref eq '-3' ? 'two weeks ago' : + ($ref-1)." weeks ago"; + $linkto= "ju/unmatched$ref"; + $short= "junk, $week"; + $descriptivehead= + "This includes messages sent to done\@$gEmailDomain\n". + "which did not have a $gBug reference number in the Subject line\n". + "or which contained an\n". + "unknown or out of date $gBug report number (these cause a warning\n". + "to be sent to the sender) and details about the messages\n". + "sent to request@$gEmailDomain (all of which". + "produce replies).\n"; + $indexlink= "Messages not matched to a specific $gBug report - $week"; + $data->{subject}= ''; + $indexentry= ''; + undef $tpack; + undef $tmaint; + undef $iiref; + $tpackfile= "pnone.html"; + $indexpart= 'unmatched'; + } else + { + $data=readbug($ref); + $_= $data->{package}; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9()]/; + $tpack= $_; + if ($data->{severity} eq '' || $data->{severity} eq 'normal') + { $showseverity= ''; + $addseverity= $gDefaultSeverity; + } elsif (isstrongseverity($data->{severity})) + { $showseverity= "Severity: $data->{severity};\n"; + $addseverity= $data->{severity}; + } else + { $showseverity= "Severity: $data->{severity};\n"; + $addseverity= $data->{severity}; + } + $days= int(($startdate - $data->{date})/86400); close(S); + $indexlink= "#$ref: ".&sani($data->{subject}); + $indexentry= ''; + $packfile= length($tpack) ? "pa/l$tpack.html" : "pa/none.html"; + $indexentry .= "Package: ". + &sani($data->{package}).";\n" + if length($data->{package}); + $indexentry .= $showseverity; + $indexentry .= "Reported by: ".&sani($data->{originator}); + $indexentry .= ";\nOwned by: ".&sani($data->{owner}) + if length($data->{owner}); + $indexentry .= ";\nKeywords: ".&sani($data->{keywords}) + if length($data->{keywords}); + $linkto= $ref; $linkto =~ s,^..,$&/$&,; + @merged= split(/ /,$data->{mergedwith}); + if (@merged) + { $mseparator= ";\nmerged with "; + for $m (@merged) + { $mfile= $m; $mfile =~ s,^..,$&/$&,; + $indexentry .= $mseparator."#$m"; + $mseparator= ",\n"; + } + } + $daysold=$submitted=''; + if (length($data->{done})) + { $indexentry .= ";\nDone: ".&sani($data->{done}); + $indexpart= "done$addseverity"; + } elsif (length($data->{forwarded})) + { $indexentry .= ";\nForwarded to ".&sani($data->{forwarded}); + $indexpart= "forwarded$addseverity"; + } else + { $cmonths= int($days/30); + if ($cmonths != $amonths) + { $msg= $cmonths == 0 ? "Submitted in the last month" : + $cmonths == 1 ? "Over one month old" : + $cmonths == 2 ? "Over two months old - attention is required" : + "OVER $cmonths MONTHS OLD - ATTENTION IS REQUIRED"; + $shortindex .= "

    $msg:

    \n$shorthead\n";
+                $amonths= $cmonths;
+            }
+            $pad= 6-length(sprintf("%d",$f));
+            $thissient=
+                ($pad>0 ? ' 'x$pad : '').
+                sprintf("%d",$linkto,$ref).
+                &sani(sprintf(" %-1.1s %-10.10s %-35.35s %-.25s\n",
+						$data->{severity},
+                        $data->{package},
+                        (length($data->{keywords}) ? $data->{keywords}.'/' : '').
+                        $data->{subject}, $data->{originator}));
+            $shortindex.= $thissient;
+            $sient{"$ref $data->{package}"}= $thissient;
+            if ($days >= 7) 
+			{ 	$font= $days <= 30 ? '' :
+                	$days <= 60 ? 'em' :
+                    'strong';
+                $efont= length($font) ? "" : '';
+                $font= length($font) ? "<$font>" : '';
+                $daysold= "; $font$days days old$efont";
+            }
+            if ($preserveonly) {
+                $submitted = 'THIS IS A BUG IN THE BUG PROCESSOR';
+            } else {
+                $submitted = strftime "%a, %e %b %Y %T %Z", localtime($data->{date});
+            }
+            $submitted= "; dated $submitted";
+            $indexpart= "pending$addseverity";
+        }
+        $iiref= $ref;
+        $short= $ref; $short =~ s/^\d+/#$&/;
+        $tmaint= defined($maintainer{$tpack}) ? $maintainer{$tpack} : '(unknown)';
+        $qpackage= &sani($_);
+        $descriptivehead= $indexentry.$submitted.";\nMaintainer for $qpackage is\n".
+            ''.&sani($tmaint).'.';
+        $indexentry .= $daysold;
+        $indexentry .= ".";
+    }
+    $indexadd='';
+    $indexadd .= "" if defined($iiref);
+    $indexadd .= "
  • ".$indexlink."";
+    $indexadd .=  "
    \n".$indexentry if length($indexentry);
+    $indexadd .= "" if defined($iiref);
+    $indexadd .= "\n";
+    $estr= "\$index$indexpart = \$indexadd.\$index$indexpart; 1;";
+    eval($estr) || die "eval add to \$index$indexpart ($estr) failed: $@";
+	#print STDERR ">$estr|$indexadd<\n";
+    $indexadd= "\n" if defined($iiref);
+    eval("\$iiindex$indexpart = \$indexadd.\$iiindex$indexpart; 1;") ||
+        die "eval add to \$iiindex$indexpart failed: $@";
+    if (defined($tmaint)) 
+	{ 	$countpermaint{$tmaint} += length($data->{done}) ? 0 : length($data->{forwarded}) ? 0 : 1;
+        eval("\$permaint${indexpart}{\$tmaint} .= \$indexadd; 1;") ||
+            die "eval add to \$permaint${indexpart}{\$tmaint} failed: $@";
+    }
+    if (defined($tpack)) 
+	{ 	$countperpack{$tpack} += length($data->{done}) ? 0 : length($data->{forwarded}) ? 0 : 1;
+        eval("\$perpack${indexpart}{\$tpack} .= \$indexadd; 1;") ||
+            die "eval add to \$perpack${indexpart}{\$tpack} failed: $@";
+    }
+    if ($preserveonly) { &preserve("$linkto.html"); &preserve("$linkto-b.html"); &unfilelock; next; }
+    my $hash = get_hashname($ref);
+    open(L,"db-h/$hash/$ref.log") || die "open db-h/$hash/$ref.log: $!";
+    $log='';
+    $boring=''; $xmessage= 0;
+    $normstate= 'kill-init';
+    $suppressnext= 0;
+    while() {
+        if (m/^\07$/) {
+            $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
+                die "$ref ^G in state $normstate";
+            $normstate= 'incoming-recv';
+        } elsif (m/^\01$/) {
+            $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
+                die "$ref ^A in state $normstate";
+            $normstate= 'autocheck';
+        } elsif (m/^\02$/) {
+            $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
+                die "$ref ^B in state $normstate";
+            $normstate= 'recips';
+        } elsif (m/^\03$/) {
+            $normstate eq 'go' || $normstate eq 'go-nox' || $normstate eq 'html' ||
+                die "$ref ^C in state $normstate";
+            $this .= "
    • \n" if $normstate eq 'go' || $normstate eq 'go-nox'; + if ($normstate eq 'html') { + $xmessage++; + $this .= " Full text". + " available."; + } + if ($suppressnext && $normstate ne 'html') { + $ntis= $this; $ntis =~ s:\:
    :i;
+                $boring .= "
    \n$ntis\n";
+            } else {
+                $log = $this. "
    \n". $log;
+            }
+            $suppressnext= $normstate eq 'html';
+            $normstate= 'kill-end';
+        } elsif (m/^\05$/) {
+            $normstate eq 'kill-body' || die "^E in state $normstate";
+            $this .= "
    \n";
+            $normstate= 'go';
+        } elsif (m/^\06$/) {
+            $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
+                die "$ref ^F in state $normstate";
+            $normstate= 'html'; $this= '';
+        } elsif ($normstate eq 'incoming-recv') {
+            $pl= $_; $pl =~ s/\n+$//;
+            m/^Received: \(at (\S+)\) by (\S+)\;/ ||
+                die "bad line \`$pl' in state incoming-recv";
+            $this = "
    Message received at ".&sani("$1\@$2").":

    \n".
+                    "
    \n".
+                    "$_";
+            $normstate= 'go';
+        } elsif ($normstate eq 'html') {
+            $this .= $_;
+        } elsif ($normstate eq 'go') {
+            s/^\030//;
+            $this .= &sani($_);
+        } elsif ($normstate eq 'go-nox') {
+            next if !s/^X//;
+            $this .= &sani($_);
+        } elsif ($normstate eq 'recips') {
+            if (m/^-t$/) {
+                $this = "
    Message sent:

    \n";
+            } else {
+                s/\04/, /g; s/\n$//;
+                $this = "
    Message sent to ".&sani($_).":

    \n";
+            }
+            $normstate= 'kill-body';
+        } elsif ($normstate eq 'autocheck') {
+            next if !m/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
+            $normstate= 'autowait';
+            $this = "
    Message received at $2:

    \n";
+        } elsif ($normstate eq 'autowait') {
+            next if !m/^$/;
+            $normstate= 'go-nox';
+            $this .= "
    \n";
+        } else {
+            die "$ref state $normstate line \`$_'";
+        }
+    }
+    die "$ref state $normstate at end" unless $normstate eq 'kill-end';
+    close(L);
+    if (length($boring)) {
+        &file("$linkto-b.html",'non',
+              "$gProject $gBug report logs - ".
+              "$short, boring messages\n".
+              "\n".
+              "$gHTMLStart
    $gProject $gBugreport logs -".
+              "\n $short,".
+              " boring messages
    \n$boring\n
    \n".
+              $tail_html."\n");
+    }
+    &file("$linkto.html",'non',
+          "$gProject $gBug report logs - ".
+          "$short\n".
+          "\n".
+          "$gHTMLStart
    $gProject $gBug report logs -  $short
    \n".
+          &sani($data->{subject})."
    ".
+          "$descriptivehead\n".
+          "\n
    \n".
+          $log.
+          $tail_html."\n");
+    &unfilelock;
+}
+
+sub maintsort {
+    $_= $_[0];
+    s/([^<>()]+) \(([^()<>]+)\)/$2 \<$1\>/;
+    
+    s/\s+/ /g;
+    s/^\s*//;
+    $email= s/ *\<[^<>()]+\>$//g ? $& : '';
+    $_= "$1 $_" if s/ (\S+)$//;
+    $_.= $email;
+    $_;
+}
+
+sub maintencoded {
+    return $maintencoded{$_[0]} if defined($maintencoded{$_[0]});
+    local ($input)= @_;
+    local ($todo,$encoded)= ($input);
+    while ($todo =~ m/\W/) {
+        $encoded.=$`.sprintf("-%02x_",unpack("C",$&));
+        $todo= $';
+    }
+    $encoded.= $todo;
+    $encoded =~ s/-2e_/\./g;
+    $encoded =~ s/^([^,]+)-20_-3c_(.*)-40_(.*)-3e_/$1,$2,$3,/;
+    $encoded =~ s/^(.*)-40_(.*)-20_-28_([^,]+)-29_$/,$1,$2,$3/;
+    $encoded =~ s/-20_/_/g;
+    $encoded =~ s/-([^_]+)_-/-$1/g;
+    $maintencoded{$input}= $encoded;
+}
+
+for $tmaint (keys %countpermaint) {
+    $_= $tmaint;
+    $after=$before=$sort2d=$sort2s=$sort1d=$sort1s='';
+    $after= "$&$after" if s/\s*\<[^<>()]+\>\s*$//;
+    $after= "$&$after" if s/\s*\)\s*$//;
+    $after= "$&$after" if s/\s*,.*$//;
+    $before.= $& if s/^.*\(\s*//;
+    $sort2d= $& if s/\S+$//;
+    $sort1d= $_;
+    while (s/^([^()<>]+)\. */$1 /) { };
+    s/\s+$//; y/A-Za-z/a-zA-Z/; $sort1s= $_;
+    $sort2s= $sort2d; $sort2s =~ y/A-Za-z/a-zA-Z/;
+    $maintsort{$tmaint}= $sort2s.' '.$sort1s.' '.$before.$sort1d.$sort2d.$after;
+    $maintdisplay{$tmaint}=
+        &sani($before).''.&sani($sort1d.$sort2d).''.&sani($after);
+}
+
+sub heading ($$) {
+    my ($pt,$sv) = @_;
+    return $displayshowseverities{$sv}.' - '.$displayshowpendings{$pt};
+}
+
+sub makeindex ($$$) {
+    my ($varprefix,$varsuffix,$tkey) = @_;
+    my ($pending,$severity,$anydone,$text);
+    $anydone= 0;
+    $text= '';
+    for $pending (qw(pending forwarded done)) {
+        for $severity (@showseverities) {
+            $estr= "\$value= \\${varprefix}${pending}${severity}${varsuffix}; 1;";
+#print STDERR $estr;
+            eval $estr
+                or die "eval get \$${varprefix}${pending}${severity} failed: $@";
+#print STDERR ">$$value<\n";
+            next unless length($$value);
+            $text.= "
    \n
    ".&heading($pending,$severity).":
    \n".
+                    "(List of all".
+                    " such $gBugs is available.)\n
      \n".
+                    $$value.
+                    "
    \n";
+            $anydone=1 if $pending eq 'done';
+        }
+    }
+    $text.= $expirynote_html if $anydone;
+    return $text;
+}        
+
+&file("ix/full.html",'def',
+      $gFullIndex.
+      makeindex('$index',"",'').
+      "
    \n".
+      $tail_html."\n");
+
+&file("ju/junk.html",'non',
+      $gJunkIndex.
+      "
    \n
    Junk (messages without a specific $gBug report number):
    \n".
+      "(\`this week' is everything since last Wednesday.)\n
      \n".
+      $indexunmatched.
+      "
    \n".
+      $tail_html."\n");
+
+$nobugs_html= "No reports are currently in this state.";
+$who_html= $gProject;
+$owner_addr= $gMaintainerEmail;
+$otherindex_html= "For other kinds of index or for other information about
+$gProject and the $gBug system, see the $gBug system top-level
+contents WWW page.
+
+";
+
+for $pending (qw(pending forwarded done)) {
+    for $severity (@showseverities) {
+        eval "\$value= \\\$iiindex${pending}${severity}; 1;"
+            or die "eval get \$iiindex${pendingtype}${severity} failed: $@";
+        $value= \$nobugs_html if !length($$value);
+        $headstring= &heading($pending,$severity);
+        &file("si/$pending$severity.html",'ref',
+              "$who_html $gBug reports: $headstring\n".
+              "\n".
+              "$gHTMLStart
    $who_html $gBug reports: $headstring
    \n".
+              $otherindex_html.
+              ($pending eq 'done' ? "
    \n$expirynote_html" : '').
+              "
    \n
      \n".
+              $$value.
+              "
    \n
    \n".
+              $tail_html."\n");
+    }
+}
+
+sub individualindexes ($\@&\%&&$$$$$&&) {
+    my ($filename,$keysref,$getfilenameref,$countref,$getdisplayref,
+        $getsimpledisplayref,$what,$caveat,$whatplural,$abbrev,$ihead,
+        $getxinforef,$getxindexref) = @_;
+    my ($itext,$i,$tkey,$sani,$count,$tfilename,$refto,$backnext,$xitext,$bugbugs);
+    $itext='';
+    for ($i=0; $i<=$#$keysref; $i++) {
+        $tkey= $$keysref[$i];
+        $tfilename= &$getfilenameref($tkey);
+        $sani= &$getsimpledisplayref($tkey);
+        $count= $$countref{$tkey};
+        $count= $count >= 1 ? "$count" : "no";
+        $bugbugs= $count == 1 ? "$gBug" : "$gBugs";
+        $xitext= &$getxindexref($tkey);
+        $xitext= length($xitext) ? "$count $bugbugs; $xitext"
+                                 : "$count outstanding $bugbugs";
+        $itext .= "
  • ".&$getdisplayref($tkey).""."\n".
+                  "  ($xitext)\n";
+        $backnext= '';
+        if ($i>0) {
+            $refto= $$keysref[$i-1];
+            $xitext= &$getxindexref($refto);
+            $xitext= " ($xitext)" if length($xitext);
+            $backnext .= "
    \nPrevious $what in list, ".&$getdisplayref($refto)."".
+                         "$xitext\n";
+        }
+        if ($i<$#$keysref) {
+            $refto= $$keysref[$i+1];
+            $xitext= &$getxindexref($refto);
+            $xitext= " ($xitext)" if length($xitext);
+            $backnext .= "
    \nNext $what in list, ".&$getdisplayref($refto)."".
+                         "$xitext\n";
+        }
+        &file($tfilename,'ref',
+              "$gProject $gBug reports: $what $sani\n".
+              "\n".
+              "$gHTMLStart
    $gProject $gBug reports: $what $sani
    \n".
+              &$getxinforef($tkey).
+              $caveat.
+              "See the listing of $whatplural.\n".
+              $backnext.
+              &makeindex("\$per${abbrev}","{\$tkey}",$tkey).
+              "
    \n".
+              $tail_html."\n");
+    }
+    &file($filename,'non',
+          $ihead.
+          "
      \n".
+          $itext.
+          "
    \n".
+          $tail_html."\n");
+}
+
+@maintainers= sort { $maintsort{$a} cmp $maintsort{$b}; } keys %countpermaint;
+individualindexes('ix/maintainers.html',
+                  @maintainers,
+                  sub { 'ma/l'.&maintencoded($_[0]).'.html'; },
+                  %countpermaint,
+                  sub { $maintdisplay{$_[0]}; },
+                  sub { &sani($_[0]); },
+                  'maintainer',
+                  "Note that there may be other reports filed under different
+				  variations on the maintainer\'s name and email address.
    ",
+                  'maintainers',
+                  'maint',
+                  $gMaintIndex,
+                  sub { return ''; },
+                  sub { return ''; });
+
+@packages= sort keys %countperpack;
+individualindexes('ix/packages.html',
+                  @packages,
+                  sub { length($_[0]) ? "pa/l$_[0].html" : 'pa/none.html'; },
+                  %countperpack,
+                  sub { length($_[0]) ? $_[0] : 'not specified'; },
+                  sub { &sani(length($_[0]) ? $_[0] : 'not specified'); },
+                  'package',
+                  "Note that with multi-binary packages there may be other
+				  reports filed under the different binary package names.
    ",
+                  'packages',
+                  'pack',
+                  $gPackageIndex,
+                  sub {
+                      return unless defined($maintainer{$_[0]});
+                      $tmaint= $maintainer{$_[0]};
+                      return "Maintainer for $_[0] is ".&sani($tmaint).".\n
    \n";
+                  },
+                  sub {
+                      return unless defined($maintainer{$_[0]});
+                      $tmaint= $maintainer{$_[0]};
+                      return "".&sani($tmaint)."";
+                  });
+
+&file('ix/summary.html','non',
+      $gSummaryIndex.
+      "
    \n".
+      $shortindex.
+      "
    \n".
+      $tail_html."\n");
+
+$bypackageindex='';
+for $k (map {$_->[0] }
+	sort { $a->[2] cmp $b->[2]  ||  $a->[1] <=> $b->[1] }
+	map { [$_, split(' ',$_,2)] } keys %sient)
+    { $bypackageindex.= $sient{$k}; }
+&file('ix/psummary.html','non',
+      $gPackageLog.
+      "
    \n$shorthead\n".
+      $bypackageindex.
+      "
    \n".
+      $tail_html."\n");
+
+open(P,"$gPseudoDescFile") ||
+    die "$gPseudoDescFile: $!";
+$ppd=''; while(
    ) { s/\s*\n$//; $ppd.= &sani($_)."\n"; } close(P);
+&file('ix/pseudopackages.html','non',
+      $gPseudoIndex.
+      "
    \n$ppd".
+      "
    \n".
+      $tail_html."\n");
+
+$_= $gHTMLStamp; s/SUBSTITUTE_DTIME/$dtime/o;
+
+&file('ix/zstamp.html','non',$_."\n");
+
+sub notimestamp ($) {
+    $_= $_[0];
+    s/\<\!\-\-timestamp\-\-\>\n.*\n\<\!\-\-\/timestamp\-\-\>\n//;
+    return $_;
+}
+
+sub file {
+    local ($name,$ii,$file)= @_;
+    if ($diff) {
+        $cmppath= "$wwwbase/$name".($ii eq 'ref' ? '.ref' : '');
+        if (open(ORIG,"$cmppath")) {
+            undef $/; $orig= ; $/= "\n";
+            close(ORIG);
+            if (¬imestamp($orig) eq ¬imestamp($file)) {
+		print "preserve $name\n";
+		return;
+	    }
+            defined($c= open(P,"-|")) or die "pipe/fork for diff: $!";
+            if (!$c) {
+                open(Q,"|diff -e $cmppath -") or die "pipe/fork II for diff: $!\n";
+                print Q $file or die "write orig to diff: $!\n";
+                close(Q); $?==0 || $?==256 or die "diff gave $?\n";
+                exit($?>>8);
+            }
+            undef $/; $difftxt= 
    ; $/= "\n";
+            close(P); $?==0 || $?==256 or die "diff fork gave $?\n";
+            if ($?==0) {
+                print "preserve $name\n";
+                return;
+            }
+            $v= (split(/\n/,$difftxt));
+            print "diff $v $ii $name\n${difftxt}thatdiff $name\n"
+                or die "stdout (diff): $!";
+            return;
+        }
+    } 
+    $v= (split(/\n/,$file));
+    print "file $v $ii $name\n${file}thatfile $name\n" or die "stdout: $!";
+}
+
+sub preserve {
+    print "preserve $_[0]\n";
+}
+
+print "end\n";
+
+while ($u= $cleanups[$#cleanups]) { &$u; }
+exit 0;
diff --git a/scripts/db2html.in b/scripts/db2html.in
deleted file mode 100755
index b45d2b9..0000000
--- a/scripts/db2html.in
+++ /dev/null
@@ -1,653 +0,0 @@
-#!/usr/bin/perl
-# $Id: db2html.in,v 1.22 2004/04/19 10:03:53 cjwatson Exp $
-# usage: db2html [-diff] [-stampfile=] [-lastrun=] 
-
-#load the necessary libraries/configuration
-$config_path = '/etc/debbugs';
-$lib_path = '/usr/lib/debbugs';
-
-require("$config_path/config");
-require("$config_path/text");
-require("$lib_path/errorlib");
-$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
-
-use POSIX qw(strftime tzset);
-$ENV{"TZ"} = 'UTC';
-tzset();
-
-#set current working directory
-chdir("$gSpoolDir") || die "chdir spool: $!\n";
-
-#setup variables
-$diff = 0;
-$stampfile = 'stamp.html';
-$tail_html = $gHTMLTail; 
-$expirynote_html = '';
-$expirynote_html = $gHTMLExpireNote if $gRemoveAge;
-$shorthead = ' Ref   * Package    Keywords/Subject                    Submitter';
-$shortindex = ''; 
-$amonths = -1;
-$indexunmatched = '';
-%displayshowpendings = ('pending','outstanding',
-                       'done','resolved',
-                       'forwarded','forwarded to upstream software authors');
-
-#set timestamp for html files
-$dtime = strftime "%a, %e %b %Y %T UTC", localtime;
-$tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
-
-#check for commandline switches
-while (@ARGV && $ARGV[0] =~ m/^-/) 
-{	if ($ARGV[0] eq '-diff') { $diff=1; }
-    elsif ($ARGV[0] =~ m/^-lastrun\=([0-9.]+)$/) { $lastrun= $1; undef $stampfile; }
-    elsif ($ARGV[0] =~ m/^-full$/) { undef $lastrun; undef $stampfile; }
-    elsif ($ARGV[0] =~ m/^-stampfile\=(\S+)$/) { $stampfile= $1; }
-    else { &quit("bad usage"); }
-    shift;
-}
-
-#check for remaing argument, only one...
-@ARGV==1 or die;
-$wwwbase= shift(@ARGV);
-
-#get starting time
-defined($startdate= time) || &quit("failed to get time: $!");
-
-$|=1;
-
-#if stamp file was given, 
-if (defined($stampfile)) 
-{	if (open(X,"< $stampfile")) 
-	{ 	$lastrun= -M X;
-        close(X);
-        printf "progress last run %.7f days\n",$lastrun;
-    } else { print "progress stamp file $stampfile: $! - full\n"; }
-}
-
-#only process file if greater than last run...
-if (defined($lastrun) && -M "db-h" > $lastrun) 
-{	$_= $gHTMLStamp;
-    s/SUBSTITUTE_DTIME/$dtime/o;
-    s/\<\!\-\-updateupdate\-\-\>.*\<\!\-\-\/updateupdate\-\-\>/check/;
-    &file('ix/zstamp.html','non',$_."\n");
-	print "noremoves";
-#    print "db2html: no changes since last run\n";
-    exit 0;
-}
-
-#parse maintainer file
-open(MM,"$gMaintainerFile") || &quit("open $gMaintainerFile: $!");
-while() 
-{	m/^(\S+)\s+(\S.*\S)\s*$/ || &quit("$gMaintainerFile: \`$_'");
-    ($a,$b)=($1,$2);
-    $a =~ y/A-Z/a-z/;
-    $maintainer{$a}= $b;
-}
-close(MM);
-
-#load all database files
-opendir(D,'db-h') || &quit("opendir db-h: $!");
-@dirs = grep(s#^#db-h/#,grep(/^\d+$/,readdir(D)));
-closedir(D);
-foreach my $dir (@dirs) {
-    opendir(D,$dir);
-    push @files, grep(/^-?\d+\.log$/,readdir(D));
-    closedir(D);
-}
-@files = sort { $a <=> $b } @files;
-
-for $pending (qw(pending done forwarded)) 
-{	for $severity (@showseverities) 
-	{ 	eval "\$index${pending}${severity}= \$iiindex${pending}${severity}= ''; 1;"
-            or &quit("reset \$index${pending}${severity}: $@");
-    }
-}
-
-for $f (@files) 
-{ 	next unless $f =~ m/^(-?\d+)\.log$/;
-    $ref= $1;
-	#((print STDERR "$ref\n"),
-	#next
-	#)
-	# unless $ref =~ m/^-/ || $ref =~ m/^124/;
-    &filelock("lock/$ref");
-    $preserveonly= defined($lastrun) && -M "db-h/".get_hashname($ref)."/$ref.log" > $lastrun;
-    if ($ref =~ m/^-\d$/) 
-	{ 	$week= $ref eq '-1' ? 'this week' :
-               $ref eq '-2' ? 'last week' :
-               $ref eq '-3' ? 'two weeks ago' :
-                              ($ref-1)." weeks ago";
-        $linkto= "ju/unmatched$ref";
-        $short= "junk, $week";
-        $descriptivehead=
-            "This includes messages sent to done\@$gEmailDomain\n".
-            "which did not have a $gBug reference number in the Subject line\n".
-            "or which contained an\n".
-            "unknown or out of date $gBug report number (these cause a warning\n".
-            "to be sent to the sender) and details about the messages\n".
-            "sent to request@$gEmailDomain (all of which".
-            "produce replies).\n";
-        $indexlink= "Messages not matched to a specific $gBug report - $week";
-        $data->{subject}= '';
-        $indexentry= '';
-        undef $tpack;
-        undef $tmaint;
-        undef $iiref;
-        $tpackfile= "pnone.html";
-        $indexpart= 'unmatched';
-    } else 
-	{
-	$data=readbug($ref);
-        $_= $data->{package}; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9()]/;
-        $tpack= $_;
-        if ($data->{severity} eq '' || $data->{severity} eq 'normal') 
-		{ 	$showseverity= '';
-            $addseverity= $gDefaultSeverity;
-        } elsif (isstrongseverity($data->{severity})) 
-		{ 	$showseverity= "Severity: $data->{severity};\n";
-            $addseverity= $data->{severity};
-        } else 
-		{ 	$showseverity= "Severity: $data->{severity};\n";
-            $addseverity= $data->{severity};
-        }
-        $days= int(($startdate - $data->{date})/86400); close(S);
-        $indexlink= "#$ref: ".&sani($data->{subject});
-        $indexentry= '';
-        $packfile= length($tpack) ? "pa/l$tpack.html" : "pa/none.html";
-        $indexentry .= "Package: ".
-                        &sani($data->{package}).";\n"
-            if length($data->{package});
-        $indexentry .= $showseverity;
-        $indexentry .= "Reported by: ".&sani($data->{originator});
-        $indexentry .= ";\nOwned by: ".&sani($data->{owner})
-            if length($data->{owner});
-        $indexentry .= ";\nKeywords: ".&sani($data->{keywords})
-            if length($data->{keywords});
-        $linkto= $ref; $linkto =~ s,^..,$&/$&,;
-        @merged= split(/ /,$data->{mergedwith});
-        if (@merged) 
-		{ 	$mseparator= ";\nmerged with ";
-            for $m (@merged) 
-			{ 	$mfile= $m; $mfile =~ s,^..,$&/$&,;
-                $indexentry .= $mseparator."#$m";
-                $mseparator= ",\n";
-            }
-        }
-        $daysold=$submitted='';
-        if (length($data->{done})) 
-		{ 	$indexentry .= ";\nDone: ".&sani($data->{done});
-            $indexpart= "done$addseverity";
-        } elsif (length($data->{forwarded})) 
-		{ 	$indexentry .= ";\nForwarded to ".&sani($data->{forwarded});
-            $indexpart= "forwarded$addseverity";
-        } else 
-		{ 	$cmonths= int($days/30);
-            if ($cmonths != $amonths) 
-			{ 	$msg= $cmonths == 0 ? "Submitted in the last month" :
-		        $cmonths == 1 ? "Over one month old" :
-		        $cmonths == 2 ? "Over two months old - attention is required" :
-		        "OVER $cmonths MONTHS OLD - ATTENTION IS REQUIRED";
-                $shortindex .= "
    • $msg:
    \n$shorthead\n";
-                $amonths= $cmonths;
-            }
-            $pad= 6-length(sprintf("%d",$f));
-            $thissient=
-                ($pad>0 ? ' 'x$pad : '').
-                sprintf("%d",$linkto,$ref).
-                &sani(sprintf(" %-1.1s %-10.10s %-35.35s %-.25s\n",
-						$data->{severity},
-                        $data->{package},
-                        (length($data->{keywords}) ? $data->{keywords}.'/' : '').
-                        $data->{subject}, $data->{originator}));
-            $shortindex.= $thissient;
-            $sient{"$ref $data->{package}"}= $thissient;
-            if ($days >= 7) 
-			{ 	$font= $days <= 30 ? '' :
-                	$days <= 60 ? 'em' :
-                    'strong';
-                $efont= length($font) ? "" : '';
-                $font= length($font) ? "<$font>" : '';
-                $daysold= "; $font$days days old$efont";
-            }
-            if ($preserveonly) {
-                $submitted = 'THIS IS A BUG IN THE BUG PROCESSOR';
-            } else {
-                $submitted = strftime "%a, %e %b %Y %T %Z", localtime($data->{date});
-            }
-            $submitted= "; dated $submitted";
-            $indexpart= "pending$addseverity";
-        }
-        $iiref= $ref;
-        $short= $ref; $short =~ s/^\d+/#$&/;
-        $tmaint= defined($maintainer{$tpack}) ? $maintainer{$tpack} : '(unknown)';
-        $qpackage= &sani($_);
-        $descriptivehead= $indexentry.$submitted.";\nMaintainer for $qpackage is\n".
-            ''.&sani($tmaint).'.';
-        $indexentry .= $daysold;
-        $indexentry .= ".";
-    }
-    $indexadd='';
-    $indexadd .= "" if defined($iiref);
-    $indexadd .= "
  • ".$indexlink."";
-    $indexadd .=  "
    \n".$indexentry if length($indexentry);
-    $indexadd .= "" if defined($iiref);
-    $indexadd .= "\n";
-    $estr= "\$index$indexpart = \$indexadd.\$index$indexpart; 1;";
-    eval($estr) || &quit("eval add to \$index$indexpart ($estr) failed: $@");
-	#print STDERR ">$estr|$indexadd<\n";
-    $indexadd= "\n" if defined($iiref);
-    eval("\$iiindex$indexpart = \$indexadd.\$iiindex$indexpart; 1;") ||
-        &quit("eval add to \$iiindex$indexpart failed: $@");
-    if (defined($tmaint)) 
-	{ 	$countpermaint{$tmaint} += length($data->{done}) ? 0 : length($data->{forwarded}) ? 0 : 1;
-        eval("\$permaint${indexpart}{\$tmaint} .= \$indexadd; 1;") ||
-            &quit("eval add to \$permaint${indexpart}{\$tmaint} failed: $@");
-    }
-    if (defined($tpack)) 
-	{ 	$countperpack{$tpack} += length($data->{done}) ? 0 : length($data->{forwarded}) ? 0 : 1;
-        eval("\$perpack${indexpart}{\$tpack} .= \$indexadd; 1;") ||
-            &quit("eval add to \$perpack${indexpart}{\$tpack} failed: $@");
-    }
-    if ($preserveonly) { &preserve("$linkto.html"); &preserve("$linkto-b.html"); &unfilelock; next; }
-    my $hash = get_hashname($ref);
-    open(L,"db-h/$hash/$ref.log") || &quit("open db-h/$hash/$ref.log: $!");
-    $log='';
-    $boring=''; $xmessage= 0;
-    $normstate= 'kill-init';
-    $suppressnext= 0;
-    while() {
-        if (m/^\07$/) {
-            $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
-                &quit("$ref ^G in state $normstate");
-            $normstate= 'incoming-recv';
-        } elsif (m/^\01$/) {
-            $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
-                &quit("$ref ^A in state $normstate");
-            $normstate= 'autocheck';
-        } elsif (m/^\02$/) {
-            $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
-                &quit("$ref ^B in state $normstate");
-            $normstate= 'recips';
-        } elsif (m/^\03$/) {
-            $normstate eq 'go' || $normstate eq 'go-nox' || $normstate eq 'html' ||
-                &quit("$ref ^C in state $normstate");
-            $this .= "
    • \n" if $normstate eq 'go' || $normstate eq 'go-nox';
-            if ($normstate eq 'html') {
-                $xmessage++;
-                $this .= "  Full text".
-                         " available.";
-            }
-            if ($suppressnext && $normstate ne 'html') {
-                $ntis= $this; $ntis =~ s:\:
    :i;
-                $boring .= "
    \n$ntis\n";
-            } else {
-                $log = $this. "
    \n". $log;
-            }
-            $suppressnext= $normstate eq 'html';
-            $normstate= 'kill-end';
-        } elsif (m/^\05$/) {
-            $normstate eq 'kill-body' || &quit("^E in state $normstate");
-            $this .= "
    \n";
-            $normstate= 'go';
-        } elsif (m/^\06$/) {
-            $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
-                &quit("$ref ^F in state $normstate");
-            $normstate= 'html'; $this= '';
-        } elsif ($normstate eq 'incoming-recv') {
-            $pl= $_; $pl =~ s/\n+$//;
-            m/^Received: \(at (\S+)\) by (\S+)\;/ ||
-                &quit("bad line \`$pl' in state incoming-recv");
-            $this = "
    Message received at ".&sani("$1\@$2").":

    \n".
-                    "
    \n".
-                    "$_";
-            $normstate= 'go';
-        } elsif ($normstate eq 'html') {
-            $this .= $_;
-        } elsif ($normstate eq 'go') {
-            s/^\030//;
-            $this .= &sani($_);
-        } elsif ($normstate eq 'go-nox') {
-            next if !s/^X//;
-            $this .= &sani($_);
-        } elsif ($normstate eq 'recips') {
-            if (m/^-t$/) {
-                $this = "
    Message sent:

    \n";
-            } else {
-                s/\04/, /g; s/\n$//;
-                $this = "
    Message sent to ".&sani($_).":

    \n";
-            }
-            $normstate= 'kill-body';
-        } elsif ($normstate eq 'autocheck') {
-            next if !m/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
-            $normstate= 'autowait';
-            $this = "
    Message received at $2:

    \n";
-        } elsif ($normstate eq 'autowait') {
-            next if !m/^$/;
-            $normstate= 'go-nox';
-            $this .= "
    \n";
-        } else {
-            &quit("$ref state $normstate line \`$_'");
-        }
-    }
-    &quit("$ref state $normstate at end") unless $normstate eq 'kill-end';
-    close(L);
-    if (length($boring)) {
-        &file("$linkto-b.html",'non',
-              "$gProject $gBug report logs - ".
-              "$short, boring messages\n".
-              "\n".
-              "$gHTMLStart
    $gProject $gBugreport logs -".
-              "\n $short,".
-              " boring messages
    \n$boring\n
    \n".
-              $tail_html."\n");
-    }
-    &file("$linkto.html",'non',
-          "$gProject $gBug report logs - ".
-          "$short\n".
-          "\n".
-          "$gHTMLStart
    $gProject $gBug report logs -  $short
    \n".
-          &sani($data->{subject})."
    ".
-          "$descriptivehead\n".
-          "\n
    \n".
-          $log.
-          $tail_html."\n");
-    &unfilelock;
-}
-
-sub maintsort {
-    $_= $_[0];
-    s/([^<>()]+) \(([^()<>]+)\)/$2 \<$1\>/;
-    
-    s/\s+/ /g;
-    s/^\s*//;
-    $email= s/ *\<[^<>()]+\>$//g ? $& : '';
-    $_= "$1 $_" if s/ (\S+)$//;
-    $_.= $email;
-    $_;
-}
-
-sub maintencoded {
-    return $maintencoded{$_[0]} if defined($maintencoded{$_[0]});
-    local ($input)= @_;
-    local ($todo,$encoded)= ($input);
-    while ($todo =~ m/\W/) {
-        $encoded.=$`.sprintf("-%02x_",unpack("C",$&));
-        $todo= $';
-    }
-    $encoded.= $todo;
-    $encoded =~ s/-2e_/\./g;
-    $encoded =~ s/^([^,]+)-20_-3c_(.*)-40_(.*)-3e_/$1,$2,$3,/;
-    $encoded =~ s/^(.*)-40_(.*)-20_-28_([^,]+)-29_$/,$1,$2,$3/;
-    $encoded =~ s/-20_/_/g;
-    $encoded =~ s/-([^_]+)_-/-$1/g;
-    $maintencoded{$input}= $encoded;
-}
-
-for $tmaint (keys %countpermaint) {
-    $_= $tmaint;
-    $after=$before=$sort2d=$sort2s=$sort1d=$sort1s='';
-    $after= "$&$after" if s/\s*\<[^<>()]+\>\s*$//;
-    $after= "$&$after" if s/\s*\)\s*$//;
-    $after= "$&$after" if s/\s*,.*$//;
-    $before.= $& if s/^.*\(\s*//;
-    $sort2d= $& if s/\S+$//;
-    $sort1d= $_;
-    while (s/^([^()<>]+)\. */$1 /) { };
-    s/\s+$//; y/A-Za-z/a-zA-Z/; $sort1s= $_;
-    $sort2s= $sort2d; $sort2s =~ y/A-Za-z/a-zA-Z/;
-    $maintsort{$tmaint}= $sort2s.' '.$sort1s.' '.$before.$sort1d.$sort2d.$after;
-    $maintdisplay{$tmaint}=
-        &sani($before).''.&sani($sort1d.$sort2d).''.&sani($after);
-}
-
-sub heading ($$) {
-    my ($pt,$sv) = @_;
-    return $displayshowseverities{$sv}.' - '.$displayshowpendings{$pt};
-}
-
-sub makeindex ($$$) {
-    my ($varprefix,$varsuffix,$tkey) = @_;
-    my ($pending,$severity,$anydone,$text);
-    $anydone= 0;
-    $text= '';
-    for $pending (qw(pending forwarded done)) {
-        for $severity (@showseverities) {
-            $estr= "\$value= \\${varprefix}${pending}${severity}${varsuffix}; 1;";
-#print STDERR $estr;
-            eval $estr
-                or &quit("eval get \$${varprefix}${pending}${severity} failed: $@");
-#print STDERR ">$$value<\n";
-            next unless length($$value);
-            $text.= "
    \n
    ".&heading($pending,$severity).":
    \n".
-                    "(List of all".
-                    " such $gBugs is available.)\n
      \n".
-                    $$value.
-                    "
    \n";
-            $anydone=1 if $pending eq 'done';
-        }
-    }
-    $text.= $expirynote_html if $anydone;
-    return $text;
-}        
-
-&file("ix/full.html",'def',
-      $gFullIndex.
-      makeindex('$index',"",'').
-      "
    \n".
-      $tail_html."\n");
-
-&file("ju/junk.html",'non',
-      $gJunkIndex.
-      "
    \n
    Junk (messages without a specific $gBug report number):
    \n".
-      "(\`this week' is everything since last Wednesday.)\n
      \n".
-      $indexunmatched.
-      "
    \n".
-      $tail_html."\n");
-
-$nobugs_html= "No reports are currently in this state.";
-$who_html= $gProject;
-$owner_addr= $gMaintainerEmail;
-$otherindex_html= "For other kinds of index or for other information about
-$gProject and the $gBug system, see the $gBug system top-level
-contents WWW page.
-
-";
-
-for $pending (qw(pending forwarded done)) {
-    for $severity (@showseverities) {
-        eval "\$value= \\\$iiindex${pending}${severity}; 1;"
-            or &quit("eval get \$iiindex${pendingtype}${severity} failed: $@");
-        $value= \$nobugs_html if !length($$value);
-        $headstring= &heading($pending,$severity);
-        &file("si/$pending$severity.html",'ref',
-              "$who_html $gBug reports: $headstring\n".
-              "\n".
-              "$gHTMLStart
    $who_html $gBug reports: $headstring
    \n".
-              $otherindex_html.
-              ($pending eq 'done' ? "
    \n$expirynote_html" : '').
-              "
    \n
      \n".
-              $$value.
-              "
    \n
    \n".
-              $tail_html."\n");
-    }
-}
-
-sub individualindexes ($\@&\%&&$$$$$&&) {
-    my ($filename,$keysref,$getfilenameref,$countref,$getdisplayref,
-        $getsimpledisplayref,$what,$caveat,$whatplural,$abbrev,$ihead,
-        $getxinforef,$getxindexref) = @_;
-    my ($itext,$i,$tkey,$sani,$count,$tfilename,$refto,$backnext,$xitext,$bugbugs);
-    $itext='';
-    for ($i=0; $i<=$#$keysref; $i++) {
-        $tkey= $$keysref[$i];
-        $tfilename= &$getfilenameref($tkey);
-        $sani= &$getsimpledisplayref($tkey);
-        $count= $$countref{$tkey};
-        $count= $count >= 1 ? "$count" : "no";
-        $bugbugs= $count == 1 ? "$gBug" : "$gBugs";
-        $xitext= &$getxindexref($tkey);
-        $xitext= length($xitext) ? "$count $bugbugs; $xitext"
-                                 : "$count outstanding $bugbugs";
-        $itext .= "
  • ".&$getdisplayref($tkey).""."\n".
-                  "  ($xitext)\n";
-        $backnext= '';
-        if ($i>0) {
-            $refto= $$keysref[$i-1];
-            $xitext= &$getxindexref($refto);
-            $xitext= " ($xitext)" if length($xitext);
-            $backnext .= "
    \nPrevious $what in list, ".&$getdisplayref($refto)."".
-                         "$xitext\n";
-        }
-        if ($i<$#$keysref) {
-            $refto= $$keysref[$i+1];
-            $xitext= &$getxindexref($refto);
-            $xitext= " ($xitext)" if length($xitext);
-            $backnext .= "
    \nNext $what in list, ".&$getdisplayref($refto)."".
-                         "$xitext\n";
-        }
-        &file($tfilename,'ref',
-              "$gProject $gBug reports: $what $sani\n".
-              "\n".
-              "$gHTMLStart
    $gProject $gBug reports: $what $sani
    \n".
-              &$getxinforef($tkey).
-              $caveat.
-              "See the listing of $whatplural.\n".
-              $backnext.
-              &makeindex("\$per${abbrev}","{\$tkey}",$tkey).
-              "
    \n".
-              $tail_html."\n");
-    }
-    &file($filename,'non',
-          $ihead.
-          "
      \n".
-          $itext.
-          "
    \n".
-          $tail_html."\n");
-}
-
-@maintainers= sort { $maintsort{$a} cmp $maintsort{$b}; } keys %countpermaint;
-individualindexes('ix/maintainers.html',
-                  @maintainers,
-                  sub { 'ma/l'.&maintencoded($_[0]).'.html'; },
-                  %countpermaint,
-                  sub { $maintdisplay{$_[0]}; },
-                  sub { &sani($_[0]); },
-                  'maintainer',
-                  "Note that there may be other reports filed under different
-				  variations on the maintainer\'s name and email address.
    ",
-                  'maintainers',
-                  'maint',
-                  $gMaintIndex,
-                  sub { return ''; },
-                  sub { return ''; });
-
-@packages= sort keys %countperpack;
-individualindexes('ix/packages.html',
-                  @packages,
-                  sub { length($_[0]) ? "pa/l$_[0].html" : 'pa/none.html'; },
-                  %countperpack,
-                  sub { length($_[0]) ? $_[0] : 'not specified'; },
-                  sub { &sani(length($_[0]) ? $_[0] : 'not specified'); },
-                  'package',
-                  "Note that with multi-binary packages there may be other
-				  reports filed under the different binary package names.
    ",
-                  'packages',
-                  'pack',
-                  $gPackageIndex,
-                  sub {
-                      return unless defined($maintainer{$_[0]});
-                      $tmaint= $maintainer{$_[0]};
-                      return "Maintainer for $_[0] is ".&sani($tmaint).".\n
    \n";
-                  },
-                  sub {
-                      return unless defined($maintainer{$_[0]});
-                      $tmaint= $maintainer{$_[0]};
-                      return "".&sani($tmaint)."";
-                  });
-
-&file('ix/summary.html','non',
-      $gSummaryIndex.
-      "
    \n".
-      $shortindex.
-      "
    \n".
-      $tail_html."\n");
-
-$bypackageindex='';
-for $k (map {$_->[0] }
-	sort { $a->[2] cmp $b->[2]  ||  $a->[1] <=> $b->[1] }
-	map { [$_, split(' ',$_,2)] } keys %sient)
-    { $bypackageindex.= $sient{$k}; }
-&file('ix/psummary.html','non',
-      $gPackageLog.
-      "
    \n$shorthead\n".
-      $bypackageindex.
-      "
    \n".
-      $tail_html."\n");
-
-open(P,"$gPseudoDescFile") ||
-    &quit("$gPseudoDescFile: $!");
-$ppd=''; while(
    ) { s/\s*\n$//; $ppd.= &sani($_)."\n"; } close(P);
-&file('ix/pseudopackages.html','non',
-      $gPseudoIndex.
-      "
    \n$ppd".
-      "
    \n".
-      $tail_html."\n");
-
-$_= $gHTMLStamp; s/SUBSTITUTE_DTIME/$dtime/o;
-
-&file('ix/zstamp.html','non',$_."\n");
-
-sub notimestamp ($) {
-    $_= $_[0];
-    s/\<\!\-\-timestamp\-\-\>\n.*\n\<\!\-\-\/timestamp\-\-\>\n//;
-    return $_;
-}
-
-sub file {
-    local ($name,$ii,$file)= @_;
-    if ($diff) {
-        $cmppath= "$wwwbase/$name".($ii eq 'ref' ? '.ref' : '');
-        if (open(ORIG,"$cmppath")) {
-            undef $/; $orig= ; $/= "\n";
-            close(ORIG);
-            if (¬imestamp($orig) eq ¬imestamp($file)) {
-		print "preserve $name\n";
-		return;
-	    }
-            defined($c= open(P,"-|")) or &quit("pipe/fork for diff: $!");
-            if (!$c) {
-                open(Q,"|diff -e $cmppath -") or die "pipe/fork II for diff: $!\n";
-                print Q $file or die "write orig to diff: $!\n";
-                close(Q); $?==0 || $?==256 or die "diff gave $?\n";
-                exit($?>>8);
-            }
-            undef $/; $difftxt= 
    ; $/= "\n";
-            close(P); $?==0 || $?==256 or die "diff fork gave $?\n";
-            if ($?==0) {
-                print "preserve $name\n";
-                return;
-            }
-            $v= (split(/\n/,$difftxt));
-            print "diff $v $ii $name\n${difftxt}thatdiff $name\n"
-                or &quit("stdout (diff): $!");
-            return;
-        }
-    } 
-    $v= (split(/\n/,$file));
-    print "file $v $ii $name\n${file}thatfile $name\n" or &quit("stdout: $!");
-}
-
-sub preserve {
-    print "preserve $_[0]\n";
-}
-
-print "end\n";
-
-while ($u= $cleanups[$#cleanups]) { &$u; }
-exit 0;
diff --git a/scripts/errorlib b/scripts/errorlib
new file mode 100755
index 0000000..a2e9016
--- /dev/null
+++ b/scripts/errorlib
@@ -0,0 +1,41 @@
+# -*- perl -*-
+
+use Mail::Address;
+use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522 getmailbody);
+use Debbugs::Packages qw(:all);
+use Debbugs::Common qw(:all);
+use Debbugs::Status qw(:all);
+use Carp;
+
+sub unlockreadbugmerge {
+    local ($rv) = @_;
+    &unfilelock if $rv >= 2;
+    &unfilelock if $rv >= 1;
+}
+
+%saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
+
+sub sani {
+    my ($in) = @_;
+    carp "You should be using HTML::Entities instead.";
+    $in =~ s/([<>&"])/$saniarray{$1}/g;
+    return $in;
+}
+
+sub get_addresses {
+	return
+	    map { $_->address() }
+	    map { Mail::Address->parse($_) } @_;
+}
+
+@severities= grep { not exists $gObsoleteSeverities{$_} } @gSeverityList;
+@showseverities= @severities;
+grep ($_= $_ eq '' ? $gDefaultSeverity : $_, @showseverities);
+%displayshowseverities= %gSeverityDisplay;
+
+# compatibility
+if (defined $gFowardList and not defined $gForwardList) {
+    $gForwardList = $gFowardList;
+}
+
+1;
diff --git a/scripts/errorlib.in b/scripts/errorlib.in
deleted file mode 100755
index a2e9016..0000000
--- a/scripts/errorlib.in
+++ /dev/null
@@ -1,41 +0,0 @@
-# -*- perl -*-
-
-use Mail::Address;
-use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522 getmailbody);
-use Debbugs::Packages qw(:all);
-use Debbugs::Common qw(:all);
-use Debbugs::Status qw(:all);
-use Carp;
-
-sub unlockreadbugmerge {
-    local ($rv) = @_;
-    &unfilelock if $rv >= 2;
-    &unfilelock if $rv >= 1;
-}
-
-%saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
-
-sub sani {
-    my ($in) = @_;
-    carp "You should be using HTML::Entities instead.";
-    $in =~ s/([<>&"])/$saniarray{$1}/g;
-    return $in;
-}
-
-sub get_addresses {
-	return
-	    map { $_->address() }
-	    map { Mail::Address->parse($_) } @_;
-}
-
-@severities= grep { not exists $gObsoleteSeverities{$_} } @gSeverityList;
-@showseverities= @severities;
-grep ($_= $_ eq '' ? $gDefaultSeverity : $_, @showseverities);
-%displayshowseverities= %gSeverityDisplay;
-
-# compatibility
-if (defined $gFowardList and not defined $gForwardList) {
-    $gForwardList = $gFowardList;
-}
-
-1;
diff --git a/scripts/expire b/scripts/expire
new file mode 100755
index 0000000..d5149e9
--- /dev/null
+++ b/scripts/expire
@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+# This script is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people may have contributed to this file; their copyrights
+# should go here too.]
+# Copyright 2004 by Collin Watson 
+# Copyright 2007 by Don Armstrong 
+
+use Getopt::Long;
+use Pod::Usage;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+expire - Expires archiveable bugs by copying to archive or deleting
+
+=head1 SYNOPSIS
+
+ expire [options]
+
+ Options:
+  --debug, -d debugging level (Default 0)
+  --help, -h display this help
+  --man, -m display manual
+
+=head1 OPTIONS
+
+=over
+
+=item B<--debug, -d>
+
+Debug verbosity. (Default 0)
+
+=item B<--help, -h>
+
+Display brief useage information.
+
+=item B<--man, -m>
+
+Display this manual.
+
+=back
+
+=head1 EXAMPLES
+
+
+=cut
+
+my %options = (debug           => 0,
+	       help            => 0,
+	       man             => 0,
+	       quick           => 0,
+	       index_path      => undef,
+	       );
+
+GetOptions(\%options,'debug|d+','help|h|?','man|m') or pod2usage(2);
+pod2usage(1) if $options{help};
+pod2usage(-verbose=>2) if $options{man};
+
+
+my $verbose = $options{debug};
+
+use Debbugs::Control qw(bug_archive);
+use Debbugs::Status qw(bug_archiveable);
+
+use Debbugs::Config qw(:config);
+use Debbugs::Common qw(:lock);
+
+# No $gRemoveAge means "never expire".
+exit 0 unless $config{remove_age};
+
+chdir($config{spool_dir}) || die "chdir $config{spool_dir} failed: $!\n";
+
+#get list of bugs (ie, status files)
+opendir(DIR,"db-h") or die "Unable to open dir db-h: $!";
+my @dirs = sort { $a cmp $b } grep(s,^,db-h/,, grep(m/^\d+$/,readdir(DIR)));
+close(DIR);
+my @list;
+foreach my $dir (@dirs) {
+    opendir(DIR,$dir);
+    push @list, sort { $a <=> $b } grep(s/\.summary$//,grep(m/^\d+\.summary$/,readdir(DIR)));
+    close(DIR);
+}
+
+my $bug;
+my $errors=0;
+our $exit_now = 0;
+#process each bug (ie, status file)
+my @bugs_to_archive = ();
+for my $bug (@list) {
+     # Weeeee.
+     print "Examining $bug\n" if $verbose;
+     next unless bug_archiveable(bug=>$bug);
+     push @bugs_to_archive,$bug;
+}
+
+$SIG{INT} = sub {$exit_now=1;};
+# At this point we want to block control
+if (not lockpid($config{spool_dir}.'/lock/expire.pid')) {
+     exit 1;
+}
+# We'll also double check that the bug can be archived
+for my $bug (@bugs_to_archive) {
+     last if $exit_now;
+     print "Reexamining $bug\n" if $verbose;
+     next unless bug_archiveable(bug=>$bug);
+     last if $exit_now;
+     print "Bug $bug can be archived: " if $verbose;
+     eval {
+	  bug_archive(bug=>$bug,
+		     );
+	  print "archived.\n" if $verbose;
+     };
+     if ($@) {
+	  $errors=1;
+	  print "failed.\n" if $verbose;
+	  print STDERR "Unable to archive bug# $bug which I thought I could archive:\n$@\n";
+     }
+     last if $exit_now;
+}
+unlink($config{spool_dir}.'/lock/expire.pid');
+
+
+exit $errors;
diff --git a/scripts/expire.in b/scripts/expire.in
deleted file mode 100755
index d5149e9..0000000
--- a/scripts/expire.in
+++ /dev/null
@@ -1,129 +0,0 @@
-#!/usr/bin/perl
-# This script is part of debbugs, and is released
-# under the terms of the GPL version 2, or any later
-# version at your option.
-# See the file README and COPYING for more information.
-#
-# [Other people may have contributed to this file; their copyrights
-# should go here too.]
-# Copyright 2004 by Collin Watson 
-# Copyright 2007 by Don Armstrong 
-
-use Getopt::Long;
-use Pod::Usage;
-
-use warnings;
-use strict;
-
-=head1 NAME
-
-expire - Expires archiveable bugs by copying to archive or deleting
-
-=head1 SYNOPSIS
-
- expire [options]
-
- Options:
-  --debug, -d debugging level (Default 0)
-  --help, -h display this help
-  --man, -m display manual
-
-=head1 OPTIONS
-
-=over
-
-=item B<--debug, -d>
-
-Debug verbosity. (Default 0)
-
-=item B<--help, -h>
-
-Display brief useage information.
-
-=item B<--man, -m>
-
-Display this manual.
-
-=back
-
-=head1 EXAMPLES
-
-
-=cut
-
-my %options = (debug           => 0,
-	       help            => 0,
-	       man             => 0,
-	       quick           => 0,
-	       index_path      => undef,
-	       );
-
-GetOptions(\%options,'debug|d+','help|h|?','man|m') or pod2usage(2);
-pod2usage(1) if $options{help};
-pod2usage(-verbose=>2) if $options{man};
-
-
-my $verbose = $options{debug};
-
-use Debbugs::Control qw(bug_archive);
-use Debbugs::Status qw(bug_archiveable);
-
-use Debbugs::Config qw(:config);
-use Debbugs::Common qw(:lock);
-
-# No $gRemoveAge means "never expire".
-exit 0 unless $config{remove_age};
-
-chdir($config{spool_dir}) || die "chdir $config{spool_dir} failed: $!\n";
-
-#get list of bugs (ie, status files)
-opendir(DIR,"db-h") or die "Unable to open dir db-h: $!";
-my @dirs = sort { $a cmp $b } grep(s,^,db-h/,, grep(m/^\d+$/,readdir(DIR)));
-close(DIR);
-my @list;
-foreach my $dir (@dirs) {
-    opendir(DIR,$dir);
-    push @list, sort { $a <=> $b } grep(s/\.summary$//,grep(m/^\d+\.summary$/,readdir(DIR)));
-    close(DIR);
-}
-
-my $bug;
-my $errors=0;
-our $exit_now = 0;
-#process each bug (ie, status file)
-my @bugs_to_archive = ();
-for my $bug (@list) {
-     # Weeeee.
-     print "Examining $bug\n" if $verbose;
-     next unless bug_archiveable(bug=>$bug);
-     push @bugs_to_archive,$bug;
-}
-
-$SIG{INT} = sub {$exit_now=1;};
-# At this point we want to block control
-if (not lockpid($config{spool_dir}.'/lock/expire.pid')) {
-     exit 1;
-}
-# We'll also double check that the bug can be archived
-for my $bug (@bugs_to_archive) {
-     last if $exit_now;
-     print "Reexamining $bug\n" if $verbose;
-     next unless bug_archiveable(bug=>$bug);
-     last if $exit_now;
-     print "Bug $bug can be archived: " if $verbose;
-     eval {
-	  bug_archive(bug=>$bug,
-		     );
-	  print "archived.\n" if $verbose;
-     };
-     if ($@) {
-	  $errors=1;
-	  print "failed.\n" if $verbose;
-	  print STDERR "Unable to archive bug# $bug which I thought I could archive:\n$@\n";
-     }
-     last if $exit_now;
-}
-unlink($config{spool_dir}.'/lock/expire.pid');
-
-
-exit $errors;
diff --git a/scripts/gen-indices b/scripts/gen-indices
new file mode 100755
index 0000000..ca11546
--- /dev/null
+++ b/scripts/gen-indices
@@ -0,0 +1,243 @@
+#!/usr/bin/perl
+# gen-indices generates bug index files, and is released
+# under the terms of the GPL version 2, or any later version, at your
+# option. See the file README and COPYING for more information.
+
+# Copyright (c) 2005/08/03 Anthony Towns
+# Copyright 2007, 2008 by Don Armstrong .
+
+use warnings;
+use strict;
+
+use DB_File;
+use MLDBM qw(DB_FILE Storable);
+use Fcntl qw/O_RDWR O_CREAT O_TRUNC/;
+use File::Copy;
+
+use Getopt::Long;
+use Pod::Usage;
+
+use File::stat;
+use List::Util qw(min);
+
+=head1 NAME
+
+gen-indices - Generates index files for the cgi scripts
+
+=head1 SYNOPSIS
+
+ gen-indices [options]
+
+ Options:
+  --index-path path to index location
+  --quick update changed bugs
+  --debug, -d debugging level (Default 0)
+  --help, -h display this help
+  --man, -m display manual
+
+=head1 OPTIONS
+
+=over
+
+=itme B<--quick>
+
+Only update changed bugs
+
+=item B<--debug, -d>
+
+Debug verbosity. (Default 0)
+
+=item B<--help, -h>
+
+Display brief useage information.
+
+=item B<--man, -m>
+
+Display this manual.
+
+=back
+
+=head1 EXAMPLES
+
+
+=cut
+
+# Use portable Storable images
+$MLDBM::DumpMeth=q(portable);
+
+
+my %options = (debug           => 0,
+	       help            => 0,
+	       man             => 0,
+	       quick           => 0,
+	       index_path      => undef,
+	       );
+
+GetOptions(\%options,'quick!','index_path|index-path=s','debug|d+','help|h|?','man|m') or pod2usage(2);
+pod2usage(1) if $options{help};
+pod2usage(-verbose=>2) if $options{man};
+
+use Debbugs::Config qw(:config);
+use Debbugs::Common qw(getparsedaddrs getbugcomponent lockpid);
+use Debbugs::Status qw(readbug);
+use Debbugs::Log;
+
+chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
+
+my $verbose = $options{debug};
+my $indexdest = $options{index_path} || $config{spool_dir};
+
+my $initialdir = "db-h";
+my $suffix = "";
+
+if (defined $ARGV[0] and $ARGV[0] eq "archive") {
+    $initialdir = "archive";
+    $suffix = "-arc";
+}
+
+if (not lockpid($config{spool_dir}.'/lock/gen-indices')) {
+     if ($options{quick}) {
+	  # If this is a quick run, just exit
+	  print STDERR "Another gen-indices is running; stopping\n" if $verbose;
+	  exit 0;
+     }
+     print STDERR "Another gen-indices is running; stopping\n";
+     exit 1;
+}
+
+# NB: The reverse index is special; it's used to clean up during updates to bugs
+my @indexes = ('package', 'tag', 'severity','owner','submitter-email','status','correspondent','reverse');
+my $indexes;
+my %slow_index = ();
+my %fast_index = ();
+if (not $options{quick}) {
+     # We'll trade memory for speed here if we're not doing a quick rebuild
+     for my $indexes (@indexes) {
+	  $fast_index{$indexes} = {};
+     }
+     $indexes = \%fast_index;
+}
+else {
+     $indexes = \%slow_index;
+}
+my $time = undef;
+my $start_time = time;
+for my $i (@indexes) {
+	$slow_index{$i} = {};
+	if ($options{quick}) {
+	     if (-e "$indexdest/by-$i${suffix}.idx") {
+		  system('cp','-a',"$indexdest/by-$i${suffix}.idx","$indexdest/by-$i${suffix}.idx.new") == 0
+		       or die "Error creating the new index";
+		  my $stat = stat("$indexdest/by-$i${suffix}.idx") or die "Unable to stat $indexdest/by-$i${suffix}.idx";
+		  $time = defined $time ? min($time,$stat->mtime) : $stat->mtime;
+	     }
+	     tie %{$slow_index{$i}}, MLDBM => "$indexdest/by-$i$suffix.idx.new",
+		  O_RDWR|O_CREAT, 0666
+		       or die "$0: can't create by-$i$suffix-idx.new: $!";
+	}
+	else {
+	     tie %{$slow_index{$i}}, MLDBM => "$indexdest/by-$i$suffix.idx.new",
+		  O_RDWR|O_CREAT|O_TRUNC, 0666
+		       or die "$0: can't create by-$i$suffix-idx.new: $!";
+
+	}
+	$time = 0 if not defined $time;
+}
+
+sub addbugtoindex {
+     my ($index, $bug, @values) = @_;
+
+     if (exists $indexes->{reverse}{"$index $bug"}) {
+	  # We do this insanity to work around a "feature" in MLDBM
+	  for my $key (@{$indexes->{reverse}{"$index $bug"}}) {
+	       my $temp = $indexes->{$index}{$key};
+	       delete $temp->{$bug};
+	       $indexes->{$index}{$key} = $temp;
+	       $indexes->{$index}{"count $key"}--;
+	  }
+	  delete $indexes->{reverse}{"$index $bug"};
+     }
+     for my $key (@values) {
+	  $indexes->{$index}->{"count $key"}++;
+	  # We do this insanity to work around a "feature" in MLDBM
+	  my $temp = $indexes->{$index}->{$key};
+	  $temp->{$bug} = 1;
+	  $indexes->{$index}->{$key} = $temp;
+     }
+     $indexes->{reverse}{"$index $bug"} = [@values];
+}
+
+sub emailfromrfc822 {
+	my $email = shift;
+	$email =~ s/\s*\(.*\)\s*//;
+	$email = $1 if ($email =~ m/<(.*)>/);
+	return $email;
+}
+
+my $cnt = 0;
+
+my @dirs = ($initialdir);
+while (my $dir = shift @dirs) {
+	printf "Doing dir %s ...\n", $dir if $verbose;
+
+	opendir(DIR, "$dir/.") or die "opendir $dir: $!";
+	my @subdirs = readdir(DIR);
+	closedir(DIR);
+
+	my @list = map { m/^(\d+)\.summary$/?($1):() } @subdirs;
+	push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
+
+	for my $bug (@list) {
+		print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
+		my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
+		if (not defined $stat) {
+		     print STDERR "Unable to stat $bug $!\n";
+		     next;
+		}
+		next if $stat->mtime < $time;
+		my $fdata = readbug($bug, $initialdir);
+		addbugtoindex("package", $bug, split /[\s,]+/, $fdata->{"package"});
+		addbugtoindex("tag", $bug, split /[\s,]+/, $fdata->{"keywords"});
+		addbugtoindex('submitter-email', $bug,
+			      map {lc($_->address)} getparsedaddrs($fdata->{originator}));
+		addbugtoindex("severity", $bug, $fdata->{"severity"});
+		addbugtoindex("owner", $bug,
+			      map {lc($_->address)} getparsedaddrs($fdata->{"owner"}));
+		# handle log entries
+		# do this in eval to avoid exploding on jacked logs
+		eval {
+		     my $log = Debbugs::Log->new(bug_num => $bug);
+		     while (my $record = $log->read_record()) {
+			  next unless $record->{type} eq 'incoming-recv';
+			  # we use a regex here, because a full mime parse will be slow.
+			  my ($from) = $record->{text} =~ /^From:\s+(.+?)^\S/ism;
+			  addbugtoindex('correspondent',$bug,
+					map {lc($_->address)} getparsedaddrs($from)
+				       );
+		     }
+		};
+		if ($@) {
+		     print STDERR "Problem dealing with log of $bug: $@";
+		}
+	   }
+}
+
+if (not $options{quick}) {
+     # put the fast index into the slow index
+     for my $key1 (keys %fast_index) {
+	  for my $key2 (keys %{$fast_index{$key1}}) {
+	       $slow_index{$key1}{$key2} = $fast_index{$key1}{$key2};
+	  }
+	  print "Dealt with index $key1\n" if $verbose;
+     }
+}
+
+
+for my $i (@indexes) {
+	untie %{$slow_index{$i}};
+	move("$indexdest/by-$i$suffix.idx.new", "$indexdest/by-$i$suffix.idx");
+	# We do this, because old versions of touch don't support -d '@epoch'
+	system('touch','-d',"1/1/1970 UTC + ${start_time}secs","$indexdest/by-$i$suffix.idx");
+}
+
+unlink($config{spool_dir}.'/lock/gen-indices')
diff --git a/scripts/gen-indices.in b/scripts/gen-indices.in
deleted file mode 100755
index 11775e4..0000000
--- a/scripts/gen-indices.in
+++ /dev/null
@@ -1,224 +0,0 @@
-#!/usr/bin/perl
-
-# Generates by-*.idx files for the CGI scripts
-# Copyright (c) 2005/08/03 Anthony Towns
-# GPL v2
-
-use DB_File;
-use MLDBM qw(DB_FILE Storable);
-use Fcntl qw/O_RDWR O_CREAT O_TRUNC/;
-use File::Copy;
-
-use Getopt::Long;
-use Pod::Usage;
-
-use warnings;
-use strict;
-
-use File::stat;
-use List::Util qw(min);
-
-=head1 NAME
-
-gen-indices - Generates index files for the cgi scripts
-
-=head1 SYNOPSIS
-
- gen-indices [options]
-
- Options:
-  --index-path path to index location
-  --quick update changed bugs
-  --debug, -d debugging level (Default 0)
-  --help, -h display this help
-  --man, -m display manual
-
-=head1 OPTIONS
-
-=over
-
-=itme B<--quick>
-
-Only update changed bugs
-
-=item B<--debug, -d>
-
-Debug verbosity. (Default 0)
-
-=item B<--help, -h>
-
-Display brief useage information.
-
-=item B<--man, -m>
-
-Display this manual.
-
-=back
-
-=head1 EXAMPLES
-
-
-=cut
-
-# Use portable Storable images
-$MLDBM::DumpMeth=q(portable);
-
-
-my %options = (debug           => 0,
-	       help            => 0,
-	       man             => 0,
-	       quick           => 0,
-	       index_path      => undef,
-	       );
-
-GetOptions(\%options,'quick!','index_path|index-path=s','debug|d+','help|h|?','man|m') or pod2usage(2);
-pod2usage(1) if $options{help};
-pod2usage(-verbose=>2) if $options{man};
-
-use Debbugs::Config qw(:config);
-use Debbugs::Common qw(getparsedaddrs getbugcomponent lockpid);
-use Debbugs::Status qw(readbug);
-
-chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
-
-my $verbose = $options{debug};
-my $indexdest = $options{index_path} || $config{spool_dir};
-
-my $initialdir = "db-h";
-my $suffix = "";
-
-if (defined $ARGV[0] and $ARGV[0] eq "archive") {
-    $initialdir = "archive";
-    $suffix = "-arc";
-}
-
-if (not lockpid($config{spool_dir}.'/lock/gen-indices')) {
-     if ($options{quick}) {
-	  # If this is a quick run, just exit
-	  print STDERR "Another gen-indices is running; stopping\n" if $verbose;
-	  exit 0;
-     }
-     print STDERR "Another gen-indices is running; stopping\n";
-     exit 1;
-}
-
-# NB: The reverse index is special; it's used to clean up during updates to bugs
-my @indexes = ('package', 'tag', 'severity','owner','submitter-email','status','reverse');
-my $indexes;
-my %slow_index = ();
-my %fast_index = ();
-if (not $options{quick}) {
-     # We'll trade memory for speed here if we're not doing a quick rebuild
-     for my $indexes (@indexes) {
-	  $fast_index{$indexes} = {};
-     }
-     $indexes = \%fast_index;
-}
-else {
-     $indexes = \%slow_index;
-}
-my $time = undef;
-my $start_time = time;
-for my $i (@indexes) {
-	$slow_index{$i} = {};
-	if ($options{quick}) {
-	     if (-e "$indexdest/by-$i${suffix}.idx") {
-		  system('cp','-a',"$indexdest/by-$i${suffix}.idx","$indexdest/by-$i${suffix}.idx.new") == 0
-		       or die "Error creating the new index";
-		  my $stat = stat("$indexdest/by-$i${suffix}.idx") or die "Unable to stat $indexdest/by-$i${suffix}.idx";
-		  $time = defined $time ? min($time,$stat->mtime) : $stat->mtime;
-	     }
-	     tie %{$slow_index{$i}}, MLDBM => "$indexdest/by-$i$suffix.idx.new",
-		  O_RDWR|O_CREAT, 0666
-		       or die "$0: can't create by-$i$suffix-idx.new: $!";
-	}
-	else {
-	     tie %{$slow_index{$i}}, MLDBM => "$indexdest/by-$i$suffix.idx.new",
-		  O_RDWR|O_CREAT|O_TRUNC, 0666
-		       or die "$0: can't create by-$i$suffix-idx.new: $!";
-
-	}
-	$time = 0 if not defined $time;
-}
-
-sub addbugtoindex {
-     my ($index, $bug, @values) = @_;
-
-     if (exists $indexes->{reverse}{"$index $bug"}) {
-	  # We do this insanity to work around a "feature" in MLDBM
-	  for my $key (@{$indexes->{reverse}{"$index $bug"}}) {
-	       my $temp = $indexes->{$index}{$key};
-	       delete $temp->{$bug};
-	       $indexes->{$index}{$key} = $temp;
-	       $indexes->{$index}{"count $key"}--;
-	  }
-	  delete $indexes->{reverse}{"$index $bug"};
-     }
-     for my $key (@values) {
-	  $indexes->{$index}->{"count $key"}++;
-	  # We do this insanity to work around a "feature" in MLDBM
-	  my $temp = $indexes->{$index}->{$key};
-	  $temp->{$bug} = 1;
-	  $indexes->{$index}->{$key} = $temp;
-     }
-     $indexes->{reverse}{"$index $bug"} = [@values];
-}
-
-sub emailfromrfc822 {
-	my $email = shift;
-	$email =~ s/\s*\(.*\)\s*//;
-	$email = $1 if ($email =~ m/<(.*)>/);
-	return $email;
-}
-
-my $cnt = 0;
-
-my @dirs = ($initialdir);
-while (my $dir = shift @dirs) {
-	printf "Doing dir %s ...\n", $dir if $verbose;
-
-	opendir(DIR, "$dir/.") or die "opendir $dir: $!";
-	my @subdirs = readdir(DIR);
-	closedir(DIR);
-
-	my @list = map { m/^(\d+)\.summary$/?($1):() } @subdirs;
-	push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
-
-	for my $bug (@list) {
-		print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
-		my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
-		if (not defined $stat) {
-		     print STDERR "Unable to stat $bug $!\n";
-		     next;
-		}
-		next if $stat->mtime < $time;
-		my $fdata = readbug($bug, $initialdir);
-		addbugtoindex("package", $bug, split /[\s,]+/, $fdata->{"package"});
-		addbugtoindex("tag", $bug, split /[\s,]+/, $fdata->{"keywords"});
-		addbugtoindex('submitter-email', $bug,
-			      map {lc($_->address)} getparsedaddrs($fdata->{originator}));
-		addbugtoindex("severity", $bug, $fdata->{"severity"});
-		addbugtoindex("owner", $bug,
-			      map {lc($_->address)} getparsedaddrs($fdata->{"owner"}));
-	}
-}
-
-if (not $options{quick}) {
-     # put the fast index into the slow index
-     for my $key1 (keys %fast_index) {
-	  for my $key2 (keys %{$fast_index{$key1}}) {
-	       $slow_index{$key1}{$key2} = $fast_index{$key1}{$key2};
-	  }
-	  print "Dealt with index $key1\n" if $verbose;
-     }
-}
-
-
-for my $i (@indexes) {
-	untie %{$slow_index{$i}};
-	move("$indexdest/by-$i$suffix.idx.new", "$indexdest/by-$i$suffix.idx");
-	# We do this, because old versions of touch don't support -d '@epoch'
-	system('touch','-d',"1/1/1970 UTC + ${start_time}secs","$indexdest/by-$i$suffix.idx");
-}
-
-unlink($config{spool_dir}.'/lock/gen-indices')
diff --git a/scripts/html-control b/scripts/html-control
new file mode 100755
index 0000000..f3901df
--- /dev/null
+++ b/scripts/html-control
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+# $Id: html-control.in,v 1.12 2004/10/26 14:00:05 cjwatson Exp $
+
+use POSIX qw(strftime tzset ENOENT);
+$ENV{"TZ"} = 'UTC';
+tzset();
+
+$config_path = '/etc/debbugs';
+$lib_path = '/usr/lib/debbugs';
+
+require("$config_path/config");
+require("$lib_path/errorlib");
+$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
+
+chdir("$gSpoolDir") || die "chdir spool: $!\n";
+#push(@INC,"$lib_path");
+
+&filelock("html.fcntl-lock");
+
+unlink("html-data.gz") || $!==&ENOENT or die "remove html-data.gz: $!";
+
+sub nonawful ($) {
+    rename("stamp.html.run","stamp.html") or warn "warning: put back stamp.html: $!";
+    die $_[0];
+}
+
+if (open(US,'updateseqs') && -f 'stamp.html') {
+    chop($lastmain=);
+    chop($lastsub=);
+    close(US);
+
+    $lastsub++;
+    $args= "-diff -stampfile=stamp.html.run";
+    rename("stamp.html","stamp.html.run") or die "rename stamp.html: $!";
+} else {
+    $lastsub=0;
+    $lastmain = strftime "%Y%m%d%H%M%S", localtime;
+    $args= '-full';
+    unlink('stamp.html') || $!==&ENOENT or die "excise stale stamp.html: $!";
+}
+
+open(X,">stamp.html.new") or die "stamp.html.new: $!";
+close(X) or die "close stamp.html.new: $!";
+
+open(US,'>updateseqs.new') || die "create updateseqs.new: $!";
+print(US "$lastmain\n$lastsub\n") || die "write updateseqs.new: $!";
+close(US) || die "close updateseqs.new: $!";
+rename('updateseqs.new','updateseqs') or nonawful("install updateseqs: $!");
+
+sub runshell ($&) {
+    my ($cmd,$errhref) = @_;
+    print "xx $cmd\n";
+    system $cmd;
+    !$? && !length($stderr) or &$errhref("$cmd failed - gave $? / $stderr");
+}
+
+$sequences="$lastmain $lastsub";
+$seqmid= $sequences; $seqmid =~ y/ /-/;
+open(MM,">html-data.mail") or nonawful("open html-data.mail: $!");
+if ( length( $gListDomain ) > 0 && length( $gMirrorList ) > 0 ) {
+print(MM <
+X-$gProject-PR: update $sequences
+
+END
+      ) or nonawful("write html-data.mail header: $!");
+} else {
+print(MM <
+X-$gProject-PR: update $sequences
+
+END
+      ) or nonawful("write html-data.mail header: $!");
+}
+close(MM) or nonawful("close html-data.mail: $!");
+
+runshell("$lib_path/db2html $args 2>&1 >html-data $gWebDir/db",
+         sub { &nonawful; });
+runshell("$lib_path/html-install $gWebDir/db &1",sub { &quit; });
+#runshell("gzip -9 html-data 2>&1",sub { &quit; });
+#runshell("btoa 2>&1 >html-data.mail",sub { &quit; });
+#runshell('2>&1 '.join(' ',('/usr/lib/sendmail','-f'."$gMaintainerEmail")).' -oem -oi -t );
-    chop($lastsub=);
-    close(US);
-
-    $lastsub++;
-    $args= "-diff -stampfile=stamp.html.run";
-    rename("stamp.html","stamp.html.run") or &quit("rename stamp.html: $!");
-} else {
-    $lastsub=0;
-    $lastmain = strftime "%Y%m%d%H%M%S", localtime;
-    $args= '-full';
-    unlink('stamp.html') || $!==&ENOENT or &quit("excise stale stamp.html: $!");
-}
-
-open(X,">stamp.html.new") or &quit("stamp.html.new: $!");
-close(X) or &quit("close stamp.html.new: $!");
-
-open(US,'>updateseqs.new') || &quit("create updateseqs.new: $!");
-print(US "$lastmain\n$lastsub\n") || &quit("write updateseqs.new: $!");
-close(US) || &quit("close updateseqs.new: $!");
-rename('updateseqs.new','updateseqs') or nonawful("install updateseqs: $!");
-
-sub runshell ($&) {
-    my ($cmd,$errhref) = @_;
-    print "xx $cmd\n";
-    system $cmd;
-    !$? && !length($stderr) or &$errhref("$cmd failed - gave $? / $stderr");
-}
-
-$sequences="$lastmain $lastsub";
-$seqmid= $sequences; $seqmid =~ y/ /-/;
-open(MM,">html-data.mail") or nonawful("open html-data.mail: $!");
-if ( length( $gListDomain ) > 0 && length( $gMirrorList ) > 0 ) {
-print(MM <
-X-$gProject-PR: update $sequences
-
-END
-      ) or nonawful("write html-data.mail header: $!");
-} else {
-print(MM <
-X-$gProject-PR: update $sequences
-
-END
-      ) or nonawful("write html-data.mail header: $!");
-}
-close(MM) or nonawful("close html-data.mail: $!");
-
-runshell("$lib_path/db2html $args 2>&1 >html-data $gWebDir/db",
-         sub { &nonawful; });
-runshell("$lib_path/html-install $gWebDir/db &1",sub { &quit; });
-#runshell("gzip -9 html-data 2>&1",sub { &quit; });
-#runshell("btoa 2>&1 >html-data.mail",sub { &quit; });
-#runshell('2>&1 '.join(' ',('/usr/lib/sendmail','-f'."$gMaintainerEmail")).' -oem -oi -t ) {
+    chomp;
+    if (m/^end$/) {
+	print "end, removing\n";
+        for $k (keys %remove) { unlink($k) || $!==&ENOENT or die "$k: $!"; }
+        for $k (keys %rmdir) { rmdir($k) || $!==&ENOTEMPTY || $!==EEXIST or die "$k: $!"; }
+        exit 0;
+    } elsif (s/^progress //) {
+        y/-+:._!#=,0-9a-zA-Z //cd;
+        print " progress $_\n";
+    } elsif (m/^preserve ($filenamere)$/o) {
+        delete $remove{$1};
+        delete $remove{"$1.ref"};
+        print " preserve $1\n";
+    } elsif (m/^(file|diff) (\d+) (ref|def|non) ($filenamere)$/o) {
+        $filediff= $1; $linestodo= $2; $ii= $3; $file= $4;
+        print " $filediff $ii $file\n";
+        delete $remove{$file};
+        delete $remove{"$file.ref"} if $ii eq 'ref';
+        $file =~ m,^(..)/, or die $file;
+        mkdir($1,0777) || $!==EEXIST or die $!;
+        $tranfile= $file;
+        $tranfile.= '.ref' if $ii eq 'ref';
+        open(DT,"> recv.tmp") or die $!;
+        if ($filediff eq 'diff') { print DT "r $tranfile\n" or die $!; }
+        $indata= 0;
+        while ($linestodo--) {
+            $z=;
+            if ($filediff eq 'diff') {
+                if ($indata) { $indata=0 if $incmd && m/^\.$/; }
+                elsif ($z =~ m/^[0-9,]+[ac]/) { $indata= 1; }
+                elsif ($z !~ m/^[0-9,]+[ds]/) { die "SECURITY $file >$z<"; }
+            }
+            print DT $z or die $!;
+        }
+        if ($filediff eq 'diff') { print DT "w new.tmp\nq\n" or die $!; }
+        close(DT) or die $!;
+        ($z=) eq "that$filediff $file\n" or die die "not confirmed >$z<";
+        if ($filediff eq 'diff') {
+            $q= `ed -s &1`;
+            length($q) || $? and die "ed $q $?";
+            rename("new.tmp","$tranfile") or die "$tranfile $!";
+            unlink("recv.tmp") or die $!;
+        } else {
+            rename("recv.tmp","$tranfile") or die "$tranfile $!";
+        }
+        if ($ii eq 'ref') {
+            open(I,"$tranfile") or die $!;
+            open(O,"> ref.tmp") or die $!;
+            while () {
+                if (m/^\<\!\-\-ii (\d+)\-\-\>$/) {
+                    defined($iival{$1}) or die "$tranfile $1";
+                    print O $iival{$1} or die $!;
+                } else {
+                    print O or die $!;
+                }
+            }
+            close(I) or die $!;
+            close(O) or die $!;
+            rename("ref.tmp","$file") or die $!;
+        } elsif ($ii eq 'def') {
+            open(I,"$file") or die $!;
+            undef $cdef; $ctext= '';
+            while () {
+                if (s/^\<\!\-\-iid (\d+)\-\-\>//) {
+                    defined($cdef) and die $file;
+                    $cdef= $1;
+                    $ctext= $_;
+                } elsif (s/\<\!\-\-\/iid\-\-\>\n$//) {
+                    defined($cdef) or die $file;
+                    $iival{$cdef}= $ctext.$_."\n";
+                    $ctext=''; undef $cdef;
+                } else {
+                    $ctext.= $_ if defined($cdef);
+                }
+            }
+        }
+    } elsif (m/^noremoves$/) {
+	print "noremoves\n";
+        exit 0;
+    } else {
+        die " huh ? $_";
+    }
+}
+
+die "eof $!";
diff --git a/scripts/html-install.in b/scripts/html-install.in
deleted file mode 100755
index bb6b04d..0000000
--- a/scripts/html-install.in
+++ /dev/null
@@ -1,120 +0,0 @@
-#!/usr/bin/perl
-# $Id: html-install.in,v 1.4 2002/11/17 22:45:16 cjwatson Exp $
-# Takes 1 argument - directory tree to install into
-# Tree _must_ be synch'd with one used by db2html to generate file
-
-use POSIX;
-$config_path = '/etc/debbugs';
-
-require("$config_path/config");
-$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
-
-$dirtree= shift(@ARGV);
-defined($dirtree) or die 'usage';
-chdir $dirtree or die $!;
-
-$filenamere= '[0-9a-z]{2}/[0-9a-z][-+_:,.0-9a-zA-Z]*';
-
-opendir(D,".") or die " opendir: $!";
-while ($dir=readdir(D)) {
-    next if $dir =~ m/^\.\.?$/;
-    if (-f $dir) {
-        $remove{$dir}= 1;
-    } else {
-        opendir(E,"$dir") or die " opendir $dir: $!";
-        while ($_=readdir(E)) {
-            next if $_ =~ m/^\.\.?$/;
-            $remove{"$dir/$_"}= 1;
-        }
-        closedir(E) or die " closedir $dir: $!";
-        $rmdir{$dir}= 1;
-    }
-}
-closedir(D) or die " closedir: $!";
-
-while(<>) {
-    chomp;
-    if (m/^end$/) {
-	print "end, removing\n";
-        for $k (keys %remove) { unlink($k) || $!==&ENOENT or die "$k: $!"; }
-        for $k (keys %rmdir) { rmdir($k) || $!==&ENOTEMPTY || $!==EEXIST or die "$k: $!"; }
-        exit 0;
-    } elsif (s/^progress //) {
-        y/-+:._!#=,0-9a-zA-Z //cd;
-        print " progress $_\n";
-    } elsif (m/^preserve ($filenamere)$/o) {
-        delete $remove{$1};
-        delete $remove{"$1.ref"};
-        print " preserve $1\n";
-    } elsif (m/^(file|diff) (\d+) (ref|def|non) ($filenamere)$/o) {
-        $filediff= $1; $linestodo= $2; $ii= $3; $file= $4;
-        print " $filediff $ii $file\n";
-        delete $remove{$file};
-        delete $remove{"$file.ref"} if $ii eq 'ref';
-        $file =~ m,^(..)/, or die $file;
-        mkdir($1,0777) || $!==EEXIST or die $!;
-        $tranfile= $file;
-        $tranfile.= '.ref' if $ii eq 'ref';
-        open(DT,"> recv.tmp") or die $!;
-        if ($filediff eq 'diff') { print DT "r $tranfile\n" or die $!; }
-        $indata= 0;
-        while ($linestodo--) {
-            $z=;
-            if ($filediff eq 'diff') {
-                if ($indata) { $indata=0 if $incmd && m/^\.$/; }
-                elsif ($z =~ m/^[0-9,]+[ac]/) { $indata= 1; }
-                elsif ($z !~ m/^[0-9,]+[ds]/) { die "SECURITY $file >$z<"; }
-            }
-            print DT $z or die $!;
-        }
-        if ($filediff eq 'diff') { print DT "w new.tmp\nq\n" or die $!; }
-        close(DT) or die $!;
-        ($z=) eq "that$filediff $file\n" or die die "not confirmed >$z<";
-        if ($filediff eq 'diff') {
-            $q= `ed -s &1`;
-            length($q) || $? and die "ed $q $?";
-            rename("new.tmp","$tranfile") or die "$tranfile $!";
-            unlink("recv.tmp") or die $!;
-        } else {
-            rename("recv.tmp","$tranfile") or die "$tranfile $!";
-        }
-        if ($ii eq 'ref') {
-            open(I,"$tranfile") or die $!;
-            open(O,"> ref.tmp") or die $!;
-            while () {
-                if (m/^\<\!\-\-ii (\d+)\-\-\>$/) {
-                    defined($iival{$1}) or die "$tranfile $1";
-                    print O $iival{$1} or die $!;
-                } else {
-                    print O or die $!;
-                }
-            }
-            close(I) or die $!;
-            close(O) or die $!;
-            rename("ref.tmp","$file") or die $!;
-        } elsif ($ii eq 'def') {
-            open(I,"$file") or die $!;
-            undef $cdef; $ctext= '';
-            while () {
-                if (s/^\<\!\-\-iid (\d+)\-\-\>//) {
-                    defined($cdef) and die $file;
-                    $cdef= $1;
-                    $ctext= $_;
-                } elsif (s/\<\!\-\-\/iid\-\-\>\n$//) {
-                    defined($cdef) or die $file;
-                    $iival{$cdef}= $ctext.$_."\n";
-                    $ctext=''; undef $cdef;
-                } else {
-                    $ctext.= $_ if defined($cdef);
-                }
-            }
-        }
-    } elsif (m/^noremoves$/) {
-	print "noremoves\n";
-        exit 0;
-    } else {
-        die " huh ? $_";
-    }
-}
-
-die "eof $!";
diff --git a/scripts/mailsummary b/scripts/mailsummary
new file mode 100755
index 0000000..1ed2e0b
--- /dev/null
+++ b/scripts/mailsummary
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+# $Id: mailsummary.in,v 1.11 2003/04/28 23:51:15 cjwatson Exp $
+
+$config_path = '/etc/debbugs';
+$lib_path = '/usr/lib/debbugs';
+
+require("$config_path/config");
+require("$lib_path/errorlib");
+$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
+
+chdir("$gSpoolDir") || die "chdir spool: $!\n";
+
+#open(DEBUG,">&4");
+
+if ($ARGV[0] eq 'undone') {
+    $vdef= "(no outstanding $gBug reports on file, or problem running script)\n";
+    $subject= "Unanswered problem reports by date";
+    $intro=
+"The following problem reports have not yet been marked as `taken up\' by a
+message to done\@$gEmailDomain or or `forwarded\' by a
+message to forwarded\@$gEmailDomain."
+    ;
+} elsif ($ARGV[0] eq 'bymaint') {
+    $vdef= "(no outstanding $gBug reports on file, or problem running script)\n";
+    $subject= "Unanswered problem reports by maintainer and package";
+    $intro=
+"The following problem reports have not yet been marked as `taken up\' by a
+message to done\@$gEmailDomain or or `forwarded\' by a
+message to forwarded\@$gEmailDomain.
+The maintainer listed against each package is derived from the Maintainer
+field of the package found in the development tree; there is an override file
+that can be amended to get the right results if you have taken over a package
+and do not expect to issue a new version soon.
+
+Variant versions of the Maintainer field for the same actual package
+maintainer will be listed separately.
+
+Maintainers with few outstanding $gBugs appear first, to avoid those with few
+$gBugs being lost deep in the message.
+"
+    ;
+} elsif ($ARGV[0] eq 'veryold') {
+    $vdef= '';
+    $subject= "Overdue problem reports by age";
+    $intro=
+"The following problem reports are very old but have not yet been marked
+as `taken up\' by a message to done\@$gEmailDomain as forwarded
+to a developer by CCing a message to forwarded\@$gEmailDomain.
+Please help ensure that these $gBugs are dealt with quickly, even if you
+are not the package maintainer in question.  (NB a full list of outstanding
+$gBug reports is posted periodically - this is a partial list only!)
+"
+} else {
+    die "urgk, wrong argument @ARGV";
+}
+
+$v=`$lib_path/summary $ARGV[0]`; $? && die "undone failed $?: $!\n";
+
+$v= $vdef if $v eq '';
+exit 0 if $v eq '';
+
+open(D, '| '.join(' ',('/usr/lib/sendmail','-f'.$gMaintainerEmail)).' -odq -oem -oi -t') ||
+    die "start sendmail: $!";
+
+print D <$gWebDomain/txt
+END
+
+close(D);
+$? && die "sendmail failed $?: $!\n";
+
+print length($v)," bytes of summary posted.\n";
diff --git a/scripts/mailsummary.in b/scripts/mailsummary.in
deleted file mode 100755
index 1ed2e0b..0000000
--- a/scripts/mailsummary.in
+++ /dev/null
@@ -1,83 +0,0 @@
-#!/usr/bin/perl
-# $Id: mailsummary.in,v 1.11 2003/04/28 23:51:15 cjwatson Exp $
-
-$config_path = '/etc/debbugs';
-$lib_path = '/usr/lib/debbugs';
-
-require("$config_path/config");
-require("$lib_path/errorlib");
-$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
-
-chdir("$gSpoolDir") || die "chdir spool: $!\n";
-
-#open(DEBUG,">&4");
-
-if ($ARGV[0] eq 'undone') {
-    $vdef= "(no outstanding $gBug reports on file, or problem running script)\n";
-    $subject= "Unanswered problem reports by date";
-    $intro=
-"The following problem reports have not yet been marked as `taken up\' by a
-message to done\@$gEmailDomain or or `forwarded\' by a
-message to forwarded\@$gEmailDomain."
-    ;
-} elsif ($ARGV[0] eq 'bymaint') {
-    $vdef= "(no outstanding $gBug reports on file, or problem running script)\n";
-    $subject= "Unanswered problem reports by maintainer and package";
-    $intro=
-"The following problem reports have not yet been marked as `taken up\' by a
-message to done\@$gEmailDomain or or `forwarded\' by a
-message to forwarded\@$gEmailDomain.
-The maintainer listed against each package is derived from the Maintainer
-field of the package found in the development tree; there is an override file
-that can be amended to get the right results if you have taken over a package
-and do not expect to issue a new version soon.
-
-Variant versions of the Maintainer field for the same actual package
-maintainer will be listed separately.
-
-Maintainers with few outstanding $gBugs appear first, to avoid those with few
-$gBugs being lost deep in the message.
-"
-    ;
-} elsif ($ARGV[0] eq 'veryold') {
-    $vdef= '';
-    $subject= "Overdue problem reports by age";
-    $intro=
-"The following problem reports are very old but have not yet been marked
-as `taken up\' by a message to done\@$gEmailDomain as forwarded
-to a developer by CCing a message to forwarded\@$gEmailDomain.
-Please help ensure that these $gBugs are dealt with quickly, even if you
-are not the package maintainer in question.  (NB a full list of outstanding
-$gBug reports is posted periodically - this is a partial list only!)
-"
-} else {
-    die "urgk, wrong argument @ARGV";
-}
-
-$v=`$lib_path/summary $ARGV[0]`; $? && die "undone failed $?: $!\n";
-
-$v= $vdef if $v eq '';
-exit 0 if $v eq '';
-
-open(D, '| '.join(' ',('/usr/lib/sendmail','-f'.$gMaintainerEmail)).' -odq -oem -oi -t') ||
-    die "start sendmail: $!";
-
-print D <$gWebDomain/txt
-END
-
-close(D);
-$? && die "sendmail failed $?: $!\n";
-
-print length($v)," bytes of summary posted.\n";
diff --git a/scripts/process b/scripts/process
new file mode 100755
index 0000000..197ae8d
--- /dev/null
+++ b/scripts/process
@@ -0,0 +1,1171 @@
+#!/usr/bin/perl
+# $Id: process.in,v 1.109 2006/02/09 22:02:04 don Exp $
+#
+# Usage: process nn
+# Temps:  incoming/Pnn
+
+use warnings;
+use strict;
+
+use POSIX qw(strftime);
+
+use IO::File;
+
+use MIME::Parser;
+use Debbugs::MIME qw(decode_rfc1522 create_mime_message getmailbody);
+use Debbugs::Mail qw(send_mail_message encode_headers);
+use Debbugs::Packages qw(getpkgsrc);
+use Debbugs::User qw(read_usertags write_usertags);
+use Debbugs::Common qw(:lock get_hashname);
+use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug);
+
+use Debbugs::CGI qw(html_escape bug_url);
+
+use Debbugs::Log qw(:misc);
+
+use Debbugs::Text qw(:templates);
+
+use Debbugs::Status qw(:versions);
+use Debbugs::Config qw(:globals :config);
+
+chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
+
+#open(DEBUG,"> /tmp/debbugs.debug");
+umask(002);
+open DEBUG, ">/dev/null";
+
+my $intdate = time or die "failed to get time: $!";
+
+$_=shift;
+m/^([BMQFDUL])(\d*)\.\d+$/ or die "bad argument: $_";
+my $codeletter= $1;
+my $tryref= length($2) ? $2 : -1;
+my $nn= $_;
+
+if (!rename("incoming/G$nn","incoming/P$nn")) 
+{
+    $_=$!.'';  m/no such file or directory/i && exit 0;
+    die "renaming to lock: $!";
+}
+
+my $baddress= 'submit' if $codeletter eq 'B';
+$baddress= 'maintonly' if $codeletter eq 'M';
+$baddress= 'quiet' if $codeletter eq 'Q';
+$baddress= 'forwarded' if $codeletter eq 'F';
+$baddress= 'done' if $codeletter eq 'D';
+$baddress= 'submitter' if $codeletter eq 'U';
+bug_list_forward($nn) if $codeletter eq 'L';
+$baddress || die "bad codeletter $codeletter";
+my $baddressroot= $baddress;
+$baddress= "$tryref-$baddress" if $tryref>=0;
+
+open(M,"incoming/P$nn");
+my @log=;
+close(M);
+
+my @msg = @log;
+chomp @msg;
+
+print DEBUG "###\n",join("##\n",@msg),"\n###\n";
+
+my $tdate = strftime "%a, %d %h %Y %T +0000", gmtime;
+my $fwd= <output_under("$gSpoolDir/mime.tmp");
+my $entity = eval { $parser->parse_data(join('',@log)) };
+
+my $i;
+if ($entity and $entity->head->tags) {
+    @headerlines = @{$entity->head->header};
+    chomp @headerlines;
+
+    my $entity_body = getmailbody($entity);
+    @bodylines = map {s/\r?\n$//; $_;}
+	 $entity_body ? $entity_body->as_lines() : ();
+
+    # set $i to beginning of encoded body data, so we can dump it out
+    # verbatim later
+    $i = 0;
+    ++$i while $msg[$i] =~ /./;
+} else {
+    # Legacy pre-MIME code, kept around in case MIME::Parser fails.
+    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 %header;
+
+for my $hdr (@headerlines) {
+    $hdr = decode_rfc1522($hdr);
+    $_ = $hdr;
+    s/\n\s/ /g;
+    &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
+    my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
+           && !m/^From / && !m/^X-Debbugs-/i;
+    $fwd .= $hdr."\n" if $ins;
+    # print DEBUG ">$_<\n";
+    if (s/^(\S+):\s*//) {
+	my $v = lc $1;
+	print DEBUG ">$v=$_<\n";
+	$header{$v} = $_;
+    } else {
+	print DEBUG "!>$_<\n";
+    }
+}
+$header{'message-id'} = '' if not defined $header{'message-id'};
+
+# remove blank lines
+shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
+
+# 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;
+}
+
+#psuedoheaders
+my %pheader;
+# extract pseudo-headers
+for my $phline (@bodylines)
+{
+    last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
+    my ($fn, $fv) = ($1, $2);
+    $fv =~ s/\s*$//;
+    print DEBUG ">$fn|$fv|\n";
+    $fn = lc $fn;
+    # Don't lc owner or forwarded
+    $fv = lc $fv unless $fn =~ /^(?:owner|forwarded|usertags|version|source-version)$/;
+    $pheader{$fn} = $fv;
+    print DEBUG ">$fn~$fv<\n";
+}
+
+# Allow pseudo headers to set x-debbugs- stuff [#179340]
+for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
+     $header{$key} = $pheader{$key} if not exists $header{$key};
+}
+
+$fwd .= join("\n",@msg[$i..$#msg]);
+
+print DEBUG "***\n$fwd\n***\n";
+
+if (defined $header{'resent-from'} && !defined $header{'from'}) {
+    $header{'from'} = $header{'resent-from'};
+}
+defined($header{'from'}) || die "no From header";
+
+my $replyto = $header{'reply-to'};
+$replyto = '' unless defined $replyto;
+$replyto =~ s/^ +//;
+$replyto =~ s/ +$//;
+unless (length $replyto) {
+    $replyto = $header{'from'};
+}
+
+my $subject = '(no subject)';
+if (!defined($header{'subject'})) 
+{
+	$brokenness.= fill_template('mail/process_broken_subject');
+
+} else { 
+    $subject= $header{'subject'}; 
+}
+
+my $ref=-1;
+$subject =~ s/^Re:\s*//i; $_= $subject."\n";
+if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
+    $tryref= $1+0; 
+}
+my $data;
+if ($tryref >= 0) 
+{
+     my $bfound;
+    ($bfound, $data)= &lockreadbugmerge($tryref);
+    if ($bfound) { 
+        $ref= $tryref; 
+    } else {
+        &htmllog("Reply","sent", $replyto,"Unknown problem report number $tryref.");
+        &sendmessage(create_mime_message(
+          [From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+	   To            => $replyto,
+	   Subject       => "Unknown problem report $gBug#$tryref ($subject)",
+	   'Message-ID'  => "",
+	   'In-Reply-To' => $header{'message-id'},
+	   References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+	   Precedence    => 'bulk',
+	   "X-$gProject-PR-Message" => 'error',
+	  ],message_body_template('process_unknown_bug_number',
+				  {subject => $subject,
+				   date    => $header{date},
+				   baddress => $baddress,
+				   tryref   => $tryref,
+				   messageid => $header{'message-id'},
+				  },
+				 )),'');
+        &appendlog;
+        &finish;
+    }
+} else { 
+    &filelock('lock/-1'); 
+}
+
+# Attempt to determine which source package this is
+my $source_pr_header = '';
+my $source_package = '';
+if (defined $pheader{source}) {
+     $source_package = $pheader{source};
+}
+elsif (defined $data->{package} or defined $pheader{package}) {
+     my $pkg_src = getpkgsrc();
+     $source_package = $pkg_src->{defined $data->{package}?$data->{package}:$pheader{package}};
+}
+$source_pr_header = "X-$gProject-PR-Source: $source_package\n"
+     if defined $source_package and length $source_package;
+
+# Done and Forwarded Bugs
+if ($codeletter eq 'D' || $codeletter eq 'F') 
+{
+    if ($replyto =~ m/$gBounceFroms/o ||
+        $header{'from'} =~ m/$gBounceFroms/o)
+    {
+	 print STDERR "bounce detected !  Mwaap! Mwaap!";
+	 exit 1;
+    }
+    my $markedby= $header{'from'} eq $replyto ? $replyto :
+               "$header{'from'} (reply to $replyto)";
+    my @generalcc;
+    my $receivedat;
+    my $markaswhat;
+    my $set_forwarded;
+    my $generalcc;
+    my $set_done;
+    if ($codeletter eq 'F') { # Forwarded
+        (&appendlog,&finish) if defined $data->{forwarded} and length($data->{forwarded});
+        $receivedat= "forwarded\@$gEmailDomain";
+        $markaswhat= 'forwarded';
+        $set_forwarded= $header{'to'};
+	# Dissallow forwarded being set to this bug tracking system
+	if (defined $set_forwarded and $set_forwarded =~ /\Q$gEmailDomain\E/) {
+	     undef $set_forwarded;
+	}
+	if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
+	    push @generalcc, "$gForwardList\@$gListDomain";
+	    $generalcc= "$gForwardList\@$gListDomain";
+	} else { 
+	    $generalcc=''; 
+        }
+    } else { # Done
+        if (defined $data->{done} and length($data->{done}) and
+                not defined $pheader{'source-version'} and
+                not defined $pheader{'version'}) {
+            &appendlog;
+            &finish;
+        }
+        $receivedat= "done\@$gEmailDomain";
+        $markaswhat= 'done';
+        $set_done= $header{'from'};
+	if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
+            $generalcc= "$gDoneList\@$gListDomain";
+	    push @generalcc, "$gDoneList\@$gListDomain";
+	} else { 
+	    $generalcc=''; 
+	}
+    }
+    if (defined $gStrongList and isstrongseverity($data->{severity})) {
+        $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
+	push @generalcc,"$gStrongList\@$gListDomain";
+    }
+    if ($ref<0) {
+	&htmllog("Warning","sent",$replyto,"Message ignored.");
+	&sendmessage(create_mime_message(
+          [From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+	   To            => $replyto,
+	   Subject       => "Message with no $gBug number ignored by $receivedat ($subject)",
+	   'Message-ID'  => "",
+	   'In-Reply-To' => $header{'message-id'},
+	   References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+	   Precedence    => 'bulk',
+	   "X-$gProject-PR-Message" => 'error',
+	  ],message_body_template('mail/process_no_bug_number',
+				  {subject => $subject,
+				   date    => $header{date},
+				   markaswhat => $markaswhat,
+				   receivedat => $receivedat,
+				   messageid => $header{'message-id'},
+				  },
+				 )),'');
+	&appendlog;
+	&finish;
+    }
+
+    &checkmaintainers;
+
+    my @noticecc = grep($_ ne $replyto,@maintaddrs);
+    my $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
+    $noticeccval =~ s/\s+\n\s+/ /g; 
+    $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
+
+    my @process= ($ref,split(/ /,$data->{mergedwith}));
+    my $orgref= $ref;
+
+    for $ref (@process) {
+ 	if ($ref != $orgref) {
+	    &unfilelock;
+	    $data = &lockreadbug($ref)
+		|| die "huh ? $ref from $orgref out of ".join(' ',@process);
+	}
+        $data->{done}= $set_done if defined($set_done);
+        $data->{forwarded}= $set_forwarded if defined($set_forwarded);
+        if ($codeletter eq 'D') {
+            $data->{keywords} = join ' ', grep $_ ne 'pending',
+                                     split ' ', $data->{keywords};
+            if (defined $pheader{'source-version'}) {
+		 if ($pheader{'source-version'} !~ m/^$config{package_version_re}$/) {
+		      $brokenness .= fill_template('mail/invalid_version',
+						   {version => $pheader{'source-version'}},
+						  );
+		 }
+		 else {
+		      addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
+		 }
+	    } elsif (defined $pheader{version}) {
+		 if ($pheader{version} !~ m/^$config{package_version_re}$/) {
+		      $brokenness .= fill_template('mail/invalid_version',
+						   {version => $pheader{version}},
+						  );
+		 }
+		 else {
+		      addfixedversions($data, $pheader{package}, $pheader{version}, '');
+		 }
+	    }
+        }
+
+	# Add bug mailing list to $generalbcc as appropriate
+ 	# This array is used to specify bcc in the cases where we're using create_mime_message.
+ 	my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
+	my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
+	$generalbcc =~ s/\s+\n\s+/ /g;
+	$generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
+	if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
+
+	writebug($ref, $data);
+
+	my $hash = get_hashname($ref);
+        open(O,"db-h/$hash/$ref.report") || die "read original report: $!";
+        my $orig_report= join('',); close(O);
+        if ($codeletter eq 'F') {
+	    &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
+            &sendmessage(create_mime_message(
+	     ["X-Loop"      => "$gMaintainerEmail",
+	      From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+              To            => "$replyto",
+              Subject       => "$gBug#$ref: marked as forwarded ($data->{subject})",
+              "Message-ID"  => "",
+              "In-Reply-To" => $header{'message-id'},
+              References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+              Precedence    => 'bulk',
+              "X-$gProject-PR-Message"  => "forwarded $ref",
+              "X-$gProject-PR-Package"  => $data->{package},
+              "X-$gProject-PR-Keywords" => $data->{keywords},
+	      # Only have a X-$gProject-PR-Source when we know the source package
+	      (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
+             ],message_body_template('mail/process_mark_as_forwarded',
+				     {date => $header{date},
+				      messageid => $header{'message-id'},
+				      data      => $data,
+				     },
+				    ),
+	     [join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
+        } else {
+	    &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
+            &sendmessage(create_mime_message(
+	     ["X-Loop"      => "$gMaintainerEmail",
+	      From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+              To            => $replyto,
+              Subject       => "$gBug#$ref: marked as done ($data->{subject})",
+              "Message-ID"  => "",
+              "In-Reply-To" => $header{'message-id'},
+              References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+              Precedence    => 'bulk',
+              "X-$gProject-PR-Message"  => "closed $ref",
+              "X-$gProject-PR-Package"  => $data->{package},
+              "X-$gProject-PR-Keywords" => $data->{keywords},
+	      # Only have a X-$gProject-PR-Source when we know the source package
+	      (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
+             ],message_body_template('mail/process_mark_as_done',
+				     {date => $header{date},
+				      messageid => $header{'message-id'},
+				      subject   => $header{subject},
+				      data      => $data,
+				     },
+				    ),
+	     [$orig_report,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
+            &htmllog("Notification","sent",$data->{originator},
+		"$gBug acknowledged by developer.");
+            &sendmessage(create_mime_message(
+	     ["X-Loop"      => "$gMaintainerEmail",
+	      From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+              To            => "$data->{originator}",
+              Subject       => "$gBug#$ref closed by $markedby ($header{'subject'})",
+              "Message-ID"  => "",
+              "In-Reply-To" => "$data->{msgid}",
+              References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+              "X-$gProject-PR-Message"  => "they-closed $ref",
+              "X-$gProject-PR-Package"  => "$data->{package}",
+              "X-$gProject-PR-Keywords" => "$data->{keywords}",
+	      # Only have a X-$gProject-PR-Source when we know the source package
+	      (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
+              "Reply-To"                => "$ref\@$gEmailDomain",
+              "Content-Type"            => 'text/plain; charset="utf-8"',
+             ],message_body_template('mail/process_your_bug_done',
+				     {data      => $data,
+				      markedby  => $markedby,
+				      messageid => $header{'message-id'},
+				      subject   => $header{subject},
+				     },
+				    ),
+	     [join("\n",@msg),$orig_report]),'',undef,1);
+        }
+	&appendlog;
+    }
+    &finish;
+}
+
+if ($ref<0) { # new bug report
+    if ($codeletter eq 'U') { # -submitter
+        &htmllog("Warning","sent",$replyto,"Message not forwarded.");
+	&sendmessage(create_mime_message(
+          [From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+	   To            => $replyto,
+	   Subject       => "Message with no $gBug number cannot be sent to submitter! ($subject)",
+	   'Message-ID'  => "",
+	   'In-Reply-To' => $header{'message-id'},
+	   References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+	   Precedence    => 'bulk',
+	   "X-$gProject-PR-Message" => 'error',
+	  ],message_body_template('mail/process_no_bug_number',
+				  {subject => $subject,
+				   date    => $header{date},
+				   markaswhat => 'submitter',
+				   receivedat => "$baddress\@$gEmailDomain",
+				   messageid => $header{'message-id'},
+				  },
+				 )),'');
+	&appendlog;
+	&finish;
+    }
+
+    $data->{found_versions} = [];
+    $data->{fixed_versions} = [];
+
+    if (defined $pheader{source}) {
+        $data->{package} = $pheader{source};
+    } elsif (defined $pheader{package}) {
+        $data->{package} = $pheader{package};
+    } elsif (defined $config{default_package}) {
+	$data->{package} = $config{default_package},
+    }
+    else {
+ 	&htmllog("Warning","sent",$replyto,"Message not forwarded.");
+	my $body = message_body_template('mail/process_no_package',
+					);
+        &sendmessage(create_mime_message(
+                       ["X-Loop"      => "$gMaintainerEmail",
+			From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+                        To            => $replyto,
+                        Subject       => "Message with no Package: tag cannot be processed! ($subject)",
+                        "Message-ID"  => "",
+                        "In-Reply-To" => $header{'message-id'},
+                        References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+                        Precedence    => 'bulk',
+                        "X-$gProject-PR-Message" => 'error'
+		       ],
+	   message_body_template('mail/process_no_package',
+				 {date => $header{date},
+				  subject => $subject,
+				  messageid => $header{'message-id'},
+				  baddress => $baddress,
+				 },
+				),[join("\n", @msg)]), '',undef,1);
+	&appendlog;
+	&finish;
+    }
+
+    if (defined $config{default_package}) {
+	 &checkmaintainers;
+	 # if there are no maintainers for this package, assign it to the default package
+	 if (not @maintaddrs) {
+	      $data->{package} = $config{default_package};
+	      $brokenness.= fill_template('mail/process_default_package_selected',
+					  {old_package => $pheader{source} || $pheader{package} || 'No package',
+					   new_package => $data->{package},
+					  }
+					 );
+	      # force the maintainers to be rechecked
+	      $maintainerschecked = 0;
+	      &checkmaintainers;
+	 }
+    }
+
+    $data->{keywords}= '';
+    if (defined($pheader{'keywords'})) {
+        $data->{keywords}= $pheader{'keywords'};
+    } elsif (defined($pheader{'tags'})) {
+        $data->{keywords}= $pheader{'tags'};
+    }
+    if (length($data->{keywords})) {
+        my @kws;
+        my %gkws = map { ($_, 1) } @gTags;
+        foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
+            push @kws, $kw if (defined $gkws{$kw});
+        }
+        $data->{keywords} = join(" ", @kws);
+    }
+    $data->{severity}= '';
+    if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
+ 	$data->{severity}= $pheader{'severity'};
+	$data->{severity}= $pheader{'priority'} unless ($data->{severity});
+	$data->{severity} =~ s/^\s*(.+)\s*$/$1/;
+
+	if (!grep($_ eq $data->{severity}, @gSeverityList, "$gDefaultSeverity")) {
+            $brokenness.= fill_template('mail/invalid_severity',
+					{severity=>$data->{severity}}
+				       );
+            $data->{severity}= '';
+        }
+    }
+    if (defined($pheader{owner})) {
+        $data->{owner}= $pheader{owner};
+    }
+    if (defined($pheader{forwarded})) {
+	$data->{'forwarded-to'} = $pheader{forwarded};
+    }
+    &filelock("nextnumber.lock");
+    open(N,"nextnumber") || die "nextnumber: read: $!";
+    my $nextnumber=; $nextnumber =~ s/\n$// || die "nextnumber bad format";
+    $ref= $nextnumber+0;  $nextnumber += 1;  $newref=1;
+    &overwrite('nextnumber', "$nextnumber\n");
+    &unfilelock;
+    my $hash = get_hashname($ref);
+    &overwrite("db-h/$hash/$ref.log",'');
+    $data->{originator} = $replyto;
+    $data->{date} = $intdate;
+    $data->{subject} = $subject;
+    $data->{msgid} = $header{'message-id'};
+    writebug($ref, $data);
+    # Deal with usertags
+    if (exists $pheader{usertags}) {
+	 my $user = $replyto;
+	 $user = $pheader{user} if exists $pheader{user};
+	 $user =~ s/,.*//;
+	 $user =~ s/^.*<(.*)>.*$/$1/;
+	 $user =~ s/[(].*[)]//;
+	 $user =~ s/^\s*(\S+)\s+.*$/$1/;
+	 if ($user ne '' and Debbugs::User::is_valid_user($user)) {
+	      $pheader{usertags} =~ s/(?:^\s+|\s+$)//g;
+	      my %user_tags;
+	      read_usertags(\%user_tags,$user);
+	      for my $tag (split /[,\s]+/, $pheader{usertags}) {
+		   if ($tag =~ /^[a-zA-Z0-9.+\@-]+/) {
+			my %bugs_with_tag; 
+			@bugs_with_tag{@{$user_tags{$tag}||[]}} = (1) x @{$user_tags{$tag}||[]};
+			$bugs_with_tag{$ref} = 1;
+			$user_tags{$tag} = [keys %bugs_with_tag];
+		   }
+	      }
+	      write_usertags(\%user_tags,$user);
+	 }
+	 else {
+	      $brokenness .= fill_template('mail/invalid_user',
+					   {user => $user}
+					  );
+	 }
+    }
+    &overwrite("db-h/$hash/$ref.report",
+               join("\n",@msg)."\n");
+}
+
+&checkmaintainers;
+
+print DEBUG "maintainers >".join(' ',@maintaddrs)."<\n";
+
+my $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
+my $newsubject= $subject;  $newsubject =~ s/^$gBug#$ref:*\s*//;
+
+my $xcchdr= $header{ 'x-debbugs-cc' } || '';
+if ($xcchdr =~ m/\S/) {
+    push(@resentccs,$xcchdr);
+    $resentccexplain.= fill_template('mail/xdebbugscc',
+				     {xcchdr => $xcchdr},
+				    );
+}
+
+if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
+    push(@resentccs,@maintaddrs);
+    $resentccexplain.= fill_template('mail/maintainercc',
+				     {maintaddrs => \@maintaddrs,
+				     },
+				    );
+}
+
+@bccs = @addsrcaddrs;
+if (defined $gStrongList and isstrongseverity($data->{severity})) {
+    push @bccs, "$gStrongList\@$gListDomain";
+}
+
+# Send mail to the per bug list subscription too
+push @bccs, "bugs=$ref\@$gListDomain";
+
+if (defined $pheader{source}) {
+    # Prefix source versions with the name of the source package. They
+    # appear that way in version trees so that we can deal with binary
+    # packages moving from one source package to another.
+    if (defined $pheader{'source-version'}) {
+	 if ($pheader{'source-version'} !~ m/^$config{package_version_re}$/) {
+	      $brokenness .= fill_template('mail/invalid_version',
+					   {version => $pheader{'source-version'}},
+					  );
+	 }
+	 else {
+	      addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
+	 }
+    } elsif (defined $pheader{version}) {
+	 if ($pheader{version} !~ m/^$config{package_version_re}$/) {
+	      $brokenness .= fill_template('mail/invalid_version',
+					   {version => $pheader{version}},
+					  );
+	 }
+	 else {
+	      addfoundversions($data, $pheader{source}, $pheader{version}, '');
+	 }
+    }
+    writebug($ref, $data);
+} elsif (defined $pheader{package}) {
+    # TODO: could handle Source-Version: by looking up the source package?
+     if (defined $pheader{version}) {
+	  if ($pheader{version} !~ m/^$config{package_version_re}$/) {
+	       $brokenness .= fill_template('mail/invalid_version',
+					    {version => $pheader{version}},
+					   );
+	  }
+	  else {
+	       addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
+	  }
+     }
+     writebug($ref, $data);
+}
+
+my $veryquiet= $codeletter eq 'Q';
+if ($codeletter eq 'M' && !@maintaddrs) {
+    $veryquiet= 1;
+    $brokenness.= fill_template('mail/invalid_maintainer',
+				{},
+			       );
+}
+
+my $resentccval.= join(', ',@resentccs);
+$resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
+my $resentcc = '';
+if (length($resentccval)) { 
+    $resentcc= "Resent-CC: $resentccval\n"; 
+}
+
+if ($codeletter eq 'U') { # sent to -submitter
+    &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
+    &sendmessage(<{originator},@resentccs],[@bccs]);
+Subject: $gBug#$ref: $newsubject
+Reply-To: $replyto, $ref-quiet\@$gEmailDomain
+${orgsender}Resent-To: $data->{originator}
+${resentcc}Resent-Date: $tdate
+Resent-Message-ID: 
+Resent-Sender: $gMaintainerEmail
+X-$gProject-PR-Message: report $ref
+X-$gProject-PR-Package: $data->{package}
+X-$gProject-PR-Keywords: $data->{keywords}
+${source_pr_header}$fwd
+END
+} elsif ($codeletter eq 'B') { # Sent to submit
+    my $report_followup = $newref ? 'report' : 'followup';
+    &htmllog($newref ? "Report" : "Information", "forwarded",
+             join(', ',"$gSubmitList\@$gListDomain",@resentccs),
+             "$gBug#$ref".
+             (length($data->{package})? "; Package ".html_escape($data->{package})."" : '').
+             ".");
+    &sendmessage(<
+Resent-Sender: $gMaintainerEmail
+X-$gProject-PR-Message: $report_followup $ref
+X-$gProject-PR-Package: $data->{package}
+X-$gProject-PR-Keywords: $data->{keywords}
+${source_pr_header}$fwd
+END
+} elsif (@resentccs or @bccs) { # Quiet or Maintainer
+    # D and F done far earlier; B just done - so this must be M or Q
+    # We preserve whichever it was in the Reply-To (possibly adding
+    # the $gBug#).
+    my $report_followup = $newref ? 'report' : 'followup';
+    if (@resentccs) {
+        &htmllog($newref ? "Report" : "Information", "forwarded",
+                 $resentccval,
+                 "$gBug#$ref".
+                 (length($data->{package}) ? "; Package ".html_escape($data->{package})."" : '').
+                 ".");
+    } else {
+        &htmllog($newref ? "Report" : "Information", "stored",
+                 "",
+                 "$gBug#$ref".
+                 (length($data->{package}) ? "; Package ".html_escape($data->{package})."" : '').
+                 ".");
+    }
+    &sendmessage(<
+Resent-Sender: $gMaintainerEmail
+X-$gProject-PR-Message: $report_followup $ref
+X-$gProject-PR-Package: $data->{package}
+X-$gProject-PR-Keywords: $data->{keywords}
+${source_pr_header}$fwd
+END
+}
+
+my $htmlbreak= length($brokenness) ? "
    \n".html_escape($brokenness)."\n
    \n" : '';
+$htmlbreak =~ s/\n\n/\n
    \n\n/g;
+if (length($resentccval)) {
+    $htmlbreak = "  Copy sent to ".html_escape($resentccval).".".
+        $htmlbreak;
+}
+
+# Should we send an ack out?
+if (not exists $header{'x-debbugs-no-ack'} and
+    ($newref or
+     ($codeletter ne 'U' and
+      (not defined $header{precedence} or
+       $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/
+      )
+     )
+    )
+   ){
+
+     # figure out forward explanation
+     my $forwardexplain = '';
+     my $thanks = '';
+     my $extra_vars;
+     # will contain info and -info in moreinfo messages
+     my $info = '';
+     my $infod = '';
+     # temporary headers
+     my %t_h;
+     if ($newref) {
+	  &htmllog("Acknowledgement","sent",$replyto,
+		   ($veryquiet ?
+		    "New $gBug report received and filed, but not forwarded." :
+		    "New $gBug report received and forwarded."). $htmlbreak);
+	  $thanks = fill_template('mail/process_ack_thanks_new');
+     }
+     else {
+	  &htmllog("Acknowledgement","sent",$replyto,
+		   ($veryquiet ? "Extra info received and filed, but not forwarded." :
+		    $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
+		    "Extra info received and forwarded to list."). $htmlbreak);
+	  $thanks = fill_template('mail/process_ack_thanks_additional');
+	  $info = 'info';
+	  $infod = '-info';
+     }
+     if ($veryquiet) {
+	  $forwardexplain = fill_template('mail/forward_veryquiet',
+					 );
+	  # these are the headers that quiet messages override
+	  $t_h{messageid}  = "";
+	  $t_h{pr_message} = "ack${infod}-quiet $ref";
+	  $t_h{reply_to}   = "$ref-quiet\@$gEmailDomain";
+	  $extra_vars->{refreplyto} = "$ref-quiet\@$gEmailDomain";
+	  $t_h{subject}    = length($info)?
+	       "$gBug#$ref: Info received and FILED only ($subject)":
+	       "$gBug#$ref: Acknowledgement of QUIET report ($subject)";
+     }
+     elsif ($codeletter eq 'M') {
+	  $forwardexplain = fill_template('mail/forward_maintonly',
+					 );
+	  # these are the headers that maintonly messages override
+	  $t_h{messageid}  = "";
+	  $t_h{pr_message} = "ack${infod}-maintonly $ref";
+	  $t_h{reply_to}   = "$ref-maintonly\@$gEmailDomain";
+	  $extra_vars->{refreplyto} = "$ref-maintonly\@$gEmailDomain";
+	  $t_h{subject}    = length($info)?
+	       "$gBug#$ref: Info received for maintainer only ($subject)":
+	       "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)";
+     }
+     else {
+	  $forwardexplain = fill_template('mail/forward_normal',
+					 );
+	  $t_h{messageid}  = "";
+	  $t_h{pr_message} = "ack${infod} $ref";
+	  $t_h{reply_to}   = "$ref\@$gEmailDomain";
+	  $extra_vars->{refreplyto} = "$ref\@$gEmailDomain";
+	  $t_h{subject}    = (defined $info and length($info))?
+	       "$gBug#$ref: Info received ($subject)" :
+	       "$gBug#$ref: Acknowledgement ($subject)";
+     }
+     my $body = message_body_template('mail/process_ack',
+				      {forwardexplain  => $forwardexplain,
+				       resentccexplain => $resentccexplain,
+				       thanks          => $thanks,
+				       %{$extra_vars}
+				      }
+				     );
+     &sendmessage(create_mime_message(
+		       ["X-Loop"      => "$gMaintainerEmail",
+			From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+			To            => $replyto,
+			Subject       => $t_h{subject},
+			"Message-ID"  => $t_h{messageid},
+			"In-Reply-To" => $header{'message-id'},
+                        References    => $header{'message-id'},
+                        Precedence    => 'bulk',
+			"X-$gProject-PR-Message"  => $t_h{pr_message} || "ack $ref",
+			"X-$gProject-PR-Package"  => $data->{package},
+			"X-$gProject-PR-Keywords" => $data->{keywords},
+			# Only have a X-$gProject-PR-Source when we know the source package
+			(defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
+			"Reply-To"                => $t_h{reply_to} || "$ref\@$gEmailDomain",
+		       ],$body,[]), '',undef,1);
+}
+
+&appendlog;
+&finish;
+
+sub overwrite {
+    my ($f,$v) = @_;
+    open(NEW,">$f.new") || die "$f.new: create: $!";
+    print(NEW "$v") || die "$f.new: write: $!";
+    close(NEW) || die "$f.new: close: $!";
+    rename("$f.new","$f") || die "rename $f.new to $f: $!";
+}
+
+sub appendlog {
+    my $hash = get_hashname($ref);
+    if (!open(AP,">>db-h/$hash/$ref.log")) {
+        print DEBUG "failed open log<\n";
+        print DEBUG "failed open log err $!<\n";
+        die "opening db-h/$hash/$ref.log (li): $!";
+    }
+    print(AP "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/$hash/$ref.log (li): $!";
+    close(AP) || die "closing db-h/$hash/$ref.log (li): $!";
+}
+
+sub finish {
+    my ($exit) = @_;
+    $exit ||= 0;
+    utime(time,time,"db");
+    # cleanups are run in an end block now.
+    #my ($u);
+    #while ($u= $cleanups[$#cleanups]) { &$u; }
+    unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
+    exit $exit;
+}
+
+die "wot no exit";
+
+sub htmllog {
+    my ($whatobj,$whatverb,$where,$desc) = @_;
+    my $hash = get_hashname($ref);
+    open(AP,">>db-h/$hash/$ref.log") || die "opening db-h/$hash/$ref.log (lh): $!";
+    print(AP
+          "\6\n".
+          "$whatobj $whatverb".
+          ($where eq '' ? "" : " to ".html_escape($where)."").
+          ":
    \n". $desc.
+          "\n\3\n") || die "writing db-h/$hash/$ref.log (lh): $!";
+    close(AP) || die "closing db-h/$hash/$ref.log (lh): $!";
+}    
+
+sub stripbccs {
+    my $msg = shift;
+    my $ret = '';
+    my $bcc = 0;
+    while ($msg =~ s/(.*\n)//) {
+	local $_ = $1;
+	if (/^$/) {
+	    $ret .= $_;
+	    last;
+	}
+	if ($bcc) {
+	    # strip continuation lines too
+	    next if /^\s/;
+	    $bcc = 0;
+	}
+	if (/^Bcc:/i) {
+	    $bcc = 1;
+	} else {
+	    $ret .= $_;
+	}
+    }
+    return $ret . $msg;
+}
+
+=head2 send_message
+
+     send_message($the_message,\@recipients,\@bcc,$do_not_encode)
+
+The first argument is the scalar message, the second argument is the
+arrayref of recipients, the third is the arrayref of Bcc:'ed
+recipients.
+
+The final argument turns off header encoding and the addition of the
+X-Loop header if true, defaults to false.
+
+=cut
+
+
+sub sendmessage {
+    my ($msg,$recips,$bcc,$no_encode) = @_;
+    if (not defined $recips or (!ref($recips) && $recips eq '')
+	or @$recips == 0) {
+	$recips = ['-t'];
+    }
+    # This is suboptimal. The right solution is to send headers
+    # separately from the rest of the message and encode them rather
+    # than doing this.
+    $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
+    # The original message received is written out in appendlog, so
+    # before writing out the other messages we've sent out, we need to
+    # RFC1522 encode the header.
+    $msg = encode_headers($msg) unless $no_encode;
+
+    my $hash = get_hashname($ref);
+    #save email to the log
+    open(AP,">>db-h/$hash/$ref.log") || die "opening db-h/$hash/$ref.log (lo): $!";
+    print(AP "\2\n",join("\4",@$recips),"\n\5\n",
+          escape_log(stripbccs($msg)),"\n\3\n") ||
+        die "writing db-h/$hash/$ref.log (lo): $!";
+    close(AP) || die "closing db-h/$hash/$ref.log (lo): $!";
+
+    if (ref($bcc)) {
+        shift @$recips if $recips->[0] eq '-t';
+        push @$recips, @$bcc;
+    }
+
+    send_mail_message(message        => $msg,
+		      # Because we encode the headers above, we do not want to encode them here
+		      encode_headers => 0,
+		      recipients     => $recips);
+}
+
+=head2 message_body_template
+
+     message_body_template('mail/ack',{ref=>'foo'});
+
+Creates a message body using a template
+
+=cut
+
+sub message_body_template{
+     my ($template,$extra_var) = @_;
+     $extra_var ||={};
+     my $body = fill_template($template,$extra_var);
+     return fill_template('mail/message_body',
+			  {%{$extra_var},
+			   body => $body,
+			  },
+			 );
+}
+
+=head2 fill_template
+
+     fill_template('mail/foo',{foo=>'bar'});
+
+Calls fill_in_template with a default set of variables and any extras
+added in.
+
+=cut
+
+sub fill_template{
+     my ($template,$extra_var) = @_;
+     $extra_var ||={};
+     my $variables = {config => \%config,
+		      defined($ref)?(ref    => $ref):(),
+		      defined($data)?(data  => $data):(),
+		      %{$extra_var},
+		     };
+     my $hole_var = {'&bugurl' =>
+		     sub{"$_[0]: ".
+			      'http://'.$config{cgi_domain}.'/'.
+				   Debbugs::CGI::bug_links(bug=>$_[0],
+							   links_only => 1,
+							  );
+		    }
+		    };
+     return fill_in_template(template => $template,
+			     variables => $variables,
+			     hole_var  => $hole_var,
+			    );
+}
+
+
+sub checkmaintainers {
+    return if $maintainerschecked++;
+    return if !length($data->{package});
+    my %maintainerof;
+    open(MAINT,"$gMaintainerFile") || die die "maintainers open: $!";
+    while () {
+	m/^\n$/ && next;
+	m/^\s*$/ && next;
+        m/^(\S+)\s+(\S.*\S)\s*\n$/ || die "maintainers bogus \`$_'";
+        $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
+	# use the package which is normalized to lower case; we do this because we lc the pseudo headers.
+        $maintainerof{$a}= $2;
+    }
+    close(MAINT);
+    open(MAINT,"$gMaintainerFileOverride") || die die "maintainers.override open: $!";
+    while () {
+	m/^\n$/ && next;
+	m/^\s*$/ && next;
+        m/^(\S+)\s+(\S.*\S)\s*\n$/ || die "maintainers.override bogus \`$_'";
+        $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
+	# use the package which is normalized to lower case; we do this because we lc the pseudo headers.
+        $maintainerof{$a}= $2;
+    }
+    close(MAINT);
+    my %pkgsrc;
+    open(SOURCES,"$gPackageSource") || die "pkgsrc open: $!";
+    while () {
+        next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
+	($a,$b)=($1,$2);
+	$a =~ y/A-Z/a-z/;
+	$pkgsrc{$a} = $b;
+    }
+    close(SOURCES);
+    my $anymaintfound=0; my $anymaintnotfound=0;
+    for my $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})) {
+		push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
+	    } else {
+		push @addsrcaddrs, "$p\@$gSubscriptionDomain";
+	    }
+	}
+        if (defined($maintainerof{$p})) {
+	    print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
+            my $addmaint= $maintainerof{$p};
+            push(@maintaddrs,$addmaint) unless
+                $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
+            $anymaintfound++;
+        } else {
+	    print DEBUG "maintainer none >$p<\n";
+	    push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
+            $anymaintnotfound++;
+            last;
+        }
+    }
+
+    if (defined $data->{owner} and length $data->{owner}) {
+        print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
+        my $addmaint = $data->{owner};
+        push(@maintaddrs, $addmaint) unless
+            $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
+    }
+}
+
+=head2 bug_list_forward
+
+     bug_list_forward($spool_filename) if $codeletter eq 'L';
+
+
+Given the spool file, will forward a bug to the per bug mailing list
+subscription system.
+
+=cut
+
+sub bug_list_forward{
+     my ($bug_fn) = @_;
+     # Read the bug information and package information for passing to
+     # the mailing list
+     my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
+     my ($bfound, $data)= lockreadbugmerge($bug_number);
+     my $bug_fh = IO::File->new("incoming/P$bug_fn",'r') or die "Unable to open incoming/P$bug_fn $!";
+
+     local $/ = undef;
+     my $bug_message = <$bug_fh>;
+     my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
+     my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
+     if (not defined $envelope_from) {
+	  # Try to use the From: header or something to set it 
+          ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
+	  # Kludgy, and should really be using a full scale header
+	  # parser to do this.
+	  $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
+     }
+     my ($header,$body) = split /\n\n/, $bug_message, 2;
+     # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
+     $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
+	  qq(X-$gProject-PR-Package: $data->{package}\n).
+	       qq(X-$gProject-PR-Title: $data->{subject})
+	       if defined $data;
+     print STDERR "Tried to loop me with $envelope_from\n"
+	  and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
+     print DEBUG $envelope_from,qq(\n);
+     # If we don't have a bug address, something has gone horribly wrong.
+     print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
+     $bug_address =~ s/\@.+//;
+     print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
+     print DEBUG $header.qq(\n\n).$body;
+     send_mail_message(message        => $header.qq(\n\n).$body,
+		       recipients     => ["bugs=$bug_address\@$gListDomain"],
+		       envelope_from  => $envelope_from,
+		       encode_headers => 0,
+		      );
+     unlink("incoming/P$bug_fn") || die "unlinking incoming/P$bug_fn: $!";
+     exit 0;
+}
diff --git a/scripts/process.in b/scripts/process.in
deleted file mode 100755
index e17127b..0000000
--- a/scripts/process.in
+++ /dev/null
@@ -1,1169 +0,0 @@
-#!/usr/bin/perl
-# $Id: process.in,v 1.109 2006/02/09 22:02:04 don Exp $
-#
-# Usage: process nn
-# Temps:  incoming/Pnn
-
-use warnings;
-use strict;
-
-use POSIX qw(strftime);
-
-use IO::File;
-
-use MIME::Parser;
-use Debbugs::MIME qw(decode_rfc1522 create_mime_message getmailbody);
-use Debbugs::Mail qw(send_mail_message encode_headers);
-use Debbugs::Packages qw(getpkgsrc);
-use Debbugs::User qw(read_usertags write_usertags);
-use Debbugs::Common qw(:lock get_hashname);
-use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug);
-
-use Debbugs::CGI qw(html_escape bug_url);
-
-use Debbugs::Log qw(:misc);
-
-use Debbugs::Text qw(:templates);
-
-use Debbugs::Status qw(:versions);
-use Debbugs::Config qw(:globals :config);
-
-chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
-
-#open(DEBUG,"> /tmp/debbugs.debug");
-umask(002);
-open DEBUG, ">/dev/null";
-
-my $intdate = time or quit("failed to get time: $!");
-
-$_=shift;
-m/^([BMQFDUL])(\d*)\.\d+$/ or quit("bad argument: $_");
-my $codeletter= $1;
-my $tryref= length($2) ? $2 : -1;
-my $nn= $_;
-
-if (!rename("incoming/G$nn","incoming/P$nn")) 
-{
-    $_=$!.'';  m/no such file or directory/i && exit 0;
-    &quit("renaming to lock: $!");
-}
-
-my $baddress= 'submit' if $codeletter eq 'B';
-$baddress= 'maintonly' if $codeletter eq 'M';
-$baddress= 'quiet' if $codeletter eq 'Q';
-$baddress= 'forwarded' if $codeletter eq 'F';
-$baddress= 'done' if $codeletter eq 'D';
-$baddress= 'submitter' if $codeletter eq 'U';
-bug_list_forward($nn) if $codeletter eq 'L';
-$baddress || &quit("bad codeletter $codeletter");
-my $baddressroot= $baddress;
-$baddress= "$tryref-$baddress" if $tryref>=0;
-
-open(M,"incoming/P$nn");
-my @log=;
-close(M);
-
-my @msg = @log;
-chomp @msg;
-
-print DEBUG "###\n",join("##\n",@msg),"\n###\n";
-
-my $tdate = strftime "%a, %d %h %Y %T +0000", gmtime;
-my $fwd= <output_under("$gSpoolDir/mime.tmp");
-my $entity = eval { $parser->parse_data(join('',@log)) };
-
-my $i;
-if ($entity and $entity->head->tags) {
-    @headerlines = @{$entity->head->header};
-    chomp @headerlines;
-
-    my $entity_body = getmailbody($entity);
-    @bodylines = map {s/\r?\n$//; $_;}
-	 $entity_body ? $entity_body->as_lines() : ();
-
-    # set $i to beginning of encoded body data, so we can dump it out
-    # verbatim later
-    $i = 0;
-    ++$i while $msg[$i] =~ /./;
-} else {
-    # Legacy pre-MIME code, kept around in case MIME::Parser fails.
-    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 %header;
-
-for my $hdr (@headerlines) {
-    $hdr = decode_rfc1522($hdr);
-    $_ = $hdr;
-    s/\n\s/ /g;
-    &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
-    my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
-           && !m/^From / && !m/^X-Debbugs-/i;
-    $fwd .= $hdr."\n" if $ins;
-    # print DEBUG ">$_<\n";
-    if (s/^(\S+):\s*//) {
-	my $v = lc $1;
-	print DEBUG ">$v=$_<\n";
-	$header{$v} = $_;
-    } else {
-	print DEBUG "!>$_<\n";
-    }
-}
-$header{'message-id'} = '' if not defined $header{'message-id'};
-
-# remove blank lines
-shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
-
-# 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;
-}
-
-#psuedoheaders
-my %pheader;
-# extract pseudo-headers
-for my $phline (@bodylines)
-{
-    last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
-    my ($fn, $fv) = ($1, $2);
-    $fv =~ s/\s*$//;
-    print DEBUG ">$fn|$fv|\n";
-    $fn = lc $fn;
-    # Don't lc owner or forwarded
-    $fv = lc $fv unless $fn =~ /^(?:owner|forwarded|usertags|version|source-version)$/;
-    $pheader{$fn} = $fv;
-    print DEBUG ">$fn~$fv<\n";
-}
-
-# Allow pseudo headers to set x-debbugs- stuff [#179340]
-for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
-     $header{$key} = $pheader{$key} if not exists $header{$key};
-}
-
-$fwd .= join("\n",@msg[$i..$#msg]);
-
-print DEBUG "***\n$fwd\n***\n";
-
-if (defined $header{'resent-from'} && !defined $header{'from'}) {
-    $header{'from'} = $header{'resent-from'};
-}
-defined($header{'from'}) || &quit("no From header");
-
-my $replyto = $header{'reply-to'};
-$replyto = '' unless defined $replyto;
-$replyto =~ s/^ +//;
-$replyto =~ s/ +$//;
-unless (length $replyto) {
-    $replyto = $header{'from'};
-}
-
-my $subject = '(no subject)';
-if (!defined($header{'subject'})) 
-{
-	$brokenness.= fill_template('mail/process_broken_subject');
-
-} else { 
-    $subject= $header{'subject'}; 
-}
-
-my $ref=-1;
-$subject =~ s/^Re:\s*//i; $_= $subject."\n";
-if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
-    $tryref= $1+0; 
-}
-my $data;
-if ($tryref >= 0) 
-{
-     my $bfound;
-    ($bfound, $data)= &lockreadbugmerge($tryref);
-    if ($bfound) { 
-        $ref= $tryref; 
-    } else {
-        &htmllog("Reply","sent", $replyto,"Unknown problem report number $tryref.");
-        &sendmessage(create_mime_message(
-          [From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
-	   To            => $replyto,
-	   Subject       => "Unknown problem report $gBug#$tryref ($subject)",
-	   'Message-ID'  => "",
-	   'In-Reply-To' => $header{'message-id'},
-	   References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
-	   Precedence    => 'bulk',
-	   "X-$gProject-PR-Message" => 'error',
-	  ],message_body_template('process_unknown_bug_number',
-				  {subject => $subject,
-				   date    => $header{date},
-				   baddress => $baddress,
-				   tryref   => $tryref,
-				   messageid => $header{'message-id'},
-				  },
-				 )),'');
-        &appendlog;
-        &finish;
-    }
-} else { 
-    &filelock('lock/-1'); 
-}
-
-# Attempt to determine which source package this is
-my $source_pr_header = '';
-my $source_package = '';
-if (defined $pheader{source}) {
-     $source_package = $pheader{source};
-}
-elsif (defined $data->{package} or defined $pheader{package}) {
-     my $pkg_src = getpkgsrc();
-     $source_package = $pkg_src->{defined $data->{package}?$data->{package}:$pheader{package}};
-}
-$source_pr_header = "X-$gProject-PR-Source: $source_package\n"
-     if defined $source_package and length $source_package;
-
-# Done and Forwarded Bugs
-if ($codeletter eq 'D' || $codeletter eq 'F') 
-{
-    if ($replyto =~ m/$gBounceFroms/o ||
-        $header{'from'} =~ m/$gBounceFroms/o)
-    {
-	 print STDERR "bounce detected !  Mwaap! Mwaap!";
-	 exit 1;
-    }
-    my $markedby= $header{'from'} eq $replyto ? $replyto :
-               "$header{'from'} (reply to $replyto)";
-    my @generalcc;
-    my $receivedat;
-    my $markaswhat;
-    my $set_forwarded;
-    my $generalcc;
-    my $set_done;
-    if ($codeletter eq 'F') { # Forwarded
-        (&appendlog,&finish) if defined $data->{forwarded} and length($data->{forwarded});
-        $receivedat= "forwarded\@$gEmailDomain";
-        $markaswhat= 'forwarded';
-        $set_forwarded= $header{'to'};
-	# Dissallow forwarded being set to this bug tracking system
-	if (defined $set_forwarded and $set_forwarded =~ /\Q$gEmailDomain\E/) {
-	     undef $set_forwarded;
-	}
-	if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
-	    push @generalcc, "$gForwardList\@$gListDomain";
-	    $generalcc= "$gForwardList\@$gListDomain";
-	} else { 
-	    $generalcc=''; 
-        }
-    } else { # Done
-        if (defined $data->{done} and length($data->{done}) and
-                not defined $pheader{'source-version'} and
-                not defined $pheader{'version'}) {
-            &appendlog;
-            &finish;
-        }
-        $receivedat= "done\@$gEmailDomain";
-        $markaswhat= 'done';
-        $set_done= $header{'from'};
-	if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
-            $generalcc= "$gDoneList\@$gListDomain";
-	    push @generalcc, "$gDoneList\@$gListDomain";
-	} else { 
-	    $generalcc=''; 
-	}
-    }
-    if (defined $gStrongList and isstrongseverity($data->{severity})) {
-        $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
-	push @generalcc,"$gStrongList\@$gListDomain";
-    }
-    if ($ref<0) {
-	&htmllog("Warning","sent",$replyto,"Message ignored.");
-	&sendmessage(create_mime_message(
-          [From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
-	   To            => $replyto,
-	   Subject       => "Message with no $gBug number ignored by $receivedat ($subject)",
-	   'Message-ID'  => "",
-	   'In-Reply-To' => $header{'message-id'},
-	   References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
-	   Precedence    => 'bulk',
-	   "X-$gProject-PR-Message" => 'error',
-	  ],message_body_template('mail/process_no_bug_number',
-				  {subject => $subject,
-				   date    => $header{date},
-				   markaswhat => $markaswhat,
-				   receivedat => $receivedat,
-				   messageid => $header{'message-id'},
-				  },
-				 )),'');
-	&appendlog;
-	&finish;
-    }
-
-    &checkmaintainers;
-
-    my @noticecc = grep($_ ne $replyto,@maintaddrs);
-    my $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
-    $noticeccval =~ s/\s+\n\s+/ /g; 
-    $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
-
-    my @process= ($ref,split(/ /,$data->{mergedwith}));
-    my $orgref= $ref;
-
-    for $ref (@process) {
- 	if ($ref != $orgref) {
-	    &unfilelock;
-	    $data = &lockreadbug($ref)
-		|| die "huh ? $ref from $orgref out of ".join(' ',@process);
-	}
-        $data->{done}= $set_done if defined($set_done);
-        $data->{forwarded}= $set_forwarded if defined($set_forwarded);
-        if ($codeletter eq 'D') {
-            $data->{keywords} = join ' ', grep $_ ne 'pending',
-                                     split ' ', $data->{keywords};
-            if (defined $pheader{'source-version'}) {
-		 if ($pheader{'source-version'} !~ m/^$config{package_version_re}$/) {
-		      $brokenness .= fill_template('mail/invalid_version',
-						   {version => $pheader{'source-version'}},
-						  );
-		 }
-		 else {
-		      addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
-		 }
-	    } elsif (defined $pheader{version}) {
-		 if ($pheader{version} !~ m/^$config{package_version_re}$/) {
-		      $brokenness .= fill_template('mail/invalid_version',
-						   {version => $pheader{version}},
-						  );
-		 }
-		 else {
-		      addfixedversions($data, $pheader{package}, $pheader{version}, '');
-		 }
-	    }
-        }
-
-	# Add bug mailing list to $generalbcc as appropriate
- 	# This array is used to specify bcc in the cases where we're using create_mime_message.
- 	my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
-	my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
-	$generalbcc =~ s/\s+\n\s+/ /g;
-	$generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
-	if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
-
-	writebug($ref, $data);
-
-	my $hash = get_hashname($ref);
-        open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
-        my $orig_report= join('',); close(O);
-        if ($codeletter eq 'F') {
-	    &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
-            &sendmessage(create_mime_message(
-	     ["X-Loop"      => "$gMaintainerEmail",
-	      From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
-              To            => "$replyto",
-              Subject       => "$gBug#$ref: marked as forwarded ($data->{subject})",
-              "Message-ID"  => "",
-              "In-Reply-To" => $header{'message-id'},
-              References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
-              Precedence    => 'bulk',
-              "X-$gProject-PR-Message"  => "forwarded $ref",
-              "X-$gProject-PR-Package"  => $data->{package},
-              "X-$gProject-PR-Keywords" => $data->{keywords},
-	      # Only have a X-$gProject-PR-Source when we know the source package
-	      (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
-             ],message_body_template('mail/process_mark_as_forwarded',
-				     {date => $header{date},
-				      messageid => $header{'message-id'},
-				      data      => $data,
-				     },
-				    ),
-	     [join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
-        } else {
-	    &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
-            &sendmessage(create_mime_message(
-	     ["X-Loop"      => "$gMaintainerEmail",
-	      From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
-              To            => $replyto,
-              Subject       => "$gBug#$ref: marked as done ($data->{subject})",
-              "Message-ID"  => "",
-              "In-Reply-To" => $header{'message-id'},
-              References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
-              Precedence    => 'bulk',
-              "X-$gProject-PR-Message"  => "closed $ref",
-              "X-$gProject-PR-Package"  => $data->{package},
-              "X-$gProject-PR-Keywords" => $data->{keywords},
-	      # Only have a X-$gProject-PR-Source when we know the source package
-	      (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
-             ],message_body_template('mail/process_mark_as_done',
-				     {date => $header{date},
-				      messageid => $header{'message-id'},
-				      subject   => $header{subject},
-				      data      => $data,
-				     },
-				    ),
-	     [$orig_report,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
-            &htmllog("Notification","sent",$data->{originator},
-		"$gBug acknowledged by developer.");
-            &sendmessage(create_mime_message(
-	     ["X-Loop"      => "$gMaintainerEmail",
-	      From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
-              To            => "$data->{originator}",
-              Subject       => "$gBug#$ref closed by $markedby ($header{'subject'})",
-              "Message-ID"  => "",
-              "In-Reply-To" => "$data->{msgid}",
-              References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
-              "X-$gProject-PR-Message"  => "they-closed $ref",
-              "X-$gProject-PR-Package"  => "$data->{package}",
-              "X-$gProject-PR-Keywords" => "$data->{keywords}",
-	      # Only have a X-$gProject-PR-Source when we know the source package
-	      (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
-              "Reply-To"                => "$ref\@$gEmailDomain",
-              "Content-Type"            => 'text/plain; charset="utf-8"',
-             ],message_body_template('mail/process_your_bug_done',
-				     {data      => $data,
-				      markedby  => $markedby,
-				      messageid => $header{'message-id'},
-				      subject   => $header{subject},
-				     },
-				    ),
-	     [join("\n",@msg),$orig_report]),'',undef,1);
-        }
-	&appendlog;
-    }
-    &finish;
-}
-
-if ($ref<0) { # new bug report
-    if ($codeletter eq 'U') { # -submitter
-        &htmllog("Warning","sent",$replyto,"Message not forwarded.");
-	&sendmessage(create_mime_message(
-          [From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
-	   To            => $replyto,
-	   Subject       => "Message with no $gBug number cannot be sent to submitter! ($subject)",
-	   'Message-ID'  => "",
-	   'In-Reply-To' => $header{'message-id'},
-	   References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
-	   Precedence    => 'bulk',
-	   "X-$gProject-PR-Message" => 'error',
-	  ],message_body_template('mail/process_no_bug_number',
-				  {subject => $subject,
-				   date    => $header{date},
-				   markaswhat => 'submitter',
-				   receivedat => "$baddress\@$gEmailDomain",
-				   messageid => $header{'message-id'},
-				  },
-				 )),'');
-	&appendlog;
-	&finish;
-    }
-
-    $data->{found_versions} = [];
-    $data->{fixed_versions} = [];
-
-    if (defined $pheader{source}) {
-        $data->{package} = $pheader{source};
-    } elsif (defined $pheader{package}) {
-        $data->{package} = $pheader{package};
-    } elsif (defined $config{default_package}) {
-	$data->{package} = $config{default_package},
-    }
-    else {
- 	&htmllog("Warning","sent",$replyto,"Message not forwarded.");
-	my $body = message_body_template('mail/process_no_package',
-					);
-        &sendmessage(create_mime_message(
-                       ["X-Loop"      => "$gMaintainerEmail",
-			From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
-                        To            => $replyto,
-                        Subject       => "Message with no Package: tag cannot be processed! ($subject)",
-                        "Message-ID"  => "",
-                        "In-Reply-To" => $header{'message-id'},
-                        References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
-                        Precedence    => 'bulk',
-                        "X-$gProject-PR-Message" => 'error'
-		       ],
-	   message_body_template('mail/process_no_package',
-				 {date => $header{date},
-				  subject => $subject,
-				  messageid => $header{'message-id'},
-				  baddress => $baddress,
-				 },
-				),[join("\n", @msg)]), '',undef,1);
-	&appendlog;
-	&finish;
-    }
-
-    if (defined $config{default_package}) {
-	 &checkmaintainers;
-	 # if there are no maintainers for this package, assign it to the default package
-	 if (not @maintaddrs) {
-	      $data->{package} = $config{default_package};
-	      $brokenness.= fill_template('mail/process_default_package_selected',
-					  {old_package => $pheader{source} || $pheader{package} || 'No package',
-					   new_package => $data->{package},
-					  }
-					 );
-	      # force the maintainers to be rechecked
-	      $maintainerschecked = 0;
-	      &checkmaintainers;
-	 }
-    }
-
-    $data->{keywords}= '';
-    if (defined($pheader{'keywords'})) {
-        $data->{keywords}= $pheader{'keywords'};
-    } elsif (defined($pheader{'tags'})) {
-        $data->{keywords}= $pheader{'tags'};
-    }
-    if (length($data->{keywords})) {
-        my @kws;
-        my %gkws = map { ($_, 1) } @gTags;
-        foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
-            push @kws, $kw if (defined $gkws{$kw});
-        }
-        $data->{keywords} = join(" ", @kws);
-    }
-    $data->{severity}= '';
-    if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
- 	$data->{severity}= $pheader{'severity'};
-	$data->{severity}= $pheader{'priority'} unless ($data->{severity});
-	$data->{severity} =~ s/^\s*(.+)\s*$/$1/;
-
-	if (!grep($_ eq $data->{severity}, @gSeverityList, "$gDefaultSeverity")) {
-            $brokenness.= fill_template('mail/invalid_severity',
-					{severity=>$data->{severity}}
-				       );
-            $data->{severity}= '';
-        }
-    }
-    if (defined($pheader{owner})) {
-        $data->{owner}= $pheader{owner};
-    }
-    if (defined($pheader{forwarded})) {
-	$data->{'forwarded-to'} = $pheader{forwarded};
-    }
-    &filelock("nextnumber.lock");
-    open(N,"nextnumber") || &quit("nextnumber: read: $!");
-    my $nextnumber=; $nextnumber =~ s/\n$// || &quit("nextnumber bad format");
-    $ref= $nextnumber+0;  $nextnumber += 1;  $newref=1;
-    &overwrite('nextnumber', "$nextnumber\n");
-    &unfilelock;
-    my $hash = get_hashname($ref);
-    &overwrite("db-h/$hash/$ref.log",'');
-    $data->{originator} = $replyto;
-    $data->{date} = $intdate;
-    $data->{subject} = $subject;
-    $data->{msgid} = $header{'message-id'};
-    writebug($ref, $data);
-    # Deal with usertags
-    if (exists $pheader{usertags}) {
-	 my $user = $replyto;
-	 $user = $pheader{user} if exists $pheader{user};
-	 $user =~ s/,.*//;
-	 $user =~ s/^.*<(.*)>.*$/$1/;
-	 $user =~ s/[(].*[)]//;
-	 $user =~ s/^\s*(\S+)\s+.*$/$1/;
-	 if ($user ne '' and Debbugs::User::is_valid_user($user)) {
-	      $pheader{usertags} =~ s/(?:^\s+|\s+$)//g;
-	      my %user_tags;
-	      read_usertags(\%user_tags,$user);
-	      for my $tag (split /[,\s]+/, $pheader{usertags}) {
-		   if ($tag =~ /^[a-zA-Z0-9.+\@-]+/) {
-			my %bugs_with_tag; 
-			@bugs_with_tag{@{$user_tags{$tag}||[]}} = (1) x @{$user_tags{$tag}||[]};
-			$bugs_with_tag{$ref} = 1;
-			$user_tags{$tag} = [keys %bugs_with_tag];
-		   }
-	      }
-	      write_usertags(\%user_tags,$user);
-	 }
-	 else {
-	      $brokenness .= fill_template('mail/invalid_user',
-					   {user => $user}
-					  );
-	 }
-    }
-    &overwrite("db-h/$hash/$ref.report",
-               join("\n",@msg)."\n");
-}
-
-&checkmaintainers;
-
-print DEBUG "maintainers >".join(' ',@maintaddrs)."<\n";
-
-my $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
-my $newsubject= $subject;  $newsubject =~ s/^$gBug#$ref:*\s*//;
-
-my $xcchdr= $header{ 'x-debbugs-cc' } || '';
-if ($xcchdr =~ m/\S/) {
-    push(@resentccs,$xcchdr);
-    $resentccexplain.= fill_template('mail/xdebbugscc',
-				     {xcchdr => $xcchdr},
-				    );
-}
-
-if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
-    push(@resentccs,@maintaddrs);
-    $resentccexplain.= fill_template('mail/maintainercc',
-				     {maintaddrs => \@maintaddrs,
-				     },
-				    );
-}
-
-@bccs = @addsrcaddrs;
-if (defined $gStrongList and isstrongseverity($data->{severity})) {
-    push @bccs, "$gStrongList\@$gListDomain";
-}
-
-# Send mail to the per bug list subscription too
-push @bccs, "bugs=$ref\@$gListDomain";
-
-if (defined $pheader{source}) {
-    # Prefix source versions with the name of the source package. They
-    # appear that way in version trees so that we can deal with binary
-    # packages moving from one source package to another.
-    if (defined $pheader{'source-version'}) {
-	 if ($pheader{'source-version'} !~ m/^$config{package_version_re}$/) {
-	      $brokenness .= fill_template('mail/invalid_version',
-					   {version => $pheader{'source-version'}},
-					  );
-	 }
-	 else {
-	      addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
-	 }
-    } elsif (defined $pheader{version}) {
-	 if ($pheader{version} !~ m/^$config{package_version_re}$/) {
-	      $brokenness .= fill_template('mail/invalid_version',
-					   {version => $pheader{version}},
-					  );
-	 }
-	 else {
-	      addfoundversions($data, $pheader{source}, $pheader{version}, '');
-	 }
-    }
-    writebug($ref, $data);
-} elsif (defined $pheader{package}) {
-    # TODO: could handle Source-Version: by looking up the source package?
-     if (defined $pheader{version}) {
-	  if ($pheader{version} !~ m/^$config{package_version_re}$/) {
-	       $brokenness .= fill_template('mail/invalid_version',
-					    {version => $pheader{version}},
-					   );
-	  }
-	  else {
-	       addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
-	  }
-     }
-     writebug($ref, $data);
-}
-
-my $veryquiet= $codeletter eq 'Q';
-if ($codeletter eq 'M' && !@maintaddrs) {
-    $veryquiet= 1;
-    $brokenness.= fill_template('mail/invalid_maintainer',
-				{},
-			       );
-}
-
-my $resentccval.= join(', ',@resentccs);
-$resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
-my $resentcc = '';
-if (length($resentccval)) { 
-    $resentcc= "Resent-CC: $resentccval\n"; 
-}
-
-if ($codeletter eq 'U') { # sent to -submitter
-    &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
-    &sendmessage(<{originator},@resentccs],[@bccs]);
-Subject: $gBug#$ref: $newsubject
-Reply-To: $replyto, $ref-quiet\@$gEmailDomain
-${orgsender}Resent-To: $data->{originator}
-${resentcc}Resent-Date: $tdate
-Resent-Message-ID: 
-Resent-Sender: $gMaintainerEmail
-X-$gProject-PR-Message: report $ref
-X-$gProject-PR-Package: $data->{package}
-X-$gProject-PR-Keywords: $data->{keywords}
-${source_pr_header}$fwd
-END
-} elsif ($codeletter eq 'B') { # Sent to submit
-    my $report_followup = $newref ? 'report' : 'followup';
-    &htmllog($newref ? "Report" : "Information", "forwarded",
-             join(', ',"$gSubmitList\@$gListDomain",@resentccs),
-             "$gBug#$ref".
-             (length($data->{package})? "; Package ".html_escape($data->{package})."" : '').
-             ".");
-    &sendmessage(<
-Resent-Sender: $gMaintainerEmail
-X-$gProject-PR-Message: $report_followup $ref
-X-$gProject-PR-Package: $data->{package}
-X-$gProject-PR-Keywords: $data->{keywords}
-${source_pr_header}$fwd
-END
-} elsif (@resentccs or @bccs) { # Quiet or Maintainer
-    # D and F done far earlier; B just done - so this must be M or Q
-    # We preserve whichever it was in the Reply-To (possibly adding
-    # the $gBug#).
-    my $report_followup = $newref ? 'report' : 'followup';
-    if (@resentccs) {
-        &htmllog($newref ? "Report" : "Information", "forwarded",
-                 $resentccval,
-                 "$gBug#$ref".
-                 (length($data->{package}) ? "; Package ".html_escape($data->{package})."" : '').
-                 ".");
-    } else {
-        &htmllog($newref ? "Report" : "Information", "stored",
-                 "",
-                 "$gBug#$ref".
-                 (length($data->{package}) ? "; Package ".html_escape($data->{package})."" : '').
-                 ".");
-    }
-    &sendmessage(<
-Resent-Sender: $gMaintainerEmail
-X-$gProject-PR-Message: $report_followup $ref
-X-$gProject-PR-Package: $data->{package}
-X-$gProject-PR-Keywords: $data->{keywords}
-${source_pr_header}$fwd
-END
-}
-
-my $htmlbreak= length($brokenness) ? "
    \n".html_escape($brokenness)."\n
    \n" : '';
-$htmlbreak =~ s/\n\n/\n
    \n\n/g;
-if (length($resentccval)) {
-    $htmlbreak = "  Copy sent to ".html_escape($resentccval).".".
-        $htmlbreak;
-}
-
-# Should we send an ack out?
-if (not exists $header{'x-debbugs-no-ack'} and
-    ($newref or
-     ($codeletter ne 'U' and
-      (not defined $header{precedence} or
-       $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/
-      )
-     )
-    )
-   ){
-
-     # figure out forward explanation
-     my $forwardexplain = '';
-     my $thanks = '';
-     my $extra_vars;
-     # will contain info and -info in moreinfo messages
-     my $info = '';
-     my $infod = '';
-     # temporary headers
-     my %t_h;
-     if ($newref) {
-	  &htmllog("Acknowledgement","sent",$replyto,
-		   ($veryquiet ?
-		    "New $gBug report received and filed, but not forwarded." :
-		    "New $gBug report received and forwarded."). $htmlbreak);
-	  $thanks = fill_template('mail/process_ack_thanks_new');
-     }
-     else {
-	  &htmllog("Acknowledgement","sent",$replyto,
-		   ($veryquiet ? "Extra info received and filed, but not forwarded." :
-		    $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
-		    "Extra info received and forwarded to list."). $htmlbreak);
-	  $thanks = fill_template('mail/process_ack_thanks_additional');
-	  $info = 'info';
-	  $infod = '-info';
-     }
-     if ($veryquiet) {
-	  $forwardexplain = fill_template('mail/forward_veryquiet',
-					 );
-	  # these are the headers that quiet messages override
-	  $t_h{messageid}  = "";
-	  $t_h{pr_message} = "ack${infod}-quiet $ref";
-	  $t_h{reply_to}   = "$ref-quiet\@$gEmailDomain";
-	  $extra_vars->{refreplyto} = "$ref-quiet\@$gEmailDomain";
-	  $t_h{subject}    = length($info)?
-	       "$gBug#$ref: Info received and FILED only ($subject)":
-	       "$gBug#$ref: Acknowledgement of QUIET report ($subject)";
-     }
-     elsif ($codeletter eq 'M') {
-	  $forwardexplain = fill_template('mail/forward_maintonly',
-					 );
-	  # these are the headers that maintonly messages override
-	  $t_h{messageid}  = "";
-	  $t_h{pr_message} = "ack${infod}-maintonly $ref";
-	  $t_h{reply_to}   = "$ref-maintonly\@$gEmailDomain";
-	  $extra_vars->{refreplyto} = "$ref-maintonly\@$gEmailDomain";
-	  $t_h{subject}    = length($info)?
-	       "$gBug#$ref: Info received for maintainer only ($subject)":
-	       "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)";
-     }
-     else {
-	  $forwardexplain = fill_template('mail/forward_normal',
-					 );
-	  $t_h{messageid}  = "";
-	  $t_h{pr_message} = "ack${infod} $ref";
-	  $t_h{reply_to}   = "$ref\@$gEmailDomain";
-	  $extra_vars->{refreplyto} = "$ref\@$gEmailDomain";
-	  $t_h{subject}    = (defined $info and length($info))?
-	       "$gBug#$ref: Info received ($subject)" :
-	       "$gBug#$ref: Acknowledgement ($subject)";
-     }
-     my $body = message_body_template('mail/process_ack',
-				      {forwardexplain  => $forwardexplain,
-				       resentccexplain => $resentccexplain,
-				       thanks          => $thanks,
-				       %{$extra_vars}
-				      }
-				     );
-     &sendmessage(create_mime_message(
-		       ["X-Loop"      => "$gMaintainerEmail",
-			From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
-			To            => $replyto,
-			Subject       => $t_h{subject},
-			"Message-ID"  => $t_h{messageid},
-			"In-Reply-To" => $header{'message-id'},
-                        References    => $header{'message-id'},
-                        Precedence    => 'bulk',
-			"X-$gProject-PR-Message"  => $t_h{pr_message} || "ack $ref",
-			"X-$gProject-PR-Package"  => $data->{package},
-			"X-$gProject-PR-Keywords" => $data->{keywords},
-			# Only have a X-$gProject-PR-Source when we know the source package
-			(defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
-			"Reply-To"                => $t_h{reply_to} || "$ref\@$gEmailDomain",
-		       ],$body,[]), '',undef,1);
-}
-
-&appendlog;
-&finish;
-
-sub overwrite {
-    my ($f,$v) = @_;
-    open(NEW,">$f.new") || &quit("$f.new: create: $!");
-    print(NEW "$v") || &quit("$f.new: write: $!");
-    close(NEW) || &quit("$f.new: close: $!");
-    rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
-}
-
-sub appendlog {
-    my $hash = get_hashname($ref);
-    if (!open(AP,">>db-h/$hash/$ref.log")) {
-        print DEBUG "failed open log<\n";
-        print DEBUG "failed open log err $!<\n";
-        &quit("opening db-h/$hash/$ref.log (li): $!");
-    }
-    print(AP "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
-    close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
-}
-
-sub finish {
-    my ($exit) = @_;
-    $exit ||= 0;
-    utime(time,time,"db");
-    # cleanups are run in an end block now.
-    #my ($u);
-    #while ($u= $cleanups[$#cleanups]) { &$u; }
-    unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
-    exit $exit;
-}
-
-&quit("wot no exit");
-
-sub htmllog {
-    my ($whatobj,$whatverb,$where,$desc) = @_;
-    my $hash = get_hashname($ref);
-    open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
-    print(AP
-          "\6\n".
-          "$whatobj $whatverb".
-          ($where eq '' ? "" : " to ".html_escape($where)."").
-          ":
    \n". $desc.
-          "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
-    close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
-}    
-
-sub stripbccs {
-    my $msg = shift;
-    my $ret = '';
-    my $bcc = 0;
-    while ($msg =~ s/(.*\n)//) {
-	local $_ = $1;
-	if (/^$/) {
-	    $ret .= $_;
-	    last;
-	}
-	if ($bcc) {
-	    # strip continuation lines too
-	    next if /^\s/;
-	    $bcc = 0;
-	}
-	if (/^Bcc:/i) {
-	    $bcc = 1;
-	} else {
-	    $ret .= $_;
-	}
-    }
-    return $ret . $msg;
-}
-
-=head2 send_message
-
-     send_message($the_message,\@recipients,\@bcc,$do_not_encode)
-
-The first argument is the scalar message, the second argument is the
-arrayref of recipients, the third is the arrayref of Bcc:'ed
-recipients.
-
-The final argument turns off header encoding and the addition of the
-X-Loop header if true, defaults to false.
-
-=cut
-
-
-sub sendmessage {
-    my ($msg,$recips,$bcc,$no_encode) = @_;
-    if (not defined $recips or (!ref($recips) && $recips eq '')
-	or @$recips == 0) {
-	$recips = ['-t'];
-    }
-    # This is suboptimal. The right solution is to send headers
-    # separately from the rest of the message and encode them rather
-    # than doing this.
-    $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
-    # The original message received is written out in appendlog, so
-    # before writing out the other messages we've sent out, we need to
-    # RFC1522 encode the header.
-    $msg = encode_headers($msg) unless $no_encode;
-
-    my $hash = get_hashname($ref);
-    #save email to the log
-    open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
-    print(AP "\2\n",join("\4",@$recips),"\n\5\n",
-          escape_log(stripbccs($msg)),"\n\3\n") ||
-        &quit("writing db-h/$hash/$ref.log (lo): $!");
-    close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
-
-    if (ref($bcc)) {
-        shift @$recips if $recips->[0] eq '-t';
-        push @$recips, @$bcc;
-    }
-
-    send_mail_message(message        => $msg,
-		      # Because we encode the headers above, we do not want to encode them here
-		      encode_headers => 0,
-		      recipients     => $recips);
-}
-
-=head2 message_body_template
-
-     message_body_template('mail/ack',{ref=>'foo'});
-
-Creates a message body using a template
-
-=cut
-
-sub message_body_template{
-     my ($template,$extra_var) = @_;
-     $extra_var ||={};
-     my $body = fill_template($template,$extra_var);
-     return fill_template('mail/message_body',
-			  {%{$extra_var},
-			   body => $body,
-			  },
-			 );
-}
-
-=head2 fill_template
-
-     fill_template('mail/foo',{foo=>'bar'});
-
-Calls fill_in_template with a default set of variables and any extras
-added in.
-
-=cut
-
-sub fill_template{
-     my ($template,$extra_var) = @_;
-     $extra_var ||={};
-     my $variables = {config => \%config,
-		      defined($ref)?(ref    => $ref):(),
-		      defined($data)?(data  => $data):(),
-		      %{$extra_var},
-		     };
-     my $hole_var = {'&bugurl' =>
-		     sub{"$_[0]: ".
-			      'http://'.$config{cgi_domain}.'/'.
-				   Debbugs::CGI::bug_url($_[0]);
-		    }
-		    };
-     return fill_in_template(template => $template,
-			     variables => $variables,
-			     hole_var  => $hole_var,
-			    );
-}
-
-
-sub checkmaintainers {
-    return if $maintainerschecked++;
-    return if !length($data->{package});
-    my %maintainerof;
-    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/;
-	# use the package which is normalized to lower case; we do this because we lc the pseudo headers.
-        $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/;
-	# use the package which is normalized to lower case; we do this because we lc the pseudo headers.
-        $maintainerof{$a}= $2;
-    }
-    close(MAINT);
-    my %pkgsrc;
-    open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
-    while () {
-        next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
-	($a,$b)=($1,$2);
-	$a =~ y/A-Z/a-z/;
-	$pkgsrc{$a} = $b;
-    }
-    close(SOURCES);
-    my $anymaintfound=0; my $anymaintnotfound=0;
-    for my $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})) {
-		push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
-	    } else {
-		push @addsrcaddrs, "$p\@$gSubscriptionDomain";
-	    }
-	}
-        if (defined($maintainerof{$p})) {
-	    print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
-            my $addmaint= $maintainerof{$p};
-            push(@maintaddrs,$addmaint) unless
-                $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
-            $anymaintfound++;
-        } else {
-	    print DEBUG "maintainer none >$p<\n";
-	    push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
-            $anymaintnotfound++;
-            last;
-        }
-    }
-
-    if (defined $data->{owner} and length $data->{owner}) {
-        print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
-        my $addmaint = $data->{owner};
-        push(@maintaddrs, $addmaint) unless
-            $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
-    }
-}
-
-=head2 bug_list_forward
-
-     bug_list_forward($spool_filename) if $codeletter eq 'L';
-
-
-Given the spool file, will forward a bug to the per bug mailing list
-subscription system.
-
-=cut
-
-sub bug_list_forward{
-     my ($bug_fn) = @_;
-     # Read the bug information and package information for passing to
-     # the mailing list
-     my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
-     my ($bfound, $data)= lockreadbugmerge($bug_number);
-     my $bug_fh = IO::File->new("incoming/P$bug_fn",'r') or die "Unable to open incoming/P$bug_fn $!";
-
-     local $/ = undef;
-     my $bug_message = <$bug_fh>;
-     my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
-     my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
-     if (not defined $envelope_from) {
-	  # Try to use the From: header or something to set it 
-          ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
-	  # Kludgy, and should really be using a full scale header
-	  # parser to do this.
-	  $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
-     }
-     my ($header,$body) = split /\n\n/, $bug_message, 2;
-     # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
-     $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
-	  qq(X-$gProject-PR-Package: $data->{package}\n).
-	       qq(X-$gProject-PR-Title: $data->{subject})
-	       if defined $data;
-     print STDERR "Tried to loop me with $envelope_from\n"
-	  and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
-     print DEBUG $envelope_from,qq(\n);
-     # If we don't have a bug address, something has gone horribly wrong.
-     print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
-     $bug_address =~ s/\@.+//;
-     print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
-     print DEBUG $header.qq(\n\n).$body;
-     send_mail_message(message        => $header.qq(\n\n).$body,
-		       recipients     => ["bugs=$bug_address\@$gListDomain"],
-		       envelope_from  => $envelope_from,
-		       encode_headers => 0,
-		      );
-     unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");
-     exit 0;
-}
diff --git a/scripts/processall b/scripts/processall
new file mode 100755
index 0000000..2606b26
--- /dev/null
+++ b/scripts/processall
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+# $Id: processall.in,v 1.13 2005/10/06 03:46:13 ajt Exp $
+#
+# Usage: processall
+#
+# Uses up: incoming/I.nn
+# Temps:   incoming/[GP].nn
+# Creates: incoming/E.nn
+# Stop:    stop
+
+use warnings;
+use strict;
+
+
+use Debbugs::Config qw(:globals);
+use Debbugs::Common qw(:lock);
+
+my $lib_path = $gLibPath;
+
+use File::Path;
+
+chdir( $gSpoolDir ) || die "chdir spool: $!\n";
+
+#open(DEBUG,">&4");
+
+umask(002);
+
+$|=1;
+my %fudged;
+my @ids;
+
+my $ndone = 0;
+&filelock('incoming-cleaner');
+for (;;) {
+    if (-f 'stop') {
+        print(STDERR "stop file created\n") || die $!;
+        last;
+    }
+    if (!@ids) {
+        opendir(DIR,"incoming") || die $!;
+        while ( defined( $_= readdir(DIR) )) { push(@ids,$_) if s/^I//; }
+        last unless @ids;
+        @ids= sort(@ids);
+    }
+    stat("$gMaintainerFile") || die "stat $gMaintainerFile: $!\n";
+    my $nf= @ids;
+    my $id= shift(@ids);
+    unless (rename("incoming/I$id","incoming/G$id")) {
+        if ($fudged{$id}) {
+            die "$id already fudged once! $!\n";
+        }
+        $fudged{$id}= 1;
+        next;
+    }
+    my $c;
+    if ($id =~ m/^[RC]/) {
+	 print(STDOUT "[$nf] $id service ...") || die $!;
+        defined($c=fork) || die $!;
+        if (!$c) { exec("$lib_path/service",$id); die "unable to execute $lib_path/service: $!"; }
+    } elsif ($id =~ m/^[BMQFDUL]/) {
+        print(STDOUT "[$nf] $id process ...") || die $!;
+        defined($c=fork) || die $!;
+        if (!$c) { exec("$lib_path/process",$id); die "unable to execute $lib_path/process: $!"; }
+    } else {
+        die "bad name $id";
+    }
+    my $cc=waitpid($c,0); $cc == $c || die "$cc $c $!";
+    my $status=$?;
+    if ($status) {
+        print(STDERR "$id: process failed ($status $!) - now in [PG]$id\n") || die $!;
+    }
+    print(STDOUT " done\n") || die $!;
+    rmtree("$gSpoolDir/mime.tmp",0,1);
+    $ndone++;
+}
+
+
+system("$lib_path/gen-indices",'--quick') == 0 or print STDERR "gen-indices failed\n";
+
+if (@gPostProcessall) {
+    system @gPostProcessall == 0 or print STDERR "\@gPostProcessall failed: ".join(' ',@gPostProcessall)."\n";
+}
+
+
+
+&unfilelock;
+
+exit(0);
diff --git a/scripts/processall.in b/scripts/processall.in
deleted file mode 100755
index 2606b26..0000000
--- a/scripts/processall.in
+++ /dev/null
@@ -1,88 +0,0 @@
-#!/usr/bin/perl
-# $Id: processall.in,v 1.13 2005/10/06 03:46:13 ajt Exp $
-#
-# Usage: processall
-#
-# Uses up: incoming/I.nn
-# Temps:   incoming/[GP].nn
-# Creates: incoming/E.nn
-# Stop:    stop
-
-use warnings;
-use strict;
-
-
-use Debbugs::Config qw(:globals);
-use Debbugs::Common qw(:lock);
-
-my $lib_path = $gLibPath;
-
-use File::Path;
-
-chdir( $gSpoolDir ) || die "chdir spool: $!\n";
-
-#open(DEBUG,">&4");
-
-umask(002);
-
-$|=1;
-my %fudged;
-my @ids;
-
-my $ndone = 0;
-&filelock('incoming-cleaner');
-for (;;) {
-    if (-f 'stop') {
-        print(STDERR "stop file created\n") || die $!;
-        last;
-    }
-    if (!@ids) {
-        opendir(DIR,"incoming") || die $!;
-        while ( defined( $_= readdir(DIR) )) { push(@ids,$_) if s/^I//; }
-        last unless @ids;
-        @ids= sort(@ids);
-    }
-    stat("$gMaintainerFile") || die "stat $gMaintainerFile: $!\n";
-    my $nf= @ids;
-    my $id= shift(@ids);
-    unless (rename("incoming/I$id","incoming/G$id")) {
-        if ($fudged{$id}) {
-            die "$id already fudged once! $!\n";
-        }
-        $fudged{$id}= 1;
-        next;
-    }
-    my $c;
-    if ($id =~ m/^[RC]/) {
-	 print(STDOUT "[$nf] $id service ...") || die $!;
-        defined($c=fork) || die $!;
-        if (!$c) { exec("$lib_path/service",$id); die "unable to execute $lib_path/service: $!"; }
-    } elsif ($id =~ m/^[BMQFDUL]/) {
-        print(STDOUT "[$nf] $id process ...") || die $!;
-        defined($c=fork) || die $!;
-        if (!$c) { exec("$lib_path/process",$id); die "unable to execute $lib_path/process: $!"; }
-    } else {
-        die "bad name $id";
-    }
-    my $cc=waitpid($c,0); $cc == $c || die "$cc $c $!";
-    my $status=$?;
-    if ($status) {
-        print(STDERR "$id: process failed ($status $!) - now in [PG]$id\n") || die $!;
-    }
-    print(STDOUT " done\n") || die $!;
-    rmtree("$gSpoolDir/mime.tmp",0,1);
-    $ndone++;
-}
-
-
-system("$lib_path/gen-indices",'--quick') == 0 or print STDERR "gen-indices failed\n";
-
-if (@gPostProcessall) {
-    system @gPostProcessall == 0 or print STDERR "\@gPostProcessall failed: ".join(' ',@gPostProcessall)."\n";
-}
-
-
-
-&unfilelock;
-
-exit(0);
diff --git a/scripts/rebuild b/scripts/rebuild
new file mode 100755
index 0000000..fd1b927
--- /dev/null
+++ b/scripts/rebuild
@@ -0,0 +1,60 @@
+#!/usr/bin/perl -w
+# $Id: rebuild.in,v 1.13 2003/08/23 15:12:57 cjwatson Exp $
+
+# Load modules and set environment
+use File::Copy;
+$config_path = '/etc/debbugs';
+$lib_path = '/usr/lib/debbugs';
+
+require("$config_path/config");
+require("$lib_path/errorlib");
+use vars qw($gSpoolDir);
+
+$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
+
+chdir("$gSpoolDir") || die "chdir spool: $!\n";
+
+#global variables
+$debug = 0;
+
+@ARGV==0 and die  "no archive given on the commandline" ;
+my $archive = shift(@ARGV);
+my $index = "index.$archive";
+$index = 'index.db' if $archive eq 'db-h';
+open IDXFILE, "> $index" or die  "trying to reset index file: $!" ;
+
+#get list of bugs (ie, status files)
+my @files;
+for ($subdir=0; $subdir<100; $subdir++ )
+{
+    my $path = sprintf( "$archive/%.2d", $subdir );
+    opendir(DIR,$path) || next; 
+    my @list= grep(m/^\d+\.summary$/,readdir(DIR));
+    closedir DIR;
+    grep(s/\.summary$//,@list);
+    push @files, @list;
+}
+
+@files = sort { $a <=> $b } @files;
+
+#process each bug (ie, status file)
+for my $ref (@files) 
+{
+    print STDERR "$ref considering\n" if $debug;
+    my $data = readbug($ref, $archive);
+    $data->{severity} =~ y/A-Z/a-z/;
+
+    (my $pkglist = $data->{package}) =~ s/[,\s]+/,/g;
+    $pkglist =~ s/^,+//;
+    $pkglist =~ s/,+$//;
+
+    my $whendone = 'open';
+    $whendone = 'forwarded' if length $data->{forwarded};
+    $whendone = 'done' if length $data->{done};
+
+    printf IDXFILE "%s %d %d %s [%s] %s %s\n",
+	$pkglist, $ref, $data->{date}, $whendone, $data->{originator},
+	$data->{severity}, $data->{keywords};
+}
+
+close IDXFILE;
diff --git a/scripts/rebuild.in b/scripts/rebuild.in
deleted file mode 100755
index 6c98f25..0000000
--- a/scripts/rebuild.in
+++ /dev/null
@@ -1,60 +0,0 @@
-#!/usr/bin/perl -w
-# $Id: rebuild.in,v 1.13 2003/08/23 15:12:57 cjwatson Exp $
-
-# Load modules and set environment
-use File::Copy;
-$config_path = '/etc/debbugs';
-$lib_path = '/usr/lib/debbugs';
-
-require("$config_path/config");
-require("$lib_path/errorlib");
-use vars qw($gSpoolDir);
-
-$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
-
-chdir("$gSpoolDir") || die "chdir spool: $!\n";
-
-#global variables
-$debug = 0;
-
-@ARGV==0 and &quit( "no archive given on the commandline" );
-my $archive = shift(@ARGV);
-my $index = "index.$archive";
-$index = 'index.db' if $archive eq 'db-h';
-open IDXFILE, "> $index" or &quit( "trying to reset index file: $!" );
-
-#get list of bugs (ie, status files)
-my @files;
-for ($subdir=0; $subdir<100; $subdir++ )
-{
-    my $path = sprintf( "$archive/%.2d", $subdir );
-    opendir(DIR,$path) || next; 
-    my @list= grep(m/^\d+\.summary$/,readdir(DIR));
-    closedir DIR;
-    grep(s/\.summary$//,@list);
-    push @files, @list;
-}
-
-@files = sort { $a <=> $b } @files;
-
-#process each bug (ie, status file)
-for my $ref (@files) 
-{
-    print STDERR "$ref considering\n" if $debug;
-    my $data = readbug($ref, $archive);
-    $data->{severity} =~ y/A-Z/a-z/;
-
-    (my $pkglist = $data->{package}) =~ s/[,\s]+/,/g;
-    $pkglist =~ s/^,+//;
-    $pkglist =~ s/,+$//;
-
-    my $whendone = 'open';
-    $whendone = 'forwarded' if length $data->{forwarded};
-    $whendone = 'done' if length $data->{done};
-
-    printf IDXFILE "%s %d %d %s [%s] %s %s\n",
-	$pkglist, $ref, $data->{date}, $whendone, $data->{originator},
-	$data->{severity}, $data->{keywords};
-}
-
-close IDXFILE;
diff --git a/scripts/receive b/scripts/receive
new file mode 100755
index 0000000..eb101a4
--- /dev/null
+++ b/scripts/receive
@@ -0,0 +1,147 @@
+#!/usr/bin/perl
+# $Id: receive.in,v 1.17 2005/07/24 18:42:41 don Exp $
+# usage: mail is piped directly into program
+
+#set umask in order to have group-writable incoming/*
+#umask(002);
+
+use Debbugs::Config qw(:globals :text);
+my $lib_path = $gLibPath;
+
+$ENV{'PATH'} = '/usr/lib/debbugs:'.$ENV{'PATH'};
+
+#set source of mail delivery
+#sets any prefix needed to get mailer to add it to error mail
+if ( $gMailer eq 'exim' ) 
+{	$gBadEmailPrefix = '';
+	$_ = $ENV{'LOCAL_PART'};
+} elsif ( $gMailer eq 'qmail' )
+{	$gBadEmailPrefix = '//';
+	$_ = $ENV{'DEFAULT'};
+#	$_ = $ENV{'RECIPIENT'};
+#	s/^\w+-bugs--?//;
+} else 
+{	$gBadEmailPrefix = '';
+	$_ = $ARGV[0];
+	s/\>//;
+	s/\T.$id") || &failure("open temporary file: $!");
+printf(FILE "Received: (at %s) by $gEmailDomain; %d %s %d %02d:%02d:%02d +0000\n",
+       $addrrec, $mday,$months[$mon],$year+1900, $hour,$min,$sec) ||
+    &failure("write header to temporary file: $!");
+while() { print(FILE) || &failure("write temporary file: $!"); }
+close(FILE) || &failure("close temporary file: $!");
+
+my $prefix;
+if ($gSpamScan) {
+    $prefix = 'S';
+} else {
+    $prefix = 'I';
+}
+rename("T.$id","$prefix$queue.$id") || &failure("rename spool message: $!");
+
+exit(0);
+
+sub failure {
+    length($id) && unlink("T.$id");
+    print STDERR "bugs receive failure: @_\n";
+    exit(75); # EX_TEMPFAIL
+}
diff --git a/scripts/receive.in b/scripts/receive.in
deleted file mode 100755
index eb101a4..0000000
--- a/scripts/receive.in
+++ /dev/null
@@ -1,147 +0,0 @@
-#!/usr/bin/perl
-# $Id: receive.in,v 1.17 2005/07/24 18:42:41 don Exp $
-# usage: mail is piped directly into program
-
-#set umask in order to have group-writable incoming/*
-#umask(002);
-
-use Debbugs::Config qw(:globals :text);
-my $lib_path = $gLibPath;
-
-$ENV{'PATH'} = '/usr/lib/debbugs:'.$ENV{'PATH'};
-
-#set source of mail delivery
-#sets any prefix needed to get mailer to add it to error mail
-if ( $gMailer eq 'exim' ) 
-{	$gBadEmailPrefix = '';
-	$_ = $ENV{'LOCAL_PART'};
-} elsif ( $gMailer eq 'qmail' )
-{	$gBadEmailPrefix = '//';
-	$_ = $ENV{'DEFAULT'};
-#	$_ = $ENV{'RECIPIENT'};
-#	s/^\w+-bugs--?//;
-} else 
-{	$gBadEmailPrefix = '';
-	$_ = $ARGV[0];
-	s/\>//;
-	s/\T.$id") || &failure("open temporary file: $!");
-printf(FILE "Received: (at %s) by $gEmailDomain; %d %s %d %02d:%02d:%02d +0000\n",
-       $addrrec, $mday,$months[$mon],$year+1900, $hour,$min,$sec) ||
-    &failure("write header to temporary file: $!");
-while() { print(FILE) || &failure("write temporary file: $!"); }
-close(FILE) || &failure("close temporary file: $!");
-
-my $prefix;
-if ($gSpamScan) {
-    $prefix = 'S';
-} else {
-    $prefix = 'I';
-}
-rename("T.$id","$prefix$queue.$id") || &failure("rename spool message: $!");
-
-exit(0);
-
-sub failure {
-    length($id) && unlink("T.$id");
-    print STDERR "bugs receive failure: @_\n";
-    exit(75); # EX_TEMPFAIL
-}
diff --git a/scripts/service b/scripts/service
new file mode 100755
index 0000000..df289c9
--- /dev/null
+++ b/scripts/service
@@ -0,0 +1,1749 @@
+#!/usr/bin/perl
+# $Id: service.in,v 1.118 2005/10/19 01:22:14 don Exp $
+#
+# Usage: service .nn
+# Temps:  incoming/P.nn
+
+use warnings;
+use strict;
+
+
+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::Status qw(:read :status :write :versions);
+
+use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
+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::CGI qw(html_escape);
+use Debbugs::Control qw(:archive :log :owner);
+use Debbugs::Log qw(:misc);
+use Debbugs::Text qw(:templates);
+
+use Mail::RFC822::Address;
+
+chdir($config{spool_dir}) or
+     die "Unable to chdir to spool_dir '$config{spool_dir}': $!";
+
+my $debug = 0;
+umask(002);
+
+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: $!";
+}
+
+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;
+
+# Bug numbers to send e-mail to, hash so that we don't send to the
+# same bug twice.
+my (%bug_affected);
+
+my (@headerlines,@bodylines);
+
+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;
+    print ">$_<\n" if $debug;
+    if (s/^(\S+):\s*//) {
+	my $v = lc $1;
+	print ">$v=$_<\n" if $debug;
+	$header{$v} = $_;
+    } else {
+	print "!>$_<\n" if $debug;
+    }
+}
+$header{'message-id'} ||= '';
+
+grep(s/\s+$//,@bodylines);
+
+print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
+
+if (defined $header{'resent-from'} && !defined $header{'from'}) {
+    $header{'from'} = $header{'resent-from'};
+}
+
+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 {
+    $replyto = $header{'from'};
+}
+
+# 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 $transcript_scalar = '';
+my $transcript = IO::Scalar->new(\$transcript_scalar) or
+     die "Unable to create new IO::Scalar";
+print {$transcript} "Processing commands for $controlrequestaddr:\n\n";
+
+# debug level
+my $dl = 0;
+my $state= 'idle';
+my $lowstate= 'idle';
+my $mergelowstate= 'idle';
+my $midix=0;
+
+my $user = $replyto;
+$user =~ s/,.*//;
+$user =~ s/^.*<(.*)>.*$/$1/;
+$user =~ s/[(].*[)]//;
+$user =~ s/^\s*(\S+)\s+.*$/$1/;
+$user = "" unless (Debbugs::User::is_valid_user($user));
+my $indicated_user = 0;
+
+my $quickabort = 0;
+
+
+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;
+
+
+# recipients of mail
+my %recipients;
+# affected_packages
+my %affected_packages;
+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";
+    if ($quickabort) {
+         print {$transcript} "Stopping processing here.\n\n";
+	 last;
+    }
+    $_= $bodylines[$procline]; s/\s+$//;
+    next unless m/\S/;
+    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) {
+	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";
+    } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
+        $ref= $2+0;
+        &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
+    } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
+	$ref= $1+0;
+	&sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
+		     "detailed logs for $gBug#$ref");
+    } elsif (m/^index(\s+full)?$/i) {
+	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) {
+	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) {
+	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) {
+	&sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
+    } elsif (m/^index(\s+|-)maints?$/i) {
+	&sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
+    } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
+	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) {
+	my $package = $+;
+	&sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
+		     "$gBug list for package $package");
+        $ok++;
+    } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
+	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) {
+	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) {
+	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) {
+        # the following is basically a Debian-specific kludge, but who cares
+        my $req = $1;
+	if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
+	    &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
+	} 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 {
+	    print {$transcript} "Info file $req does not exist.\n\n";
+	}
+    } elsif (m/^help/i) {
+        &sendhelp;
+        print {$transcript} "\n";
+        $ok++;
+    } elsif (m/^refcard/i) {
+        &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
+    } elsif (m/^subscribe/i) {
+        print {$transcript} < $bodylines[$procline]\n";
+            next if $bad;
+            my ($o, $txt) = ($1, $2);
+            if ($#cats == -1 && $o eq "+") {
+                print {$transcript} "User defined category specification must start with a category name. Skipping.\n\n";
+		$errors++;
+                $bad = 1;
+                next;
+            }
+            if ($o eq "+") {
+	        unless (ref($cats[-1]) eq "HASH") {
+		    $cats[-1] = { "nam" => $cats[-1], 
+		                  "pri" => [], "ttl" => [] };
+		}
+	        $catsec++;
+		my ($desc, $ord, $op);
+                if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
+                    $desc = $1; $ord = $3; $op = "";
+                } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
+                    $desc = $1; $ord = $3; $op = $4;
+                } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
+                    $desc = ""; $op = $1;
+                } else {
+                    print {$transcript} "Unrecognised syntax for category section. Skipping.\n\n";
+		    $errors++;
+                    $bad = 1;
+                    next;
+                }
+		$ord = 999 unless defined $ord;
+
+		if ($op) {
+                    push @{$cats[-1]->{"pri"}}, $prefix . $op;
+		    push @{$cats[-1]->{"ttl"}}, $desc;
+		    push @ords, "$ord $catsec";
+		} else {
+		    $cats[-1]->{"def"} = $desc;
+		    push @ords, "$ord DEF";
+		    $catsec--;
+		}
+		@ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
+		               $a1 <=> $b1 || $a2 <=> $b2; } @ords;
+		$cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
+            } elsif ($o eq "*") {
+	        $catsec = 0;
+                my ($name);
+                if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
+                    $name = $1; $prefix = $3;
+                } else {
+                    $name = $txt; $prefix = "";
+                }
+                push @cats, $name;
+            }
+        }
+        # XXX: got @cats, now do something with it
+	my $u = Debbugs::User::get_user($user);
+	if (@cats) {
+	    print {$transcript} "Added usercategory $catname.\n\n";
+	    $u->{"categories"}->{$catname} = [ @cats ];
+	    if (not $hidden) {
+		 push @{$u->{visible_cats}},$catname;
+	    }
+	} else {
+	    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;
+	my $addsubcode = $3 || "+";
+	my $tags = $4;
+	if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
+	     $ref = $clonebugs{$ref};
+        }
+	if ($user eq "") {
+	    print {$transcript} "No valid user selected\n";
+	    $errors++;
+	    $indicated_user = 1;
+        } elsif (&setbug) {
+	    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 (@badtags) {
+                print {$transcript} "Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n";
+		$errors++;
+	    }
+            for my $t (keys %chtags) {
+	        $ut{$t} = [] unless defined $ut{$t};
+	    }
+	    for my $t (keys %ut) {
+		my %res = map { ($_, 1) } @{$ut{$t}};
+		push @oldtags, $t if defined $res{$ref};
+		my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
+		my $del = (defined $chtags{$t} ? $addsubcode eq "-" 
+		                               : $addsubcode eq "=");
+		$res{$ref} = 1 if ($addop && defined $chtags{$t});
+		delete $res{$ref} if ($del);
+		push @newtags, $t if defined $res{$ref};
+		$ut{$t} = [ sort { $a <=> $b } (keys %res) ];
+	    }
+	    if (@oldtags == 0) {
+		print {$transcript} "There were no usertags set.\n";
+	    } else {
+		print {$transcript} "Usertags were: " . join(" ", @oldtags) . ".\n";
+	    }
+	    print {$transcript} "Usertags are now: " . join(" ", @newtags) . ".\n";
+	    Debbugs::User::write_usertags(\%ut, $user);
+	}
+    } elsif (!$control) {
+        print {$transcript} <= 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},
+				  );
+		    $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);
+                $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);
+            } 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);
+                    $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);
+                    # 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);
+                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);
+                    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);
+                    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);
+                $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},
+			      );
+		$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);
+                    $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);
+                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);
+	        $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 ($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);
+		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);
+		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);
+		    $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);
+	    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);
+		@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);
+		@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++;
+
+	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/^owner\s+\#?(-?\d+)\s+((?:\S.*\S)|\!)\s*$/i) {
+	$ok++;
+        $ref = $1;
+	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,
+		 );
+	};
+    } elsif (m/^noowner\s+\#?(-?\d+)\s*$/i) {
+        $ok++;
+        $ref = $1;
+	$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: $@";
+	}
+    } elsif (m/^unarchive\s+#?(\d+)$/i) {
+	 $ok++;
+	 $ref = $1;
+	 $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;
+	 $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";
+	$errors++;
+        if (++$unknowns >= 5) {
+            print {$transcript} "Too many unknown commands, stopping here.\n\n";
+            last;
+        }
+    }
+}
+if ($procline>$#bodylines) {
+    print {$transcript} ">\nEnd of message, stopping processing here.\n\n";
+}
+if (!$ok && !$quickabort) {
+    $errors++;
+    print {$transcript} "No commands successfully parsed; sending the help text(s).\n";
+    &sendhelp;
+    print {$transcript} "\n";
+}
+
+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 $repliedshow= join(', ',$replyto,
+		      determine_recipients(recipients => \%recipients,
+					   cc => 1,
+					   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,
+		 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 {
+    my ($message,@recips) = @_;
+    $message = "X-Loop: $gMaintainerEmail\n" . $message;
+    send_mail_message(message    => $message,
+		      recipients => \@recips,
+		     );
+    $midix++;
+}
+
+sub fill_template{
+     my ($template,$extra_var) = @_;
+     $extra_var ||={};
+     my $variables = {config => \%config,
+		      defined($ref)?(ref    => $ref):(),
+		      defined($data)?(data  => $data):(),
+		      %{$extra_var},
+		     };
+     my $hole_var = {'&bugurl' =>
+		     sub{"$_[0]: ".
+			      'http://'.$config{cgi_domain}.'/'.
+				   Debbugs::CGI::bug_url($_[0]);
+		    }
+		    };
+     return fill_in_template(template => $template,
+			     variables => $variables,
+			     hole_var  => $hole_var,
+			    );
+}
+
+=head2 message_body_template
+
+     message_body_template('mail/ack',{ref=>'foo'});
+
+Creates a message body using a template
+
+=cut
+
+sub message_body_template{
+     my ($template,$extra_var) = @_;
+     $extra_var ||={};
+     my $body = fill_template($template,$extra_var);
+     return fill_template('mail/message_body',
+			  {%{$extra_var},
+			   body => $body,
+			  },
+			 );
+}
+
+sub sendhelp {
+        &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
+        &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
+            if $control;
+}
+
+#sub unimplemented {
+#    print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n";
+#}
+
+sub checkmatch {
+    my ($string,$mvarname,$svarvalue,@newmergelist) = @_;
+    my ($mvarvalue);
+    if (@newmergelist) {
+        eval "\$mvarvalue= \$$mvarname";
+        print {$transcript} "D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n"
+            if $dl;
+        $mismatch .=
+            "Values for \`$string' don't match:\n".
+            " #$newmergelist[0] has \`$mvarvalue';\n".
+            " #$ref has \`$svarvalue'\n"
+            if $mvarvalue ne $svarvalue;
+    } else {
+	 print {$transcript} "D| setupmatch \`$string' /$mvarname/$svarvalue/\n"
+	      if $dl;
+        eval "\$$mvarname= \$svarvalue";
+    }
+}
+
+sub checkpkglimit {
+    if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
+        print {$transcript} "$gBug number $ref belongs to package $data->{package}, skipping.\n\n";
+        $errors++;
+        return 0;
+    }
+    return 1;
+}
+
+sub manipset {
+    my $list = shift;
+    my $elt = shift;
+    my $add = shift;
+
+    my %h = map { $_ => 1 } split ' ', $list;
+    if ($add) {
+        $h{$elt}=1;
+    }
+    else {
+	delete $h{$elt};
+    }
+    return join ' ', sort keys %h;
+}
+
+# High-level bug manipulation calls
+# Do announcements themselves
+#
+# Possible calling sequences:
+#    setbug (returns 0)
+#    
+#    setbug (returns 1)
+#    &transcript(something)
+#    nochangebug
+#
+#    setbug (returns 1)
+#    $action= (something)
+#    do {
+#      (modify s_* variables)
+#    } while (getnextbug);
+
+our $manybugs;
+
+sub nochangebug {
+    &dlen("nochangebug");
+    $state eq 'single' || $state eq 'multiple' || die "$state ?";
+    &cancelbug;
+    &endmerge if $manybugs;
+    $state= 'idle';
+    &dlex("nochangebug");
+}
+
+our $sref;
+our @thisbugmergelist;
+
+sub setbug {
+    &dlen("setbug $ref");
+    if ($ref =~ m/^-\d+/) {
+        if (!defined $clonebugs{$ref}) {
+            ¬foundbug;
+            &dlex("setbug => noclone");
+            return 0;
+        }
+        $ref = $clonebugs{$ref};
+    }
+    $state eq 'idle' || die "$state ?";
+    if (!&getbug) {
+        ¬foundbug;
+        &dlex("setbug => 0s");
+        return 0;
+    }
+
+    if (!&checkpkglimit) {
+        &cancelbug;
+        return 0;
+    }
+
+    @thisbugmergelist= split(/ /,$data->{mergedwith});
+    if (!@thisbugmergelist) {
+        &foundbug;
+        $manybugs= 0;
+        $state= 'single';
+        $sref=$ref;
+        &dlex("setbug => 1s");
+        return 1;
+    }
+    &cancelbug;
+    &getmerge;
+    $manybugs= 1;
+    if (!&getbug) {
+        ¬foundbug;
+        &endmerge;
+        &dlex("setbug => 0mc");
+        return 0;
+    }
+    &foundbug;
+    $state= 'multiple'; $sref=$ref;
+    &dlex("setbug => 1m");
+    return 1;
+}
+
+sub getnextbug {
+    &dlen("getnextbug");
+    $state eq 'single' || $state eq 'multiple' || die "$state ?";
+    &savebug;
+    if (!$manybugs || !@thisbugmergelist) {
+        length($action) || die;
+        print {$transcript} "$action\n$extramessage\n";
+        &endmerge if $manybugs;
+        $state= 'idle';
+        &dlex("getnextbug => 0");
+        return 0;
+    }
+    $ref= shift(@thisbugmergelist);
+    &getbug || die "bug $ref disappeared";
+    &foundbug;
+    &dlex("getnextbug => 1");
+    return 1;
+}
+
+# Low-level bug-manipulation calls
+# Do no announcements
+#
+#    getbug (returns 0)
+#
+#    getbug (returns 1)
+#    cancelbug
+#
+#    getmerge
+#    $action= (something)
+#    getbug (returns 1)
+#    savebug/cancelbug
+#    getbug (returns 1)
+#    savebug/cancelbug
+#    [getbug (returns 0)]
+#    &transcript("$action\n\n")
+#    endmerge
+
+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");
+    $mergelowstate eq 'idle' || die "$mergelowstate ?";
+    &filelock('lock/merge');
+    $mergelowstate='locked';
+    &dlex("getmerge");
+}
+
+sub endmerge {
+    &dlen("endmerge");
+    $mergelowstate eq 'locked' || die "$mergelowstate ?";
+    &unfilelock;
+    $mergelowstate='idle';
+    &dlex("endmerge");
+}
+
+sub getbug {
+    &dlen("getbug $ref");
+    $lowstate eq 'idle' || die "$state ?";
+    # Only use unmerged bugs here
+    if (($data = &lockreadbug($ref,'db-h'))) {
+        $sref= $ref;
+        $lowstate= "open";
+        &dlex("getbug => 1");
+        $extramessage='';
+        return 1;
+    }
+    $lowstate= 'idle';
+    &dlex("getbug => 0");
+    return 0;
+}
+
+sub cancelbug {
+    &dlen("cancelbug");
+    $lowstate eq 'open' || die "$state ?";
+    &unfilelock;
+    $lowstate= 'idle';
+    &dlex("cancelbug");
+}
+
+sub savebug {
+    &dlen("savebug $ref");
+    $lowstate eq 'open' || die "$lowstate ?";
+    length($action) || die;
+    $ref == $sref || die "read $sref but saving $ref ?";
+    append_action_to_log(bug => $ref,
+			 action => $action,
+			 requester => $header{from},
+			 request_addr => $controlrequestaddr,
+			 message => \@log,
+			 get_lock => 0,
+			);
+    unlockwritebug($ref, $data);
+    $lowstate= "idle";
+    &dlex("savebug");
+}
+
+sub dlen {
+    return if !$dl;
+    print {$transcript} "C> @_ ($state $lowstate $mergelowstate)\n";
+}
+
+sub dlex {
+    return if !$dl;
+    print {$transcript} "R> @_ ($state $lowstate $mergelowstate)\n";
+}
+
+sub urlsanit {
+    my $url = shift;
+    $url =~ s/%/%25/g;
+    $url =~ s/\+/%2b/g;
+    my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
+    $url =~ s/([<>&"])/\&$saniarray{$1};/g;
+    return $url;
+}
+
+sub sendlynxdoc {
+    &sendlynxdocraw;
+    print {$transcript} "\n";
+    $ok++;
+}
+
+sub sendtxthelp {
+    &sendtxthelpraw;
+    print {$transcript} "\n";
+    $ok++;
+}
+
+
+our $doc;
+sub sendtxthelpraw {
+    my ($relpath,$description) = @_;
+    $doc='';
+    open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!";
+    while() { $doc.=$_; }
+    close(D);
+    print {$transcript} "Sending $description in separate message.\n";
+    &sendmailmessage(<
+Precedence: bulk
+X-$gProject-PR-Message: doc-text $relpath
+
+END
+    $ok++;
+}
+
+sub sendlynxdocraw {
+    my ($relpath,$description) = @_;
+    $doc='';
+    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/) {
+        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";
+    } else {
+        print {$transcript} "Sending $description.\n";
+        &sendmailmessage(<
+Precedence: bulk
+X-$gProject-PR-Message: doc-html $relpath
+
+END
+         $ok++;
+    }
+}
+
+
+sub sendinfo {
+    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;
+      if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
+          print {$transcript} "$description is not available.\n";
+          $ok++; return;
+      } elsif ($?) {
+          print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
+          return;
+      }
+    } elsif ($wherefrom eq "local") {
+      open P, "$path";
+      $doc = do { local $/; 
     };
+      close P;
+    } else {
+      print {$transcript} "internal errror: info files location unknown.\n";
+      $ok++; return;
+    }
+    print {$transcript} "Sending $description.\n";
+    &sendmailmessage(<
+Precedence: bulk
+X-$gProject-PR-Message: getinfo
+
+$description follows:
+
+END
+    $ok++;
+    print {$transcript} "\n";
+}
diff --git a/scripts/service.in b/scripts/service.in
deleted file mode 100755
index 05925d2..0000000
--- a/scripts/service.in
+++ /dev/null
@@ -1,1818 +0,0 @@
-#!/usr/bin/perl
-# $Id: service.in,v 1.118 2005/10/19 01:22:14 don Exp $
-#
-# Usage: service .nn
-# Temps:  incoming/P.nn
-
-use File::Copy;
-use MIME::Parser;
-use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
-use Debbugs::Mail qw(send_mail_message);
-use Debbugs::User;
-use HTML::Entities qw(encode_entities);
-use Debbugs::Versions::Dpkg;
-
-use Debbugs::Config qw(:globals :config);
-use Debbugs::CGI qw(html_escape);
-use Debbugs::Control qw(:archive :log);
-use Debbugs::Log qw(:misc);
-use Debbugs::Text qw(:templates);
-
-use Mail::RFC822::Address;
-
-$lib_path = $gLibPath;
-require "$lib_path/errorlib";
-$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
-
-chdir("$gSpoolDir") || die "chdir spool: $!\n";
-
-# open(DEBUG,">&4");
-open DEBUG, ">/dev/null";
-$debug = 0;
-umask(002);
-
-$_=shift;
-m/^[RC]\.\d+$/ || &quit("bad argument");
-$control= m/C/;
-$nn= $_;
-if (!rename("incoming/G$nn","incoming/P$nn")) {
-    $_=$!.'';  m/no such file or directory/i && exit 0;
-    &quit("renaming to lock: $!");
-}    
-
-open(M,"incoming/P$nn");
-@log=;
-@msg=@log;
-close(M);
-
-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 $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];
-}
-
-for (@headerlines) {
-    $_ = decode_rfc1522($_);
-    s/\n\s/ /g;
-    print ">$_<\n" if $debug;
-    if (s/^(\S+):\s*//) {
-	my $v = lc $1;
-	print ">$v=$_<\n" if $debug;
-	$header{$v} = $_;
-    } else {
-	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;
-}
-
-grep(s/\s+$//,@bodylines);
-
-print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
-
-if (defined $header{'resent-from'} && !defined $header{'from'}) {
-    $header{'from'} = $header{'resent-from'};
-}
-
-defined($header{'from'}) || &quit("no From header");
-
-delete $header{'reply-to'} 
-	if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
-
-if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
-    $replyto = $header{'reply-to'};
-} else {
-    $replyto = $header{'from'};
-}
-
-# 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 $user = $replyto;
-$user =~ s/,.*//;
-$user =~ s/^.*<(.*)>.*$/$1/;
-$user =~ s/[(].*[)]//;
-$user =~ s/^\s*(\S+)\s+.*$/$1/;
-$user = "" unless (Debbugs::User::is_valid_user($user));
-my $indicated_user = 0;
-
-my $quickabort = 0;
-
-my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")";
-if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
-	&transcript(fill_template('mail/excluded_from_control'));
-	$quickabort = 1;
-}
-
-my %limit_pkgs = ();
-my %clonebugs = ();
-my @bcc = ();
-
-sub addbcc {
-    push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
-}
-
-for ($procline=0; $procline<=$#bodylines; $procline++) {
-    $state eq 'idle' || print "$state ?\n";
-    $lowstate eq 'idle' || print "$lowstate ?\n";
-    $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
-    if ($quickabort) {
-         &transcript("Stopping processing here.\n\n");
-	 last;
-    }
-    $_= $bodylines[$procline]; s/\s+$//;
-    next unless m/\S/;
-    &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");
-        last;
-    } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
-        $dl= $1+0;
-        &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");
-    } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
-	$ref= $1+0;
-	&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");
-	$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");
-	$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");
-	$errors++;
-	$ok++; # well, it's not really ok, but it fixes #81224 :)
-    } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
-	&sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
-    } elsif (m/^index(\s+|-)maints?$/i) {
-	&sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
-    } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
-	$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 = $+;
-	&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");
-	$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");
-	$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");
-	$errors++;
-	$ok++; # well, it's not really ok, but it fixes #81224 :)
-    } elsif (m/^getinfo\s+([\w-.]+)$/i) {
-        # the following is basically a Debian-specific kludge, but who cares
-        $req = $1;
-	if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
-	    &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
-	} 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");
-	}
-    } elsif (m/^help/i) {
-        &sendhelp;
-        &transcript("\n");
-        $ok++;
-    } elsif (m/^refcard/i) {
-        &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
-    } elsif (m/^subscribe/i) {
-        &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");
-		$errors++;
-                $bad = 1;
-                next;
-            }
-            if ($o eq "+") {
-	        unless (ref($cats[-1]) eq "HASH") {
-		    $cats[-1] = { "nam" => $cats[-1], 
-		                  "pri" => [], "ttl" => [] };
-		}
-	        $catsec++;
-		my ($desc, $ord, $op);
-                if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
-                    $desc = $1; $ord = $3; $op = "";
-                } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
-                    $desc = $1; $ord = $3; $op = $4;
-                } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
-                    $desc = ""; $op = $1;
-                } else {
-                    &transcript("Unrecognised syntax for category section. Skipping.\n\n");
-		    $errors++;
-                    $bad = 1;
-                    next;
-                }
-		$ord = 999 unless defined $ord;
-
-		if ($op) {
-                    push @{$cats[-1]->{"pri"}}, $prefix . $op;
-		    push @{$cats[-1]->{"ttl"}}, $desc;
-		    push @ords, "$ord $catsec";
-		} else {
-		    @cats[-1]->{"def"} = $desc;
-		    push @ords, "$ord DEF";
-		    $catsec--;
-		}
-		@ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
-		               $a1 <=> $b1 || $a2 <=> $b2; } @ords;
-		$cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
-            } elsif ($o eq "*") {
-	        $catsec = 0;
-                my ($name);
-                if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
-                    $name = $1; $prefix = $3;
-                } else {
-                    $name = $txt; $prefix = "";
-                }
-                push @cats, $name;
-            }
-        }
-        # XXX: got @cats, now do something with it
-	my $u = Debbugs::User::get_user($user);
-	if (@cats) {
-	    &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");
-	    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;
-	if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
-	     $ref = $clonebugs{$ref};
-        }
-	if ($user eq "") {
-	    &transcript("No valid user selected\n");
-	    $errors++;
-	    $indicated_user = 1;
-        } elsif (&setbug) {
-	    if (not $indicated_user and defined $user) {
-		 &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 (@badtags) {
-                &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
-		$errors++;
-	    }
-            for my $t (keys %chtags) {
-	        $ut{$t} = [] unless defined $ut{$t};
-	    }
-	    for my $t (keys %ut) {
-		my %res = map { ($_, 1) } @{$ut{$t}};
-		push @oldtags, $t if defined $res{$ref};
-		my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
-		my $del = (defined $chtags{$t} ? $addsubcode eq "-" 
-		                               : $addsubcode eq "=");
-		$res{$ref} = 1 if ($addop && defined $chtags{$t});
-		delete $res{$ref} if ($del);
-		push @newtags, $t if defined $res{$ref};
-		$ut{$t} = [ sort { $a <=> $b } (keys %res) ];
-	    }
-	    if (@oldtags == 0) {
-		&transcript("There were no usertags set.\n");
-	    } else {
-		&transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
-	    }
-	    &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");
-	}
-    } 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");
-	$errors++;
-        if (++$unknowns >= 5) {
-            &transcript("Too many unknown commands, stopping here.\n\n");
-            last;
-        }
-    }
-}
-if ($procline>$#bodylines) {
-    &transcript(">\nEnd of message, stopping processing here.\n\n");
-}
-if (!$ok && !quickabort) {
-    $errors++;
-    &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";
-}
-
-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;
-
-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
-
-$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);
-
-unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
-
-sub sendmailmessage {
-    local ($message,@recips) = @_;
-    $message = "X-Loop: $gMaintainerEmail\n" . $message;
-    send_mail_message(message    => $message,
-		      recipients => \@recips,
-		     );
-    $midix++;
-}
-
-sub fill_template{
-     my ($template,$extra_var) = @_;
-     $extra_var ||={};
-     my $variables = {config => \%config,
-		      defined($ref)?(ref    => $ref):(),
-		      defined($data)?(data  => $data):(),
-		      %{$extra_var},
-		     };
-     my $hole_var = {'&bugurl' =>
-		     sub{"$_[0]: ".
-			      'http://'.$config{cgi_domain}.'/'.
-				   Debbugs::CGI::bug_url($_[0]);
-		    }
-		    };
-     return fill_in_template(template => $template,
-			     variables => $variables,
-			     hole_var  => $hole_var,
-			    );
-}
-
-=head2 message_body_template
-
-     message_body_template('mail/ack',{ref=>'foo'});
-
-Creates a message body using a template
-
-=cut
-
-sub message_body_template{
-     my ($template,$extra_var) = @_;
-     $extra_var ||={};
-     my $body = fill_template($template,$extra_var);
-     return fill_template('mail/message_body',
-			  {%{$extra_var},
-			   body => $body,
-			  },
-			 );
-}
-
-sub sendhelp {
-        &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
-        &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
-            if $control;
-}
-
-#sub unimplemented {
-#    &transcript("Sorry, command $_[0] not yet implemented.\n\n");
-#}
-
-sub checkmatch {
-    local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
-    local ($mvarvalue);
-    if (@newmergelist) {
-        eval "\$mvarvalue= \$$mvarname";
-        &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
-            if $dl;
-        $mismatch .=
-            "Values for \`$string' don't match:\n".
-            " #$newmergelist[0] has \`$mvarvalue';\n".
-            " #$ref has \`$svarvalue'\n"
-            if $mvarvalue ne $svarvalue;
-    } else {
-        &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
-            if $dl;
-        eval "\$$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");
-        $errors++;
-        return 0;
-    }
-    return 1;
-}
-
-sub manipset {
-    my $list = shift;
-    my $elt = shift;
-    my $add = shift;
-
-    my %h = map { $_ => 1 } split ' ', $list;
-    if ($add) {
-        $h{$elt}=1;
-    }
-    else {
-	delete $h{$elt};
-    }
-    return join ' ', sort keys %h;
-}
-
-# High-level bug manipulation calls
-# Do announcements themselves
-#
-# Possible calling sequences:
-#    setbug (returns 0)
-#    
-#    setbug (returns 1)
-#    &transcript(something)
-#    nochangebug
-#
-#    setbug (returns 1)
-#    $action= (something)
-#    do {
-#      (modify s_* variables)
-#    } while (getnextbug);
-
-sub nochangebug {
-    &dlen("nochangebug");
-    $state eq 'single' || $state eq 'multiple' || die "$state ?";
-    &cancelbug;
-    &endmerge if $manybugs;
-    $state= 'idle';
-    &dlex("nochangebug");
-}
-
-sub setbug {
-    &dlen("setbug $ref");
-    if ($ref =~ m/^-\d+/) {
-        if (!defined $clonebugs{$ref}) {
-            ¬foundbug;
-            &dlex("setbug => noclone");
-            return 0;
-        }
-        $ref = $clonebugs{$ref};
-    }
-    $state eq 'idle' || die "$state ?";
-    if (!&getbug) {
-        ¬foundbug;
-        &dlex("setbug => 0s");
-        return 0;
-    }
-
-    if (!&checkpkglimit) {
-        &cancelbug;
-        return 0;
-    }
-
-    @thisbugmergelist= split(/ /,$data->{mergedwith});
-    if (!@thisbugmergelist) {
-        &foundbug;
-        $manybugs= 0;
-        $state= 'single';
-        $sref=$ref;
-        &dlex("setbug => 1s");
-        return 1;
-    }
-    &cancelbug;
-    &getmerge;
-    $manybugs= 1;
-    if (!&getbug) {
-        ¬foundbug;
-        &endmerge;
-        &dlex("setbug => 0mc");
-        return 0;
-    }
-    &foundbug;
-    $state= 'multiple'; $sref=$ref;
-    &dlex("setbug => 1m");
-    return 1;
-}
-
-sub getnextbug {
-    &dlen("getnextbug");
-    $state eq 'single' || $state eq 'multiple' || die "$state ?";
-    &savebug;
-    if (!$manybugs || !@thisbugmergelist) {
-        length($action) || die;
-        &transcript("$action\n$extramessage\n");
-        &endmerge if $manybugs;
-        $state= 'idle';
-        &dlex("getnextbug => 0");
-        return 0;
-    }
-    $ref= shift(@thisbugmergelist);
-    &getbug || die "bug $ref disappeared";
-    &foundbug;
-    &dlex("getnextbug => 1");
-    return 1;
-}
-
-# Low-level bug-manipulation calls
-# Do no announcements
-#
-#    getbug (returns 0)
-#
-#    getbug (returns 1)
-#    cancelbug
-#
-#    getmerge
-#    $action= (something)
-#    getbug (returns 1)
-#    savebug/cancelbug
-#    getbug (returns 1)
-#    savebug/cancelbug
-#    [getbug (returns 0)]
-#    &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 getmerge {
-    &dlen("getmerge");
-    $mergelowstate eq 'idle' || die "$mergelowstate ?";
-    &filelock('lock/merge');
-    $mergelowstate='locked';
-    &dlex("getmerge");
-}
-
-sub endmerge {
-    &dlen("endmerge");
-    $mergelowstate eq 'locked' || die "$mergelowstate ?";
-    &unfilelock;
-    $mergelowstate='idle';
-    &dlex("endmerge");
-}
-
-sub getbug {
-    &dlen("getbug $ref");
-    $lowstate eq 'idle' || die "$state ?";
-    # Only use unmerged bugs here
-    if (($data = &lockreadbug($ref,'db-h'))) {
-        $sref= $ref;
-        $lowstate= "open";
-        &dlex("getbug => 1");
-        $extramessage='';
-        return 1;
-    }
-    $lowstate= 'idle';
-    &dlex("getbug => 0");
-    return 0;
-}
-
-sub cancelbug {
-    &dlen("cancelbug");
-    $lowstate eq 'open' || die "$state ?";
-    &unfilelock;
-    $lowstate= 'idle';
-    &dlex("cancelbug");
-}
-
-sub savebug {
-    &dlen("savebug $ref");
-    $lowstate eq 'open' || die "$lowstate ?";
-    length($action) || die;
-    $ref == $sref || die "read $sref but saving $ref ?";
-    append_action_to_log(bug => $ref,
-			 action => $action,
-			 requester => $header{from},
-			 request_addr => $controlrequestaddr,
-			 message => \@log,
-			 get_lock => 0,
-			);
-    unlockwritebug($ref, $data);
-    $lowstate= "idle";
-    &dlex("savebug");
-}
-
-sub dlen {
-    return if !$dl;
-    &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];
-}
-
-sub urlsanit {
-    my $url = shift;
-    $url =~ s/%/%25/g;
-    $url =~ s/\+/%2b/g;
-    my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
-    $url =~ s/([<>&"])/\&$saniarray{$1};/g;
-    return $url;
-}
-
-sub sendlynxdoc {
-    &sendlynxdocraw;
-    &transcript("\n");
-    $ok++;
-}
-
-sub sendtxthelp {
-    &sendtxthelpraw;
-    &transcript("\n");
-    $ok++;
-}
-
-sub sendtxthelpraw {
-    local ($relpath,$description) = @_;
-    $doc='';
-    open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
-    while() { $doc.=$_; }
-    close(D);
-    &transcript("Sending $description in separate message.\n");
-    &sendmailmessage(<
-Precedence: bulk
-X-$gProject-PR-Message: doc-text $relpath
-
-END
-    $ok++;
-}
-
-sub sendlynxdocraw {
-    local ($relpath,$description) = @_;
-    $doc='';
-    open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("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");
-         $ok++;
-    } elsif ($?) {
-        &transcript("Error getting $description (code $? $!):\n$doc\n");
-    } else {
-        &transcript("Sending $description.\n");
-        &sendmailmessage(<
-Precedence: bulk
-X-$gProject-PR-Message: doc-html $relpath
-
-END
-         $ok++;
-    }
-}
-
-sub addccaddress {
-    my ($cca) = @_;
-    $maintccreasons{$cca}{''}{$ref}= 1;
-}
-
-sub addmaintainers {
-    # Data structure is:
-    #   maintainer email address &c -> 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) = @_;
-    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: $!");
-      $! = 0;
-      if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
-          &transcript("$description is not available.\n");
-          $ok++; return;
-      } elsif ($?) {
-          &transcript("Error getting $description (code $? $!):\n$doc\n");
-          return;
-      }
-    } elsif ($wherefrom eq "local") {
-      open P, "$path";
-      $doc = do { local $/; 
     };
-      close P;
-    } else {
-      &transcript("internal errror: info files location unknown.\n");
-      $ok++; return;
-    }
-    &transcript("Sending $description.\n");
-    &sendmailmessage(<
-Precedence: bulk
-X-$gProject-PR-Message: getinfo
-
-$description follows:
-
-END
-    $ok++;
-    &transcript("\n");
-}
diff --git a/scripts/spamscan b/scripts/spamscan
new file mode 100755
index 0000000..9114b83
--- /dev/null
+++ b/scripts/spamscan
@@ -0,0 +1,325 @@
+#! /usr/bin/perl
+# $Id: spamscan.in,v 1.8 2005/02/01 07:54:01 blarson Exp $
+#
+# Usage: spamscan
+#
+# Performs SpamAssassin checks on a message before allowing it through to
+# the main incoming queue.
+#
+# Uses up: incoming/S.nn
+# Temps:   incoming/R.nn
+# Creates: incoming/I.nn
+# Stop:    spamscan-stop
+
+use warnings;
+use strict;
+
+use threads;
+use threads::shared;
+
+use Debbugs::Config qw(:config);
+
+use Debbugs::Common qw(:lock);
+
+use Mail::CrossAssassin;
+use Socket;
+use IO::Handle;
+use IPC::Open2;
+
+
+exit unless $config{spam_scan};
+
+chdir $config{spool_dir} or die "chdir spool: $!\n";
+
+umask 002;
+
+eval {
+    filelock('incoming-spamscan');
+};
+exit if $@;
+
+my %spamseen : shared = ();
+my @ids : shared = ();
+my %fudged : shared = ();
+my $spamscan_stop : shared = 0;
+my $cross_key : shared;
+my @cross_return : shared;
+my $cross_tid : shared;
+my $print_lock : shared;
+my $assassinated_lock : shared;
+my $crossassassinated_lock : shared;
+my $threadsrunning : shared = 0;
+
+# flush output immediately
+$| = 1;
+
+sub lprint ($) {
+    lock $print_lock;
+    print $_[0];
+}
+
+my $user_prefs = "$ENV{HOME}/.spamassassin/user_prefs";
+my $user_prefs_time;
+if (-e $user_prefs) {
+    $user_prefs_time = (stat $user_prefs)[9];
+} else {
+    die "$user_prefs not found";
+}
+
+# This thread handles the updating and querying of the crossassassin db
+sub cross {
+    ca_init('\b\d{3,8}(?:-(?:close|done|forwarded|maintonly|submitter|quiet|subscribe))?\@'.$config{email_domain}, $config{spam_crossassassin_db});
+    my $mytid = threads->self->tid();
+crosscheck:
+    while ($spamscan_stop <= 1) {
+	my ($ck, $ct);
+	{
+	    lock $cross_key unless($cross_key);
+	    until ($cross_key) {
+		last crosscheck if $spamscan_stop > 1;
+		lprint "{$mytid} cross waiting\n";
+		cond_timedwait $cross_key, (time() + 30);
+	    }
+	    last crosscheck if ($spamscan_stop > 1);
+	    $ck = $cross_key;
+	    $ct = $cross_tid;
+	    undef $cross_key;
+	}
+	unless ($ck) {
+	    lprint "{$mytid} Cross nothing\n";
+	    sleep 1;
+	    next crosscheck;
+	}
+	lprint "{$mytid} Cross{$ct}: $ck\n";
+	{
+	    lock @cross_return;
+	    $cross_return[$ct] = ca_set($ck);
+	    cond_signal @cross_return;
+	}
+    }
+}
+
+# multiple threads handle spamassassin
+sub sa {
+    {
+	lock $threadsrunning;
+	$threadsrunning++;
+    }
+    my $mytid = threads->self->tid();
+    sleep $mytid + 3;
+    return if $spamscan_stop;
+    my ($sain, $saout);
+
+    my $pid = open2($saout, $sain, "/usr/lib/debbugs/spamscan-sa");
+	lprint "{$mytid} forked $pid\n";
+	my $messages_handled=0;
+pp:	until ($spamscan_stop) {
+	    my ($id, $nf);
+	    lprint "{$mytid} $messages_handled messages handled\n";
+	    $messages_handled++;
+getid:	    for (;;) {
+		{
+		    lock @ids;
+		    $nf = @ids;
+		    $id = shift @ids;
+		    last getid if $nf;
+		    cond_timedwait @ids, (time() + 30);
+		    last pp if $spamscan_stop;
+		    $nf = @ids;
+		    $id = shift @ids;
+		    last getid if $nf;
+		}
+		lprint "{$mytid} Waiting for spam to process\n";
+		sleep 1;
+	    }
+	    print $sain "$id\n$nf\n";
+	    lprint "{$mytid} $id is $nf\n";
+	    my $keys = <$saout>;
+	    unless (defined $keys) {
+		lprint "{$mytid} Could not get keys: $!\n";
+		last pp;
+	    }
+	    chomp $keys;
+	    my $messageid = <$saout>;
+	    unless (defined($messageid)) {
+		lprint "{$mytid} Could not read messageid: $!\n";
+		last pp;
+	    }
+	    chomp $messageid;
+	    lprint "{$mytid} $id $keys\n";
+	    my $ca_score;
+crosskey:   for (;;) {
+	        {
+		    lock $cross_key;
+		    unless ($cross_key) {
+			$cross_tid = $mytid;
+			$cross_key = $keys;
+			cond_signal $cross_key;
+			last crosskey;
+		    }
+		}
+		lprint "{$mytid} zzz...\n";
+		select undef, undef, undef, 0.1;
+	    }
+crossret:   for (;;) {
+	        {
+		    lock @cross_return;
+		    if ($cross_return[$mytid]) {
+			$ca_score = $cross_return[$mytid];
+			undef $cross_return[$mytid];
+			last crossret;
+		    }
+		}
+		lprint "{$mytid} z z z...\n";
+		select undef, undef, undef, 0.1;
+	    }
+	    lprint "{$mytid} $id: ca_score: $ca_score\n";
+	    my $seen = $spamseen{$messageid};
+	    $seen = '' unless $seen;
+	    unless(print $sain "$ca_score\n$seen\n") {
+		lprint "{$mytid} Could not send ca_score: $!\n";
+		last pp;
+	    }
+	    my $todo = <$saout>;
+	    unless (defined($todo)) {
+		lprint "{$mytid} Could not read todo: $!\n";
+		last pp;
+	    }
+	    chomp $todo;
+	    my $nseen;
+	    if ($todo == 1) {
+		lock $assassinated_lock;
+		print $sain "$todo\n";
+		$nseen = <$saout>;
+	    } elsif ($todo == 2) {
+		lock $crossassassinated_lock;
+		print $sain "$todo\n";
+		$nseen = <$saout>;
+	    } else {
+		print $sain "$todo\n";
+		$nseen = <$saout>;
+	    }
+	    unless(defined($nseen)) {
+		lprint "{$mytid} Could not read seen: $!\n";
+		start_sa() if (scalar(@ids) > ($threadsrunning * $config{spam_spams_per_thread})
+		    && $threadsrunning < $config{spam_max_threads});
+		last pp;
+	    }
+	    chomp $nseen;
+	    $spamseen{$messageid} = $nseen if ($nseen);
+	    my $out = <$saout>;
+	    unless(defined($out)) {
+		lprint "{$mytid} Could not read out: $!\n";
+		last pp;
+	    }
+	    chomp $out;
+	    $out =~ tr/\r/\n/;
+	    lprint $out;
+	}
+	{
+	    lock $threadsrunning;
+	    $threadsrunning--;
+	}
+        close $sain;
+        close $saout;
+	waitpid($pid,0);
+}
+
+my @sa_threads;
+sub start_sa {
+    my $s = threads->create(\&sa)
+	or die "Could not start sa threads: $!";
+    $s->detach;
+    push @sa_threads, $s;
+}
+
+my $cross_thread = threads->create(\&cross)
+    or die "Could not start cross thread: $!";
+$cross_thread->detach;
+start_sa;
+# start_sa;
+
+my $stopafter = time() + $config{spam_keep_running};
+
+for (;;) {
+    alarm 180;
+    if (-f 'spamscan-stop') {
+	lprint "spamscan-stop file created\n";
+	last;
+    }
+    if ($user_prefs_time != (stat $user_prefs)[9]) {
+	# stop and wait to be re-invoked from cron
+	lprint "File $user_prefs changed\n";
+	last;
+    }
+
+    unless (@ids) {
+	if (time() > $stopafter) {
+	    lprint "KeepRunning timer expired\n";
+	    last;
+	}
+        my @i;
+	opendir DIR, 'incoming' or die "opendir incoming: $!";
+	while (defined($_ = readdir DIR)) {
+	    push @i, $1 if /^S(.*)/;
+	}
+	unless (@i) {
+	    lprint "No more spam to process\n";
+	    last;
+	}
+	@i = sort {(split(/\./,$a))[1] <=> (split(/\./,$b))[1]} @i;
+	my $m = @i;
+	lprint "Messages to process: $m\n";
+	lock @ids;
+	push @ids, @i;
+	cond_broadcast @ids;
+    }
+    start_sa if (scalar(@ids) > (($threadsrunning - 1) * $config{spam_spams_per_thread})
+		 && $threadsrunning < $config{spam_max_threads});
+    sleep 30;
+}
+
+alarm 180;
+
+# wait for the spamassasin threads
+$spamscan_stop = 1;
+{
+    lock @ids;
+    cond_broadcast @ids;
+}
+
+while (my $t = shift @sa_threads) {
+    my $tid = $t->tid;
+    lprint "{} waiting for thread $tid\n";
+    my $max_wait = 60;
+    while ($t->is_running and --$max_wait > 0) {
+        sleep 1;
+    }
+#    $t->join;
+}
+
+# wait for the crossassasin thread
+$spamscan_stop = 2;
+{
+    lprint "{} waiting for cross thread\n";
+    lock $cross_key;
+    $cross_key = 1;
+    cond_signal $cross_key;
+}
+my $max_wait = 60;
+while ($cross_thread->is_running and --$max_wait > 0) {
+    sleep 1;
+}
+#$cross_thread->join;
+
+END{
+   foreach my $thread (threads->list()){
+      $thread->join;
+   }
+}
+
+&unfilelock;
+
+
+
+#exit 0;
diff --git a/scripts/spamscan.in b/scripts/spamscan.in
deleted file mode 100755
index 9114b83..0000000
--- a/scripts/spamscan.in
+++ /dev/null
@@ -1,325 +0,0 @@
-#! /usr/bin/perl
-# $Id: spamscan.in,v 1.8 2005/02/01 07:54:01 blarson Exp $
-#
-# Usage: spamscan
-#
-# Performs SpamAssassin checks on a message before allowing it through to
-# the main incoming queue.
-#
-# Uses up: incoming/S.nn
-# Temps:   incoming/R.nn
-# Creates: incoming/I.nn
-# Stop:    spamscan-stop
-
-use warnings;
-use strict;
-
-use threads;
-use threads::shared;
-
-use Debbugs::Config qw(:config);
-
-use Debbugs::Common qw(:lock);
-
-use Mail::CrossAssassin;
-use Socket;
-use IO::Handle;
-use IPC::Open2;
-
-
-exit unless $config{spam_scan};
-
-chdir $config{spool_dir} or die "chdir spool: $!\n";
-
-umask 002;
-
-eval {
-    filelock('incoming-spamscan');
-};
-exit if $@;
-
-my %spamseen : shared = ();
-my @ids : shared = ();
-my %fudged : shared = ();
-my $spamscan_stop : shared = 0;
-my $cross_key : shared;
-my @cross_return : shared;
-my $cross_tid : shared;
-my $print_lock : shared;
-my $assassinated_lock : shared;
-my $crossassassinated_lock : shared;
-my $threadsrunning : shared = 0;
-
-# flush output immediately
-$| = 1;
-
-sub lprint ($) {
-    lock $print_lock;
-    print $_[0];
-}
-
-my $user_prefs = "$ENV{HOME}/.spamassassin/user_prefs";
-my $user_prefs_time;
-if (-e $user_prefs) {
-    $user_prefs_time = (stat $user_prefs)[9];
-} else {
-    die "$user_prefs not found";
-}
-
-# This thread handles the updating and querying of the crossassassin db
-sub cross {
-    ca_init('\b\d{3,8}(?:-(?:close|done|forwarded|maintonly|submitter|quiet|subscribe))?\@'.$config{email_domain}, $config{spam_crossassassin_db});
-    my $mytid = threads->self->tid();
-crosscheck:
-    while ($spamscan_stop <= 1) {
-	my ($ck, $ct);
-	{
-	    lock $cross_key unless($cross_key);
-	    until ($cross_key) {
-		last crosscheck if $spamscan_stop > 1;
-		lprint "{$mytid} cross waiting\n";
-		cond_timedwait $cross_key, (time() + 30);
-	    }
-	    last crosscheck if ($spamscan_stop > 1);
-	    $ck = $cross_key;
-	    $ct = $cross_tid;
-	    undef $cross_key;
-	}
-	unless ($ck) {
-	    lprint "{$mytid} Cross nothing\n";
-	    sleep 1;
-	    next crosscheck;
-	}
-	lprint "{$mytid} Cross{$ct}: $ck\n";
-	{
-	    lock @cross_return;
-	    $cross_return[$ct] = ca_set($ck);
-	    cond_signal @cross_return;
-	}
-    }
-}
-
-# multiple threads handle spamassassin
-sub sa {
-    {
-	lock $threadsrunning;
-	$threadsrunning++;
-    }
-    my $mytid = threads->self->tid();
-    sleep $mytid + 3;
-    return if $spamscan_stop;
-    my ($sain, $saout);
-
-    my $pid = open2($saout, $sain, "/usr/lib/debbugs/spamscan-sa");
-	lprint "{$mytid} forked $pid\n";
-	my $messages_handled=0;
-pp:	until ($spamscan_stop) {
-	    my ($id, $nf);
-	    lprint "{$mytid} $messages_handled messages handled\n";
-	    $messages_handled++;
-getid:	    for (;;) {
-		{
-		    lock @ids;
-		    $nf = @ids;
-		    $id = shift @ids;
-		    last getid if $nf;
-		    cond_timedwait @ids, (time() + 30);
-		    last pp if $spamscan_stop;
-		    $nf = @ids;
-		    $id = shift @ids;
-		    last getid if $nf;
-		}
-		lprint "{$mytid} Waiting for spam to process\n";
-		sleep 1;
-	    }
-	    print $sain "$id\n$nf\n";
-	    lprint "{$mytid} $id is $nf\n";
-	    my $keys = <$saout>;
-	    unless (defined $keys) {
-		lprint "{$mytid} Could not get keys: $!\n";
-		last pp;
-	    }
-	    chomp $keys;
-	    my $messageid = <$saout>;
-	    unless (defined($messageid)) {
-		lprint "{$mytid} Could not read messageid: $!\n";
-		last pp;
-	    }
-	    chomp $messageid;
-	    lprint "{$mytid} $id $keys\n";
-	    my $ca_score;
-crosskey:   for (;;) {
-	        {
-		    lock $cross_key;
-		    unless ($cross_key) {
-			$cross_tid = $mytid;
-			$cross_key = $keys;
-			cond_signal $cross_key;
-			last crosskey;
-		    }
-		}
-		lprint "{$mytid} zzz...\n";
-		select undef, undef, undef, 0.1;
-	    }
-crossret:   for (;;) {
-	        {
-		    lock @cross_return;
-		    if ($cross_return[$mytid]) {
-			$ca_score = $cross_return[$mytid];
-			undef $cross_return[$mytid];
-			last crossret;
-		    }
-		}
-		lprint "{$mytid} z z z...\n";
-		select undef, undef, undef, 0.1;
-	    }
-	    lprint "{$mytid} $id: ca_score: $ca_score\n";
-	    my $seen = $spamseen{$messageid};
-	    $seen = '' unless $seen;
-	    unless(print $sain "$ca_score\n$seen\n") {
-		lprint "{$mytid} Could not send ca_score: $!\n";
-		last pp;
-	    }
-	    my $todo = <$saout>;
-	    unless (defined($todo)) {
-		lprint "{$mytid} Could not read todo: $!\n";
-		last pp;
-	    }
-	    chomp $todo;
-	    my $nseen;
-	    if ($todo == 1) {
-		lock $assassinated_lock;
-		print $sain "$todo\n";
-		$nseen = <$saout>;
-	    } elsif ($todo == 2) {
-		lock $crossassassinated_lock;
-		print $sain "$todo\n";
-		$nseen = <$saout>;
-	    } else {
-		print $sain "$todo\n";
-		$nseen = <$saout>;
-	    }
-	    unless(defined($nseen)) {
-		lprint "{$mytid} Could not read seen: $!\n";
-		start_sa() if (scalar(@ids) > ($threadsrunning * $config{spam_spams_per_thread})
-		    && $threadsrunning < $config{spam_max_threads});
-		last pp;
-	    }
-	    chomp $nseen;
-	    $spamseen{$messageid} = $nseen if ($nseen);
-	    my $out = <$saout>;
-	    unless(defined($out)) {
-		lprint "{$mytid} Could not read out: $!\n";
-		last pp;
-	    }
-	    chomp $out;
-	    $out =~ tr/\r/\n/;
-	    lprint $out;
-	}
-	{
-	    lock $threadsrunning;
-	    $threadsrunning--;
-	}
-        close $sain;
-        close $saout;
-	waitpid($pid,0);
-}
-
-my @sa_threads;
-sub start_sa {
-    my $s = threads->create(\&sa)
-	or die "Could not start sa threads: $!";
-    $s->detach;
-    push @sa_threads, $s;
-}
-
-my $cross_thread = threads->create(\&cross)
-    or die "Could not start cross thread: $!";
-$cross_thread->detach;
-start_sa;
-# start_sa;
-
-my $stopafter = time() + $config{spam_keep_running};
-
-for (;;) {
-    alarm 180;
-    if (-f 'spamscan-stop') {
-	lprint "spamscan-stop file created\n";
-	last;
-    }
-    if ($user_prefs_time != (stat $user_prefs)[9]) {
-	# stop and wait to be re-invoked from cron
-	lprint "File $user_prefs changed\n";
-	last;
-    }
-
-    unless (@ids) {
-	if (time() > $stopafter) {
-	    lprint "KeepRunning timer expired\n";
-	    last;
-	}
-        my @i;
-	opendir DIR, 'incoming' or die "opendir incoming: $!";
-	while (defined($_ = readdir DIR)) {
-	    push @i, $1 if /^S(.*)/;
-	}
-	unless (@i) {
-	    lprint "No more spam to process\n";
-	    last;
-	}
-	@i = sort {(split(/\./,$a))[1] <=> (split(/\./,$b))[1]} @i;
-	my $m = @i;
-	lprint "Messages to process: $m\n";
-	lock @ids;
-	push @ids, @i;
-	cond_broadcast @ids;
-    }
-    start_sa if (scalar(@ids) > (($threadsrunning - 1) * $config{spam_spams_per_thread})
-		 && $threadsrunning < $config{spam_max_threads});
-    sleep 30;
-}
-
-alarm 180;
-
-# wait for the spamassasin threads
-$spamscan_stop = 1;
-{
-    lock @ids;
-    cond_broadcast @ids;
-}
-
-while (my $t = shift @sa_threads) {
-    my $tid = $t->tid;
-    lprint "{} waiting for thread $tid\n";
-    my $max_wait = 60;
-    while ($t->is_running and --$max_wait > 0) {
-        sleep 1;
-    }
-#    $t->join;
-}
-
-# wait for the crossassasin thread
-$spamscan_stop = 2;
-{
-    lprint "{} waiting for cross thread\n";
-    lock $cross_key;
-    $cross_key = 1;
-    cond_signal $cross_key;
-}
-my $max_wait = 60;
-while ($cross_thread->is_running and --$max_wait > 0) {
-    sleep 1;
-}
-#$cross_thread->join;
-
-END{
-   foreach my $thread (threads->list()){
-      $thread->join;
-   }
-}
-
-&unfilelock;
-
-
-
-#exit 0;
diff --git a/scripts/summary b/scripts/summary
new file mode 100755
index 0000000..5d2b03f
--- /dev/null
+++ b/scripts/summary
@@ -0,0 +1,99 @@
+#!/usr/bin/perl
+# $Id: summary.in,v 1.11 2004/04/17 17:31:04 cjwatson Exp $
+
+$config_path = '/etc/debbugs';
+$lib_path = '/usr/lib/debbugs';
+
+require("$config_path/config");
+require("$lib_path/errorlib");
+$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
+
+chdir("$gSpoolDir") || die "chdir spool: $!\n";
+
+#open(DEBUG,">&4");
+
+$mode= shift(@ARGV);
+
+open(M,"$gMaintainerFile") || die "open $gMaintainerFile: $!";
+while () {
+    m/^(\S+)\s+(\S.*\S)\s*$/ || warn "$_ ?";
+    ($a,$b)=($1,$2);
+    $a =~ y/A-Z/a-z/;
+    $maintainer{$a}= $b;
+}
+close(M);
+open(M,"$gMaintainerFileOverride") || die "open $gMaintainerFileOverride: $!";
+while () {
+    m/^(\S+)\s+(\S.*\S)\s*$/ || warn "$_ ?";
+    ($a,$b)=($1,$2);
+    $a =~ y/A-Z/a-z/;
+    $maintainer{$a}= $b;
+}
+close(M);
+		
+
+defined($startdate= time) || die "failed to get time: $!";
+
+opendir(DIR,"db-h") || die "opendir db-h: $!\n";
+@dirs = grep(s,^,db-h/,, grep(m/^\d+$/,readdir(DIR)));
+closedir(DIR);
+foreach my $dir (@dirs) {
+        opendir(DIR,$dir);
+        push @list, grep(s/\.status$//,grep(m/^\d+\.status$/,readdir(DIR)));
+        closedir(DIR);
+}
+@list = sort { $a <=> $b } @list;
+
+$head= $mode eq 'bymaint'
+    ? ' Package     Ref    Subject'
+    : ' Ref   Package    Keywords/Subject               Package maintainer';
+$amonths=-1;
+
+while (length($f=shift(@list))) {
+    if (!($data = lockreadbug($f))) { next; }
+    $_= $data->{package}; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9]/;
+    $data->{maintainer}=
+        defined($maintainer{$_}) ? $maintainer{$_} :
+        length($_) ? "(unknown -- \`$_')" :
+        "(unknown)";
+    if ($mode eq 'undone' || $mode eq 'veryold') {
+        &unfilelock;
+        next if length($data->{done}) || length($data->{forwarded});
+        $cmonths= int(($startdate - $data->{date})/2592000); # 3600*24*30 (30 days)
+        next if $mode eq 'veryold' && $cmonths < 2;
+        if ($cmonths != $amonths) {
+            $msg= $cmonths == 0 ? "Submitted in the last month" :
+                  $cmonths == 1 ? "Over one month old" :
+                  $cmonths == 2 ? "Over two months old - attention is required" :
+                                  "OVER $cmonths MONTHS OLD - ATTENTION IS REQUIRED";
+            print "\n$msg:\n$head\n";
+            $amonths= $cmonths;
+        }
+        printf("%6d %-10.10s %-30.30s %-.31s\n", $f, $data->{package},
+               (length($data->{keywords}) ? $data->{keywords}.'/' : '').$data->{subject},
+               $data->{maintainer}) || die "output undone: $!";
+    } elsif ($mode eq 'bymaint') {
+        &unfilelock;
+        next if length($data->{done}) || length($data->{forwarded});
+        $string{$f}=
+            sprintf(" %-10.10s %6d  %-.59s\n", $data->{package}, $f, $data->{subject});
+        $data->{maintainer}= "(unknown)" if $data->{maintainer} =~ m/^\(unknown \-\-/;
+        $maintainercnt{$data->{maintainer}}++;
+        $maintainerlist{$data->{maintainer}}.= " $f";
+    } else {
+        die "badmode $mode";
+    }
+}
+
+if ($mode eq 'bymaint') {
+    print("$head\n") || die "output head: $!";
+    for $m (sort { $maintainercnt{$a} <=> $maintainercnt{$b} } keys %maintainercnt) {
+        printf("\n%s (%d $gBugs):\n",$m,$maintainercnt{$m})
+            || die "output mainthead: $!";
+        for $i (sort { $string{$a} cmp $string{$b} } split(/ /,$maintainerlist{$m})) {
+            printf($string{$i}) || die "output 1bymaint: $!";
+        }
+    }
+}
+
+close(STDOUT) || die "close stdout: $!";
diff --git a/scripts/summary.in b/scripts/summary.in
deleted file mode 100755
index a1be697..0000000
--- a/scripts/summary.in
+++ /dev/null
@@ -1,99 +0,0 @@
-#!/usr/bin/perl
-# $Id: summary.in,v 1.11 2004/04/17 17:31:04 cjwatson Exp $
-
-$config_path = '/etc/debbugs';
-$lib_path = '/usr/lib/debbugs';
-
-require("$config_path/config");
-require("$lib_path/errorlib");
-$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
-
-chdir("$gSpoolDir") || die "chdir spool: $!\n";
-
-#open(DEBUG,">&4");
-
-$mode= shift(@ARGV);
-
-open(M,"$gMaintainerFile") || &quit("open $gMaintainerFile: $!");
-while () {
-    m/^(\S+)\s+(\S.*\S)\s*$/ || warn "$_ ?";
-    ($a,$b)=($1,$2);
-    $a =~ y/A-Z/a-z/;
-    $maintainer{$a}= $b;
-}
-close(M);
-open(M,"$gMaintainerFileOverride") || &quit("open $gMaintainerFileOverride: $!");
-while () {
-    m/^(\S+)\s+(\S.*\S)\s*$/ || warn "$_ ?";
-    ($a,$b)=($1,$2);
-    $a =~ y/A-Z/a-z/;
-    $maintainer{$a}= $b;
-}
-close(M);
-		
-
-defined($startdate= time) || &quit("failed to get time: $!");
-
-opendir(DIR,"db-h") || &quit("opendir db-h: $!\n");
-@dirs = grep(s,^,db-h/,, grep(m/^\d+$/,readdir(DIR)));
-closedir(DIR);
-foreach my $dir (@dirs) {
-        opendir(DIR,$dir);
-        push @list, grep(s/\.status$//,grep(m/^\d+\.status$/,readdir(DIR)));
-        closedir(DIR);
-}
-@list = sort { $a <=> $b } @list;
-
-$head= $mode eq 'bymaint'
-    ? ' Package     Ref    Subject'
-    : ' Ref   Package    Keywords/Subject               Package maintainer';
-$amonths=-1;
-
-while (length($f=shift(@list))) {
-    if (!($data = lockreadbug($f))) { next; }
-    $_= $data->{package}; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9]/;
-    $data->{maintainer}=
-        defined($maintainer{$_}) ? $maintainer{$_} :
-        length($_) ? "(unknown -- \`$_')" :
-        "(unknown)";
-    if ($mode eq 'undone' || $mode eq 'veryold') {
-        &unfilelock;
-        next if length($data->{done}) || length($data->{forwarded});
-        $cmonths= int(($startdate - $data->{date})/2592000); # 3600*24*30 (30 days)
-        next if $mode eq 'veryold' && $cmonths < 2;
-        if ($cmonths != $amonths) {
-            $msg= $cmonths == 0 ? "Submitted in the last month" :
-                  $cmonths == 1 ? "Over one month old" :
-                  $cmonths == 2 ? "Over two months old - attention is required" :
-                                  "OVER $cmonths MONTHS OLD - ATTENTION IS REQUIRED";
-            print "\n$msg:\n$head\n";
-            $amonths= $cmonths;
-        }
-        printf("%6d %-10.10s %-30.30s %-.31s\n", $f, $data->{package},
-               (length($data->{keywords}) ? $data->{keywords}.'/' : '').$data->{subject},
-               $data->{maintainer}) || &quit("output undone: $!");
-    } elsif ($mode eq 'bymaint') {
-        &unfilelock;
-        next if length($data->{done}) || length($data->{forwarded});
-        $string{$f}=
-            sprintf(" %-10.10s %6d  %-.59s\n", $data->{package}, $f, $data->{subject});
-        $data->{maintainer}= "(unknown)" if $data->{maintainer} =~ m/^\(unknown \-\-/;
-        $maintainercnt{$data->{maintainer}}++;
-        $maintainerlist{$data->{maintainer}}.= " $f";
-    } else {
-        &quit("badmode $mode");
-    }
-}
-
-if ($mode eq 'bymaint') {
-    print("$head\n") || &quit("output head: $!");
-    for $m (sort { $maintainercnt{$a} <=> $maintainercnt{$b} } keys %maintainercnt) {
-        printf("\n%s (%d $gBugs):\n",$m,$maintainercnt{$m})
-            || &quit("output mainthead: $!");
-        for $i (sort { $string{$a} cmp $string{$b} } split(/ /,$maintainerlist{$m})) {
-            printf($string{$i}) || &quit("output 1bymaint: $!");
-        }
-    }
-}
-
-close(STDOUT) || &quit("close stdout: $!");
diff --git a/scripts/text b/scripts/text
new file mode 100644
index 0000000..415aba0
--- /dev/null
+++ b/scripts/text
@@ -0,0 +1,342 @@
+# -*- mode: cperl -*-
+
+use Debbugs::Config qw(:globals);
+
+############################################################################
+#  Here is a blurb to point people to ftp archive of directions.  It is
+#  used by the receive script when bouncing a badly formatted email
+#
+# $gTextInstructions = "$gBadEmailPrefix
+# $gBadEmailPrefix Instructions are available from ftp.debian.org in /debian
+# $gBadEmailPrefix and at all Debian mirror sites, in the files:
+# $gBadEmailPrefix  doc/bug-reporting.txt
+# $gBadEmailPrefix  doc/bug-log-access.txt
+# $gBadEmailPrefix  doc/bug-maint-info.txt
+# $gBadEmailPrefix";
+############################################################################
+$gBadEmailPrefix = '' unless defined $gBadEmailPrefix;
+$gTextInstructions = "$gBadEmailPrefix";
+
+
+############################################################################
+# Here is a blurb for any mirrors of the web site.  Here's a sample:
+#
+#$gHTMLCopies = "
    Copies of the logs are available on the World Wide Web at
    
+# http://mirror1.domain
    
+# http://mirror2.domain";
+############################################################################
+$gHTMLCopies = "";
+
+
+############################################################################
+# notice other links you want to note, like your list archives or project
+# home page.
+#
+#$gHTMLOtherPages = "Other Links of note:
    
+#	The Debian Project
    
+#	Description of URL";
+############################################################################
+$gHTMLOtherPages = "";
+
+
+############################################################################
+# list of other links you want to note, like your list archives or project
+# home page.  Some pages already have links in a list, this adds them to 
+# the end of the list.
+#
+#$gHTMLOtherPageList = "
  • 
+#	The Debian Project
+#	
  • Description of URL";
+############################################################################
+$gHTMLOtherPageList = "";
+
+
+############################################################################
+# gives explanation of bad maintainer situation and instructions on how to
+# correct.
+############################################################################
+$gBadMaintHtml = "";
+
+
+############################################################################
+# give directions here for how to find the proper title for Package:
+# pseudo header line.
+############################################################################
+$gHTMLFindPackage = "";
+
+
+############################################################################
+# If you have pseudo packages, place a blurb here.  For example:
+# $gHTMLPseudoDesc = "
    There are some pseudo-packages available for putting in
+# the Package line when reporting a $gBug in something other than an
+# actual $gProject software package.  There is 
+#  a list of these on the $gBugs WWW 
+# pages.";
+############################################################################
+$gHTMLPseudoDesc = "";
+
+
+############################################################################
+# List any extra information you would like included in bug reports. For
+# example:
+# $gXtraBugInfo = "
  • What kernel version you're using (type
+# uname -a), your shared C library (type ls -l
+# /lib/libc.so.6 or dpkg -s libc6 | grep ^Version), and
+# any other details about your Debian system, if it seems appropriate.
+# For example, if you had a problem with a Perl script, you would want to
+# provide the version of the `perl' binary (type perl -v or
+# dpkg -s perl-5.005 | grep ^Version:).";
+############################################################################
+$gXtraBugInfo = "";
+
+
+############################################################################
+# List any extra information you would like about reporting bugs
+############################################################################
+$gXtraReportingInfo = "";
+
+
+############################################################################
+# Process used by system to create Maintainers index file
+############################################################################
+$gCreateMaintainers = "";
+
+
+###########################################################################
+# You shouldn't have to modify anything below here unless it's for personal
+# preference.  Be very careful and don't touch unless you *know* what
+# you're doing.  Much of the stuff has hardcoded duplicates elsewhere.
+
+
+############################################################################
+# Description of the severities
+############################################################################
+$gHTMLSeverityDesc = "
    critical
+	
    makes unrelated software on the system (or the whole system) break,
+	or causes serious data loss, or introduces a security hole on systems 
+	where you install the package.
+
+	
    grave
+	
    makes the package in question unusable or mostly so, or causes data
+	loss, or introduces a security hole allowing access to the accounts of
+	users who use the package.
+
+	
    normal
+	
    the default value, for normal $gBugs.
+
+	
    wishlist
+	
    for any feature request, and also for any $gBugs that are very 
+	difficult to fix due to major design considerations.";
+
+############################################################################
+# Description of the tags
+############################################################################
+$gHTMLTagDesc = "
+
    patch
+  
    A patch or some other easy procedure for fixing the $gBug is included in
+  the $gBug logs. If there\'s a patch, but it doesn\'t resolve the $gBug
+  adequately or causes some other problems, this tag should not be used.
+
+
    wontfix
+  
    This $gBug won\'t be fixed. Possibly because this is a choice between two
+  arbitrary ways of doing things and the maintainer and submitter prefer
+  different ways of doing things, possibly because changing the behaviour
+  will cause other, worse, problems for others, or possibly for other
+  reasons.
+
+
    moreinfo
+  
    This $gBug can\'t be addressed until more information is provided by the
+  submitter. The $gBug will be closed if the submitter doesn\'t provide more
+  information in a reasonable (few months) timeframe. This is for $gBugs like
+  \"It doesn\'t work\". What doesn\'t work?
+
+
    unreproducible
+  
    This $gBug can\'t be reproduced on the maintainer\'s system.  Assistance
+  from third parties is needed in diagnosing the cause of the problem.
+
+
    fixed
+  
    This $gBug is fixed or worked around, but there\'s still an issue that
+  needs to be resolved.
+
+
    stable
+  
    This $gBug affects the stable distribution in particular.  This is only
+  intended to be used for ease in identifying release critical $gBugs that
+  affect the stable distribution.  It\'ll be replaced eventually with
+  something a little more flexible, probably.
+";
+
+############################################################################
+# shows up at the start of (most) html pages.
+############################################################################
+$gHTMLStart = "";
+
+############################################################################
+# shows up at the end of (most) html pages.
+############################################################################
+$gHTMLTail = "
+ 
    $gMaintainer <$gMaintainerEmail>.
+ Last modified:
+ 
+ SUBSTITUTE_DTIME
+ 
+	  
+ 
    
+ Debian $gBug tracking system
    
+ Copyright (C) 1999 Darren O. Benham,
+ 1997,2003 nCipher Corporation Ltd,
+ 1994-97 Ian Jackson.
+ 
    
+";
+
+############################################################################
+# Message on when reports are purged.
+############################################################################
+$gHTMLExpireNote = "(Closed $gBugs are archived $gRemoveAge days after the last related message is received.)";
+
+############################################################################
+# Makeup of the stamp page
+############################################################################
+$gHTMLStamp = "
+	$gProject $gBugs - timestamp page
+	
+	$gHTMLStart
    Is this $gBug log or mirror up to date?
    
+
+	Unlike all the other $gBug pages, this small timestamp page is updated every
+	time the update check job runs.  If the timestamp here is recent it\'s
+	likely that the mirror in which you\'re reading it is up to date.
+	
    
+	The last
+	update
+	was at 
+	SUBSTITUTE_DTIME;
+	The logs are usually checked every hour and updated if necessary.
+	
    
+	For the $gBug index or for other information about $gProject and the $gBug 
+	system, see the $gBug system main contents page.
+
+	
    
+	
    
+	$gMaintainerEmail,
+	through the $gProject $gBug database
+	
    
+	";
+
+############################################################################
+# Makeup of the indices pages
+############################################################################
+$gFullIndex = "
+	$gProject $gBugs - full index
+	
+	$gHTMLStart
    $gProject $gBug report logs - index
    
+
+	This index gives access to $gBugs sent to submit\@$gEmailDomain
+	but not yet marked as done, and to $gBugs marked as done but not yet purged
+	from the database (this happens $gRemoveAge days after the last message relating to
+	the report).
+	
    
+	For other kinds of indices or for other information about $gProject and
+	the $gBug system, see $gBug system top-level contents WWW
+	page.
+
+
+	";
+
+$gJunkIndex = "
+	$gProject $gBug reports - Junk
+	
+	$gHTMLStart
    $gProject $gBug reports - Junk
    
+
+	This is the index page for logs of messages not associated with a specific
+	$gBug report.
+	
    
+	For other kinds of indices or for other information about $gProject and
+	the $gBug system, see $gBug system top-level contents WWW
+	page.
+
+
+	";
+
+$gMaintIndex = "
+	$gProject $gBug reports by maintainer
+	
+	$gHTMLStart
    $gProject $gBug reports by maintainer
    
+
+	This page lists the package maintainers against whose packages there are
+	outstanding, forwarded or recently-closed $gBug reports.  A maintainer who
+	has several versions of their email address in the Maintainer
+	package control file field may appear several times.
    
+	If the maintainers information here is not accurate, please see 
+	the developers\'
+	instructions to find how this can happen and what to do about it. 
    
+	For other kinds of indices or for other information about $gProject and
+	the $gBug system, see $gBug system top-level contents WWW
+	page.
+
+
+	";
+
+$gPackageIndex = "
+	$gProject $gBug reports by package
+	
+	$gHTMLStart
    $gProject $gBug reports by package
    
+
+	This page lists the package against which there are outstanding, forwarded or
+	recently-closed $gBug reports.  A multi-binary package may appear several
+	times, once for each binary package name and once for the source package
+	name (if it is different).
    
+	For other kinds of indices or for other information about $gProject and
+	the $gBug system, see $gBug system top-level contents WWW
+	page.
+
+
+	";
+
+$gSummaryIndex = "
+	$gProject $gBug report logs - summary index
+	
+	$gHTMLStart
    $gProject $gBug report logs - summary index
    
+
+	This summary index briefly lists $gBugs sent to submit\@$gEmailDomain
+	 but not yet marked as done, or as forwarded to an upstream author.  
+	Here they are sorted by reference number (and therefore by submission date, 
+	too).
    
+	For other kinds of indices or for other information about $gProject and
+	the $gBug system, see $gBug system top-level contents WWW
+	page.
+
+	
    The * column lists the first letter of the severity of the $gBug.
+
+
+	";
+
+$gPackageLog = "
+	$gProject $gBug report logs - index by package
+	
+	$gHTMLStart
    $gProject $gBug report logs - index by package
    
+
+	This summary index briefly lists $gBugs sent to submit\@$gEmailDomain
+	 but not yet marked as done, or as forwarded to an upstream author.  
+	Here they are sorted by package name.
    
+	For other kinds of indices or for other information about $gProject and
+	the $gBug system, see $gBug system top-level contents WWW
+	page.
+
+
+	";
+
+$gPseudoIndex = "
+	$gProject $gBug report pseudo-packages
+	
+	$gHTMLStart
    $gProject $gBug report pseudo-packages
    
+
+	This page lists the pseudo-packages available for use in the
+	Package: line in $gBug reports.
    
+
+	See the instructions for reporting a
+	$gBug for details of how to specify a Package: line.
    
+	For other kinds of indices or for other information about $gProject and
+	the $gBug system, see $gBug system top-level contents WWW
+	page.
+
+
+	";
diff --git a/scripts/text.in b/scripts/text.in
deleted file mode 100644
index 415aba0..0000000
--- a/scripts/text.in
+++ /dev/null
@@ -1,342 +0,0 @@
-# -*- mode: cperl -*-
-
-use Debbugs::Config qw(:globals);
-
-############################################################################
-#  Here is a blurb to point people to ftp archive of directions.  It is
-#  used by the receive script when bouncing a badly formatted email
-#
-# $gTextInstructions = "$gBadEmailPrefix
-# $gBadEmailPrefix Instructions are available from ftp.debian.org in /debian
-# $gBadEmailPrefix and at all Debian mirror sites, in the files:
-# $gBadEmailPrefix  doc/bug-reporting.txt
-# $gBadEmailPrefix  doc/bug-log-access.txt
-# $gBadEmailPrefix  doc/bug-maint-info.txt
-# $gBadEmailPrefix";
-############################################################################
-$gBadEmailPrefix = '' unless defined $gBadEmailPrefix;
-$gTextInstructions = "$gBadEmailPrefix";
-
-
-############################################################################
-# Here is a blurb for any mirrors of the web site.  Here's a sample:
-#
-#$gHTMLCopies = "
    Copies of the logs are available on the World Wide Web at
    
-# http://mirror1.domain
    
-# http://mirror2.domain";
-############################################################################
-$gHTMLCopies = "";
-
-
-############################################################################
-# notice other links you want to note, like your list archives or project
-# home page.
-#
-#$gHTMLOtherPages = "Other Links of note:
    
-#	The Debian Project
    
-#	Description of URL";
-############################################################################
-$gHTMLOtherPages = "";
-
-
-############################################################################
-# list of other links you want to note, like your list archives or project
-# home page.  Some pages already have links in a list, this adds them to 
-# the end of the list.
-#
-#$gHTMLOtherPageList = "
  • 
-#	The Debian Project
-#	
  • Description of URL";
-############################################################################
-$gHTMLOtherPageList = "";
-
-
-############################################################################
-# gives explanation of bad maintainer situation and instructions on how to
-# correct.
-############################################################################
-$gBadMaintHtml = "";
-
-
-############################################################################
-# give directions here for how to find the proper title for Package:
-# pseudo header line.
-############################################################################
-$gHTMLFindPackage = "";
-
-
-############################################################################
-# If you have pseudo packages, place a blurb here.  For example:
-# $gHTMLPseudoDesc = "
    There are some pseudo-packages available for putting in
-# the Package line when reporting a $gBug in something other than an
-# actual $gProject software package.  There is 
-#  a list of these on the $gBugs WWW 
-# pages.";
-############################################################################
-$gHTMLPseudoDesc = "";
-
-
-############################################################################
-# List any extra information you would like included in bug reports. For
-# example:
-# $gXtraBugInfo = "
  • What kernel version you're using (type
-# uname -a), your shared C library (type ls -l
-# /lib/libc.so.6 or dpkg -s libc6 | grep ^Version), and
-# any other details about your Debian system, if it seems appropriate.
-# For example, if you had a problem with a Perl script, you would want to
-# provide the version of the `perl' binary (type perl -v or
-# dpkg -s perl-5.005 | grep ^Version:).";
-############################################################################
-$gXtraBugInfo = "";
-
-
-############################################################################
-# List any extra information you would like about reporting bugs
-############################################################################
-$gXtraReportingInfo = "";
-
-
-############################################################################
-# Process used by system to create Maintainers index file
-############################################################################
-$gCreateMaintainers = "";
-
-
-###########################################################################
-# You shouldn't have to modify anything below here unless it's for personal
-# preference.  Be very careful and don't touch unless you *know* what
-# you're doing.  Much of the stuff has hardcoded duplicates elsewhere.
-
-
-############################################################################
-# Description of the severities
-############################################################################
-$gHTMLSeverityDesc = "
    critical
-	
    makes unrelated software on the system (or the whole system) break,
-	or causes serious data loss, or introduces a security hole on systems 
-	where you install the package.
-
-	
    grave
-	
    makes the package in question unusable or mostly so, or causes data
-	loss, or introduces a security hole allowing access to the accounts of
-	users who use the package.
-
-	
    normal
-	
    the default value, for normal $gBugs.
-
-	
    wishlist
-	
    for any feature request, and also for any $gBugs that are very 
-	difficult to fix due to major design considerations.";
-
-############################################################################
-# Description of the tags
-############################################################################
-$gHTMLTagDesc = "
-
    patch
-  
    A patch or some other easy procedure for fixing the $gBug is included in
-  the $gBug logs. If there\'s a patch, but it doesn\'t resolve the $gBug
-  adequately or causes some other problems, this tag should not be used.
-
-
    wontfix
-  
    This $gBug won\'t be fixed. Possibly because this is a choice between two
-  arbitrary ways of doing things and the maintainer and submitter prefer
-  different ways of doing things, possibly because changing the behaviour
-  will cause other, worse, problems for others, or possibly for other
-  reasons.
-
-
    moreinfo
-  
    This $gBug can\'t be addressed until more information is provided by the
-  submitter. The $gBug will be closed if the submitter doesn\'t provide more
-  information in a reasonable (few months) timeframe. This is for $gBugs like
-  \"It doesn\'t work\". What doesn\'t work?
-
-
    unreproducible
-  
    This $gBug can\'t be reproduced on the maintainer\'s system.  Assistance
-  from third parties is needed in diagnosing the cause of the problem.
-
-
    fixed
-  
    This $gBug is fixed or worked around, but there\'s still an issue that
-  needs to be resolved.
-
-
    stable
-  
    This $gBug affects the stable distribution in particular.  This is only
-  intended to be used for ease in identifying release critical $gBugs that
-  affect the stable distribution.  It\'ll be replaced eventually with
-  something a little more flexible, probably.
-";
-
-############################################################################
-# shows up at the start of (most) html pages.
-############################################################################
-$gHTMLStart = "";
-
-############################################################################
-# shows up at the end of (most) html pages.
-############################################################################
-$gHTMLTail = "
- 
    $gMaintainer <$gMaintainerEmail>.
- Last modified:
- 
- SUBSTITUTE_DTIME
- 
-	  
- 
    
- Debian $gBug tracking system
    
- Copyright (C) 1999 Darren O. Benham,
- 1997,2003 nCipher Corporation Ltd,
- 1994-97 Ian Jackson.
- 
    
-";
-
-############################################################################
-# Message on when reports are purged.
-############################################################################
-$gHTMLExpireNote = "(Closed $gBugs are archived $gRemoveAge days after the last related message is received.)";
-
-############################################################################
-# Makeup of the stamp page
-############################################################################
-$gHTMLStamp = "
-	$gProject $gBugs - timestamp page
-	
-	$gHTMLStart
    Is this $gBug log or mirror up to date?
    
-
-	Unlike all the other $gBug pages, this small timestamp page is updated every
-	time the update check job runs.  If the timestamp here is recent it\'s
-	likely that the mirror in which you\'re reading it is up to date.
-	
    
-	The last
-	update
-	was at 
-	SUBSTITUTE_DTIME;
-	The logs are usually checked every hour and updated if necessary.
-	
    
-	For the $gBug index or for other information about $gProject and the $gBug 
-	system, see the $gBug system main contents page.
-
-	
    
-	
    
-	$gMaintainerEmail,
-	through the $gProject $gBug database
-	
    
-	";
-
-############################################################################
-# Makeup of the indices pages
-############################################################################
-$gFullIndex = "
-	$gProject $gBugs - full index
-	
-	$gHTMLStart
    $gProject $gBug report logs - index
    
-
-	This index gives access to $gBugs sent to submit\@$gEmailDomain
-	but not yet marked as done, and to $gBugs marked as done but not yet purged
-	from the database (this happens $gRemoveAge days after the last message relating to
-	the report).
-	
    
-	For other kinds of indices or for other information about $gProject and
-	the $gBug system, see $gBug system top-level contents WWW
-	page.
-
-
-	";
-
-$gJunkIndex = "
-	$gProject $gBug reports - Junk
-	
-	$gHTMLStart
    $gProject $gBug reports - Junk
    
-
-	This is the index page for logs of messages not associated with a specific
-	$gBug report.
-	
    
-	For other kinds of indices or for other information about $gProject and
-	the $gBug system, see $gBug system top-level contents WWW
-	page.
-
-
-	";
-
-$gMaintIndex = "
-	$gProject $gBug reports by maintainer
-	
-	$gHTMLStart
    $gProject $gBug reports by maintainer
    
-
-	This page lists the package maintainers against whose packages there are
-	outstanding, forwarded or recently-closed $gBug reports.  A maintainer who
-	has several versions of their email address in the Maintainer
-	package control file field may appear several times.
    
-	If the maintainers information here is not accurate, please see 
-	the developers\'
-	instructions to find how this can happen and what to do about it. 
    
-	For other kinds of indices or for other information about $gProject and
-	the $gBug system, see $gBug system top-level contents WWW
-	page.
-
-
-	";
-
-$gPackageIndex = "
-	$gProject $gBug reports by package
-	
-	$gHTMLStart
    $gProject $gBug reports by package
    
-
-	This page lists the package against which there are outstanding, forwarded or
-	recently-closed $gBug reports.  A multi-binary package may appear several
-	times, once for each binary package name and once for the source package
-	name (if it is different).
    
-	For other kinds of indices or for other information about $gProject and
-	the $gBug system, see $gBug system top-level contents WWW
-	page.
-
-
-	";
-
-$gSummaryIndex = "
-	$gProject $gBug report logs - summary index
-	
-	$gHTMLStart
    $gProject $gBug report logs - summary index
    
-
-	This summary index briefly lists $gBugs sent to submit\@$gEmailDomain
-	 but not yet marked as done, or as forwarded to an upstream author.  
-	Here they are sorted by reference number (and therefore by submission date, 
-	too).
    
-	For other kinds of indices or for other information about $gProject and
-	the $gBug system, see $gBug system top-level contents WWW
-	page.
-
-	
    The * column lists the first letter of the severity of the $gBug.
-
-
-	";
-
-$gPackageLog = "
-	$gProject $gBug report logs - index by package
-	
-	$gHTMLStart
    $gProject $gBug report logs - index by package
    
-
-	This summary index briefly lists $gBugs sent to submit\@$gEmailDomain
-	 but not yet marked as done, or as forwarded to an upstream author.  
-	Here they are sorted by package name.
    
-	For other kinds of indices or for other information about $gProject and
-	the $gBug system, see $gBug system top-level contents WWW
-	page.
-
-
-	";
-
-$gPseudoIndex = "
-	$gProject $gBug report pseudo-packages
-	
-	$gHTMLStart
    $gProject $gBug report pseudo-packages
    
-
-	This page lists the pseudo-packages available for use in the
-	Package: line in $gBug reports.
    
-
-	See the instructions for reporting a
-	$gBug for details of how to specify a Package: line.
    
-	For other kinds of indices or for other information about $gProject and
-	the $gBug system, see $gBug system top-level contents WWW
-	page.
-
-
-	";
diff --git a/t/06_mail_handling.t b/t/06_mail_handling.t
index f83eabb..ccf1ee7 100644
--- a/t/06_mail_handling.t
+++ b/t/06_mail_handling.t
@@ -228,6 +228,7 @@ while (my ($command,$control_command) = splice(@control_commands,0,2)) {
 			      Subject => "Munging a bug with $command",
 			     ],
 		  body => <{command} 1$control_command->{value}
 thanks
 EOF
diff --git a/t/07_bugreport.t b/t/07_bugreport.t
index dedd445..78fbdc7 100644
--- a/t/07_bugreport.t
+++ b/t/07_bugreport.t
@@ -74,7 +74,8 @@ my $mech = Test::WWW::Mechanize->new();
 
 $mech->get_ok('http://localhost:'.$port.'/?bug=1',
 	      'Page received ok');
-ok($mech->content() =~ qr/\\#1\s+\-\s+Submitting a bug/i,
+ok($mech->content() =~ qr/\\#1.+Submitting a bug/i,
    'Title of bug is submitting a bug');
 
 # Other tests for bugs in the page should be added here eventually
+
diff --git a/t/09_soap.t b/t/09_soap.t
index 3154a08..2a04c60 100644
--- a/t/09_soap.t
+++ b/t/09_soap.t
@@ -6,13 +6,6 @@ use Test::More tests => 4;
 use warnings;
 use strict;
 
-# Here, we're going to shoot messages through a set of things that can
-# happen.
-
-# First, we're going to send mesages to receive.
-# To do so, we'll first send a message to submit,
-# then send messages to the newly created bugnumber.
-
 use IO::File;
 use File::Temp qw(tempdir);
 use Cwd qw(getcwd);
@@ -32,7 +25,7 @@ if ($@) {
      BAIL_OUT($@);
 }
 
-# Output some debugging information if there's an error
+# Output some debugging information if we're debugging
 END{
      if ($ENV{DEBUG}) {
 	  foreach my $key (keys %config) {
@@ -55,7 +48,7 @@ This is a silly bug
 EOF
 
 
-# test bugreport.cgi
+# test the soap server
 
 my $port = 11343;
 
@@ -69,8 +62,10 @@ our $child_pid = undef;
 
 END{
      if (defined $child_pid) {
+	  my $temp_exit = $?;
 	  kill(15,$child_pid);
 	  waitpid(-1,0);
+	  $? = $temp_exit;
      }
 }
 
diff --git a/t/lib/DebbugsTest.pm b/t/lib/DebbugsTest.pm
index 5d04848..580c41d 100644
--- a/t/lib/DebbugsTest.pm
+++ b/t/lib/DebbugsTest.pm
@@ -151,16 +151,16 @@ sub send_message{
      my $output='';
      local $SIG{PIPE} = 'IGNORE';
      local $SIG{CHLD} = sub {};
-     my $pid = open3($wfd,$rfd,$rfd,'scripts/receive.in')
-	  or die "Unable to start receive.in: $!";
+     my $pid = open3($wfd,$rfd,$rfd,'scripts/receive')
+	  or die "Unable to start receive: $!";
      print {$wfd} create_mime_message($param{headers},
-					 $param{body}) or die "Unable to to print to receive.in";
-     close($wfd) or die "Unable to close receive.in";
+					 $param{body}) or die "Unable to to print to receive";
+     close($wfd) or die "Unable to close receive";
      my $err = $? >> 8;
      my $childpid = waitpid($pid,0);
      if ($childpid != -1) {
 	  $err = $? >> 8;
-	  print STDERR "receive.in pid: $pid doesn't match childpid: $childpid\n" if $childpid != $pid;
+	  print STDERR "receive pid: $pid doesn't match childpid: $childpid\n" if $childpid != $pid;
      }
      if ($err != 0 ) {
 	  my $rfh =  IO::Handle->new_from_fd($rfd,'r') or die "Unable to create filehandle: $!";
@@ -171,11 +171,11 @@ sub send_message{
 	       print STDERR "Reading from STDOUT/STDERR would have blocked.";
 	  }
 	  print STDERR $output,qq(\n);
-	  die "receive.in failed with exit status $err";
+	  die "receive failed with exit status $err";
      }
      # now we should run processall to see if the message gets processed
      if ($param{run_processall}) {
-	  system('scripts/processall.in') == 0 or die "processall.in failed";
+	  system('scripts/processall') == 0 or die "processall failed";
      }
 }
 
@@ -190,8 +190,10 @@ sub send_message{
      END {
 	  if (defined $child_pid) {
 	       # stop the child
+	       my $temp_exit = $?;
 	       kill(15,$child_pid);
 	       waitpid(-1,0);
+	       $? = $temp_exit;
 	  }
      }
 
diff --git a/templates/en_US/cgi/bugreport.tmpl b/templates/en_US/cgi/bugreport.tmpl
new file mode 100644
index 0000000..57cf044
--- /dev/null
+++ b/templates/en_US/cgi/bugreport.tmpl
@@ -0,0 +1,48 @@
+{include(q(html/pre_title))}#{$bug_num} - {html_escape($status{subject})} - {html_escape($config{project})} {html_escape($config{bug})} report logs{include(q(html/post_title.tmpl))}
+
+
+
+
    {html_escape($config{project})} {html_escape($config{bug})} report logs - 
+#{$bug_num}
    
+{html_escape($status{subject})}
    
+
    {$version_graph}
    
+{include(q(cgi/bugreport_pkginfo))}
+{include(q(cgi/bugreport_buginfo))}
+{ my $output = '';
+  if (looks_like_number($msg)) {
+     $output .= sprintf qq(
    Full log
    ),html_escape(bug_links(bug=>$ref,links_only=>1));
+  }
+  else {
+     $output .=  qq(
    Reply ).
+	  qq(or subscribe ).
+	       qq(to this bug.
    \n);
+     $output .=  qq(
    Toggle useless messages
    );
+     $output .= sprintf qq(
    View this report as an mbox folder, ).
+	  qq(status mbox, maintainer mbox
    \n),
+	       html_escape(bug_links(bug=>$bug_num, links_only=>1,options=>{mbox=>'yes'})),
+		    html_escape(bug_links(bug=>$bug_num, links_only=>1,options=>{mbox=>'yes',mboxstatus=>'yes'})),
+			 html_escape(bug_links(bug=>$bug_num, links_only=>1,options=>{mbox=>'yes',mboxmaint=>'yes'}));
+  }
+  $output;
+}
+{$log}
+
    
+
    Send a report that this bug log contains spam.
    
+
    
+{include(q(html/html_tail))}
+
+
diff --git a/templates/en_US/cgi/bugreport_buginfo.tmpl b/templates/en_US/cgi/bugreport_buginfo.tmpl
new file mode 100644
index 0000000..6bd16e0
--- /dev/null
+++ b/templates/en_US/cgi/bugreport_buginfo.tmpl
@@ -0,0 +1,62 @@
+
    
+  
    Reported by: {package_links(submitter=>$status{originator})}
    
+  
    Date: {$status{date_text}}
    
+{ my $output = ''; 
+  if (defined $status{owner} and length $status{owner}) {
+     $output = q(
    Owned by: ).package_links(owner=>$status{owner}).q(
    );
+  }
+  $output;
+}
+
    Severity: {my $output = $status{severity};
+              if (isstrongseverity($status{severity})) {
+                   $output = q().$status{severity}.q();
+              }
+              $output;
+             }
    
+
    {@{$status{tags_array}}?q(Tags: ).html_escape(join(q(, ),@{$status{tags_array}})):''}
    
+{my $output = '';
+ if (@{$status{mergedwith_array}}) {
+    $output .= q(
    Merged with ).join(qq(,\n),bug_links(bug=>$status{mergedwith_array})).qq(
    \n);
+ }
+ $output;
+}
+{my $output = '';
+ if (@{$status{found_versions}}) {
+    $output .= q(
    Found in );
+    $output .= (@{$status{found_versions}} == 1) ? 'version ' : 'versions ';
+    $output .= join(qq(, ),map {html_escape($_);} @{$status{found_versions}}).qq(
    \n);
+ }
+ if (@{$status{fixed_versions}}) {
+    $output .= q(
    Fixed in );
+    $output .= (@{$status{fixed_versions}} == 1) ? 'version ' : 'versions ';
+    $output .= join(qq(, ),map {html_escape($_);} @{$status{fixed_versions}}).qq(
    \n);
+ }
+ $output;
+}
+{ my $output = '';
+  if (length($status{done})) {
+     $output .= q(
    Done: ).html_escape($status{done}).q(
    )
+  }
+  $output;
+}
+{ my $output = '';
+  if (@{$status{blockedby_array}}) {
+     $output .= q(
    Fix blocked by ).
+        join(q(, ),
+         map {bug_links(bug=>$_->{bug_num}).q(: ).html_escape($_->{subject})}
+         @{$status{blockedby_array}}).q(
    )
+  }
+  if (@{$status{blocks_array}}) {
+     $output .= q(
    Blocking fix for ).
+        join(q(, ),
+         map {bug_links(bug=>$_->{bug_num}).q(: ).html_escape($_->{subject})}
+         @{$status{blocks_array}}).q(
    )
+  }
+  $output;
+}
+{ my $output = '';
+  if (exists $status{archived} and $status{archived}) {
+     $output .= q(
    Bug is archived. No further changes may be made.
    )
+  }
+  $output
+}
    
diff --git a/templates/en_US/cgi/bugreport_pkginfo.tmpl b/templates/en_US/cgi/bugreport_pkginfo.tmpl
new file mode 100644
index 0000000..22806f7
--- /dev/null
+++ b/templates/en_US/cgi/bugreport_pkginfo.tmpl
@@ -0,0 +1,16 @@
+
    
+  
    {if (keys %package > 1) { q(Packages)} else {q(Package)}}:
+     {join(q(, ),package_links(package => [map {$_->{package}} values %package],
+                               class => q(submitter),
+                              )
+          )};
+{my $output ='';
+ for my $package (values %package) {
+     $output .= q(Maintainer for ).package_links(package=>$package->{package}).qq( is ).
+                package_links(maintainer => $package->{maintainer}).qq(; );
+     $output .= q(Source for ).package_links(package=>$package->{package}).qq( is ).
+                package_links(source => $package->{source}).qq(. );
+ }
+ $output;
+}
    
+
    
diff --git a/templates/en_US/cgi/no_such_bug.tmpl b/templates/en_US/cgi/no_such_bug.tmpl
new file mode 100644
index 0000000..107f9f2
--- /dev/null
+++ b/templates/en_US/cgi/no_such_bug.tmpl
@@ -0,0 +1,9 @@
+
+
+#{$bug_num} - {$config{project}} {$config{bug}} report logs
+
+
    {$config{project}} {$config{bug}} report logs - #{$bug_num}
    
+
    There is no record of {$config{bug}} #{$bug_num}.
+Try the search page instead.
    
+{include('html/tail')}
+
diff --git a/templates/en_US/cgi/pkgreport_javascript.tmpl b/templates/en_US/cgi/pkgreport_javascript.tmpl
new file mode 100644
index 0000000..f801df9
--- /dev/null
+++ b/templates/en_US/cgi/pkgreport_javascript.tmpl
@@ -0,0 +1,128 @@
+
diff --git a/templates/en_US/cgi/pkgreport_options.tmpl b/templates/en_US/cgi/pkgreport_options.tmpl
new file mode 100644
index 0000000..7fa264a
--- /dev/null
+++ b/templates/en_US/cgi/pkgreport_options.tmpl
@@ -0,0 +1,83 @@
+
    
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
    Select bugs
    
+    		
+{ my $output = '';
+our $value_index = 0;
+our $search = '';
+our $search_value = '';
+for my $key (@search_key_order){
+   if (exists $param{$key}){
+        for my $value (make_list($param{$key})){
+           $search = $key;
+	   $search_value = $value;
+      	   $output .= include('cgi/pkgreport_options_search_key');
+	   $output .= '
    ';
+	   $value_index++;
+        }
+   }
+ }
+ $search = '';
+ $search_value = '';
+ $output;
+}
+{include('cgi/pkgreport_options_search_key')}
+    		
+
    The same search fields are ORed, different fields are ANDed.
    
+
    Valid severities are {$config{show_severities}}
    
+
    Valid tags are {join(', ',@{$config{tags}})}
    
+
    Include Bugs
    		{our $incexc = 'include';
+include('cgi/pkgreport_options_include_exclude');
+}
    Exclude Bugs
    		
+{our $incexc = 'exclude';
+include('cgi/pkgreport_options_include_exclude');
+}
+
    Categorize using
    Order by
    Misc options
    		
+ Repeat Merged
    
+ Reverse Bugs
    
+ Reverse Pending
    
+ Reverse Severity
    
+
    
+Toggle all extra information
+
    Submit
    		
+
+
    
+
+
diff --git a/templates/en_US/cgi/pkgreport_options_include_exclude.tmpl b/templates/en_US/cgi/pkgreport_options_include_exclude.tmpl
new file mode 100644
index 0000000..c0f8acd
--- /dev/null
+++ b/templates/en_US/cgi/pkgreport_options_include_exclude.tmpl
@@ -0,0 +1,16 @@
+
+{ my $output = '';
+  our $value_index = 0;
+  our $key1 = '';
+  our $key2 = '';
+  for my $field (make_list($param{$incexc})) {
+    ($key1,$key2) = $field =~ m/^([^:]+)\:(.+)/;
+    next unless defined $key2;
+    $output .= include('cgi/pkgreport_options_include_exclude_key');
+  }
+  $key1 = '';
+  $key2 = '';
+  $output .= include('cgi/pkgreport_options_include_exclude_key');
+  $output;
+}
+
diff --git a/templates/en_US/cgi/pkgreport_options_include_exclude_key.tmpl b/templates/en_US/cgi/pkgreport_options_include_exclude_key.tmpl
new file mode 100644
index 0000000..da67c30
--- /dev/null
+++ b/templates/en_US/cgi/pkgreport_options_include_exclude_key.tmpl
@@ -0,0 +1,14 @@
+
+
+
+
diff --git a/templates/en_US/cgi/pkgreport_options_search_key.tmpl b/templates/en_US/cgi/pkgreport_options_search_key.tmpl
new file mode 100644
index 0000000..1c2ecd9
--- /dev/null
+++ b/templates/en_US/cgi/pkgreport_options_search_key.tmpl
@@ -0,0 +1,6 @@
+
+
+
+
diff --git a/templates/en_US/cgi/quit.tmpl b/templates/en_US/cgi/quit.tmpl
new file mode 100644
index 0000000..2a89d8e
--- /dev/null
+++ b/templates/en_US/cgi/quit.tmpl
@@ -0,0 +1,6 @@
+
+Error
+
+An error occurred.
+Error was: {$msg}
+
diff --git a/templates/en_US/cgi/short_bug_status.tmpl b/templates/en_US/cgi/short_bug_status.tmpl
new file mode 100644
index 0000000..94392d6
--- /dev/null
+++ b/templates/en_US/cgi/short_bug_status.tmpl
@@ -0,0 +1,138 @@
+
    
+  #{html_escape($status{bug_num})}
+  [{
+  my $output = qq();
+  my $temp = $status{severity};
+  $temp = substr $temp,0,1;
+  if (isstrongseverity($status{severity})){
+     $temp = q().uc($temp).q();
+  $output;
+  }|{
+  my $output = '';
+  for my $tag (@{$status{tags_array}}) {
+     next unless exists $config{tags_single_letter}{$tag};
+     $output .= q().$config{tags_single_letter}{$tag}.q();
+  }
+  $output;
+  }|{
+  my $output = '';
+  if (@{$status{mergedwith_array}}) {
+     $output .= qq(=);
+  }
+  if (@{$status{fixed_versions}}) {
+     $output .= qq(☺);
+  }
+  if (@{$status{blockedby_array}}) {
+     $output .= qq(┫);
+  }
+  if (@{$status{blocks_array}}) {
+     $output .= qq(┣);
+  }
+  if (length($status{forwarded})) {
+     $output .= qq(↝);
+  }
+  if ($status{archived}) {
+     $output .= qq(♲);
+  }
+  $output;
+  }]
+  [{package_links(package=>$status{package},options=>\%options,class=>"submitter")}]
+  {html_escape($status{subject})}
+  
    
+  Reported by: {package_links(submitter=>$status{originator})};
+  Date: {$status{date_text}};
+{ my $output = ''; 
+  if (defined $status{owner} and length $status{owner}) {
+     $output = q(Owned by: ).package_links(owner=>$status{owner}).q(;);
+  }
+  $output;
+}
+Severity: {my $output = $status{severity};
+              if (isstrongseverity($status{severity})) {
+                   $output = q().$status{severity}.q();
+              }
+              $output;
+             };
+{@{$status{tags_array}}?q(Tags: ).html_escape(join(q(, ),@{$status{tags_array}})).';':''}
+{my $output = '';
+ if (@{$status{mergedwith_array}}) {
+    $output .= q(Merged with ).join(qq(,\n),bug_links(bug=>$status{mergedwith_array})).qq(;\n);
+ }
+ $output;
+}
+{my $output = '';
+ if (@{$status{found_versions}} or @{$status{fixed_versions}}) {
+    $output .= 'Found in );
+    $output .= (@{$status{found_versions}} == 1) ? 'version ' : 'versions ';
+    $output .= join(qq(, ),map {html_escape($_);} @{$status{found_versions}}).qq(;\n);
+ }
+ if (@{$status{fixed_versions}}) {
+    $output .= q(Fixed in );
+    $output .= (@{$status{fixed_versions}} == 1) ? 'version ' : 'versions ';
+    $output .= join(qq(, ),map {html_escape($_);} @{$status{fixed_versions}}).qq(;\n);
+ }
+ if (@{$status{found_versions}} or @{$status{fixed_versions}}) {
+    $output .= qq();
+ }
+ $output;
+}
+{ my $output = '';
+  if (length($status{done})) {
+     $output .= q(Done: ).html_escape($status{done}).q(; )
+  }
+  $output;
+}
+{ my $output = '';
+  if (@{$status{blockedby_array}}) {
+     $output .= q(Fix blocked by ).
+        join(q(, ),
+         map {bug_links(bug=>$_->{bug_num}).q(: ).html_escape($_->{subject})}
+         @{$status{blockedby_array}}).q(; )
+  }
+  if (@{$status{blocks_array}}) {
+     $output .= q(Blocking fix for ).
+        join(q(, ),
+         map {bug_links(bug=>$_->{bug_num}).q(: ).html_escape($_->{subject})}
+         @{$status{blocks_array}}).q(; )
+  }
+  $output;
+}{ my $output = '';
+ my ($days_last,$eng_last) = secs_to_english(time - $status{log_modified});
+ my ($days,$eng) = secs_to_english(time - $status{date});
+
+ if ($days >= 7) {
+   my $font = "";
+   my $efont = "";
+   $font = "em" if ($days > 30);
+   $font = "strong" if ($days > 60);
+   $efont = "" if ($font);
+   $font = "<$font>" if ($font);
+
+   $output .= "${font}Filed $eng ago$efont;\n";
+ }
+ if ($days_last > 7) {
+   my $font = "";
+   my $efont = "";
+   $font = "em" if ($days_last > 30);
+   $font = "strong" if ($days_last > 60);
+   $efont = "" if ($font);
+   $font = "<$font>" if ($font);
+
+   $output .= "${font}Modified $eng_last ago$efont;\n";
+ }
+ $output;
+ }{ my $output = '';
+  if (exists $status{archived} and $status{archived}) {
+     $output .= q(Bug is archived. No further changes may be made. )
+  }
+  $output}
    
+
    
diff --git a/templates/en_US/html/html_tail.tmpl b/templates/en_US/html/html_tail.tmpl
new file mode 100644
index 0000000..d7eb979
--- /dev/null
+++ b/templates/en_US/html/html_tail.tmpl
@@ -0,0 +1,11 @@
+
    {$config{maintainer}} <{$config{maintainer_email}}>.
+Last modified:
+
+{$last_modified||strftime('%c',gmtime)}
+
+
    
+{$config{project}} {$config{bug}} tracking system
    
+Copyright (C) 1999 Darren O. Benham,
+1997,2003 nCipher Corporation Ltd,
+1994-97 Ian Jackson.
+
    
diff --git a/templates/en_US/html/post_title.tmpl b/templates/en_US/html/post_title.tmpl
new file mode 100644
index 0000000..169d161
--- /dev/null
+++ b/templates/en_US/html/post_title.tmpl
@@ -0,0 +1,3 @@
+
+
+
diff --git a/templates/en_US/html/pre_title.tmpl b/templates/en_US/html/pre_title.tmpl
new file mode 100644
index 0000000..2f7ab77
--- /dev/null
+++ b/templates/en_US/html/pre_title.tmpl
@@ -0,0 +1,3 @@
+
+
+
\ No newline at end of file