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)
# 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)
# 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
--- /dev/null
+#!/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
+++ /dev/null
-#!/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
--- /dev/null
+# -*- 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;
+++ /dev/null
-# -*- 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;
--- /dev/null
+#!/usr/bin/perl
+# $Id: db2html.in,v 1.22 2004/04/19 10:03:53 cjwatson Exp $
+# usage: db2html [-diff] [-stampfile=<stampfile>] [-lastrun=<days>] <wwwbase>
+
+#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',$_."</body></html>\n");
+ print "noremoves";
+# print "db2html: no changes since last run\n";
+ exit 0;
+}
+
+#parse maintainer file
+open(MM,"$gMaintainerFile") || &quit("open $gMaintainerFile: $!");
+while(<MM>)
+{ 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 <code>done\@$gEmailDomain</code>\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 <code>request@$gEmailDomain</code> (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= "<strong>Severity: $data->{severity}</strong>;\n";
+ $addseverity= $data->{severity};
+ } else
+ { $showseverity= "Severity: <em>$data->{severity}</em>;\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: <A href=\"../$packfile\"><strong>".
+ &sani($data->{package})."</strong></A>;\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."<A href=\"../$mfile.html\">#$m</A>";
+ $mseparator= ",\n";
+ }
+ }
+ $daysold=$submitted='';
+ if (length($data->{done}))
+ { $indexentry .= ";\n<strong>Done:</strong> ".&sani($data->{done});
+ $indexpart= "done$addseverity";
+ } elsif (length($data->{forwarded}))
+ { $indexentry .= ";\n<strong>Forwarded</strong> 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 .= "</pre><h2>$msg:</h2><pre>\n$shorthead\n";
+ $amonths= $cmonths;
+ }
+ $pad= 6-length(sprintf("%d",$f));
+ $thissient=
+ ($pad>0 ? ' 'x$pad : '').
+ sprintf("<A href=\"../%s.html\">%d</A>",$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>" : '';
+ $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".
+ '<A href="../ma/l'.&maintencoded($tmaint).'.html">'.&sani($tmaint).'</A>.';
+ $indexentry .= $daysold;
+ $indexentry .= ".";
+ }
+ $indexadd='';
+ $indexadd .= "<!--iid $iiref-->" if defined($iiref);
+ $indexadd .= "<li><A href=\"../$linkto.html\">".$indexlink."</A>";
+ $indexadd .= "<br>\n".$indexentry if length($indexentry);
+ $indexadd .= "<!--/iid-->" 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= "<!--ii $iiref-->\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(<L>) {
+ 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 .= "</pre>\n" if $normstate eq 'go' || $normstate eq 'go-nox';
+ if ($normstate eq 'html') {
+ $xmessage++;
+ $this .= " <em><A href=\"../$linkto-b.html#m$xmessage\">Full text</A>".
+ " available.</em>";
+ }
+ if ($suppressnext && $normstate ne 'html') {
+ $ntis= $this; $ntis =~ s:\<pre\>:</A><pre>:i;
+ $boring .= "<hr><A name=\"m$xmessage\">\n$ntis\n";
+ } else {
+ $log = $this. "<hr>\n". $log;
+ }
+ $suppressnext= $normstate eq 'html';
+ $normstate= 'kill-end';
+ } elsif (m/^\05$/) {
+ $normstate eq 'kill-body' || &quit("^E in state $normstate");
+ $this .= "<pre>\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 = "<h2>Message received at ".&sani("$1\@$2").":</h2><br>\n".
+ "<pre>\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 = "<h2>Message sent:</h2><br>\n";
+ } else {
+ s/\04/, /g; s/\n$//;
+ $this = "<h2>Message sent to ".&sani($_).":</h2><br>\n";
+ }
+ $normstate= 'kill-body';
+ } elsif ($normstate eq 'autocheck') {
+ next if !m/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
+ $normstate= 'autowait';
+ $this = "<h2>Message received at $2:</h2><br>\n";
+ } elsif ($normstate eq 'autowait') {
+ next if !m/^$/;
+ $normstate= 'go-nox';
+ $this .= "<pre>\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',
+ "<html><head><title>$gProject $gBug report logs - ".
+ "$short, boring messages</title>\n".
+ "<link rev=\"made\" href=\"mailto:$gMaintainerEmail)\">\n".
+ "</head>$gHTMLStart<h1>$gProject $gBugreport logs -".
+ "\n <A href=\"../$linkto.html\">$short</A>,".
+ " boring messages</h1>\n$boring\n<hr>\n".
+ $tail_html."</body></html>\n");
+ }
+ &file("$linkto.html",'non',
+ "<html><head><title>$gProject $gBug report logs - ".
+ "$short</title>\n".
+ "<link rev=\"made\" href=\"mailto:$gMaintainerEmail\">\n".
+ "</head>$gHTMLStart<h1>$gProject $gBug report logs - $short<br>\n".
+ &sani($data->{subject})."</h1>".
+ "$descriptivehead\n".
+ "\n<hr>\n".
+ $log.
+ $tail_html."</body></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).'<strong>'.&sani($sort1d.$sort2d).'</strong>'.&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.= "<hr>\n<h2>".&heading($pending,$severity).":</h2>\n".
+ "(List of <A href=\"../si/$pending$severity.html\">all".
+ " such $gBugs</A> is available.)\n<ul>\n".
+ $$value.
+ "</ul>\n";
+ $anydone=1 if $pending eq 'done';
+ }
+ }
+ $text.= $expirynote_html if $anydone;
+ return $text;
+}
+
+&file("ix/full.html",'def',
+ $gFullIndex.
+ makeindex('$index',"",'').
+ "<hr>\n".
+ $tail_html."</body><html>\n");
+
+&file("ju/junk.html",'non',
+ $gJunkIndex.
+ "<hr>\n<h2>Junk (messages without a specific $gBug report number):</h2>\n".
+ "(\`this week' is everything since last Wednesday.)\n<ul>\n".
+ $indexunmatched.
+ "</ul><hr>\n".
+ $tail_html."</body><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 <A HREF=\"../../\">$gBug system top-level
+contents WWW page</A>.
+
+";
+
+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',
+ "<html><head><title>$who_html $gBug reports: $headstring</title>\n".
+ "<link rev=\"made\" href=\"mailto:".&sani($owner_addr)."\">\n".
+ "</head>$gHTMLStart<h1>$who_html $gBug reports: $headstring</h1>\n".
+ $otherindex_html.
+ ($pending eq 'done' ? "<P>\n$expirynote_html" : '').
+ "<hr>\n<ul>\n".
+ $$value.
+ "</ul>\n<hr>\n".
+ $tail_html."</body></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 .= "<li><A href=\"../$tfilename\">".&$getdisplayref($tkey)."</A>"."\n".
+ " ($xitext)\n";
+ $backnext= '';
+ if ($i>0) {
+ $refto= $$keysref[$i-1];
+ $xitext= &$getxindexref($refto);
+ $xitext= " ($xitext)" if length($xitext);
+ $backnext .= "<br>\nPrevious $what in list, <A href=\"../".
+ &$getfilenameref($refto)."\">".&$getdisplayref($refto)."</A>".
+ "$xitext\n";
+ }
+ if ($i<$#$keysref) {
+ $refto= $$keysref[$i+1];
+ $xitext= &$getxindexref($refto);
+ $xitext= " ($xitext)" if length($xitext);
+ $backnext .= "<br>\nNext $what in list, <A href=\"../".
+ &$getfilenameref($refto)."\">".&$getdisplayref($refto)."</A>".
+ "$xitext\n";
+ }
+ &file($tfilename,'ref',
+ "<html><head><title>$gProject $gBug reports: $what $sani</title>\n".
+ "<link rev=\"made\" href=\"mailto:$gMaintainerEmail\">\n".
+ "</head>$gHTMLStart<h1>$gProject $gBug reports: $what $sani</h1>\n".
+ &$getxinforef($tkey).
+ $caveat.
+ "See the <A href=\"../$filename\">listing of $whatplural</A>.\n".
+ $backnext.
+ &makeindex("\$per${abbrev}","{\$tkey}",$tkey).
+ "<hr>\n".
+ $tail_html."</body></html>\n");
+ }
+ &file($filename,'non',
+ $ihead.
+ "<hr><ul>\n".
+ $itext.
+ "</ul><hr>\n".
+ $tail_html."</body></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.<P>",
+ '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.<P>",
+ 'packages',
+ 'pack',
+ $gPackageIndex,
+ sub {
+ return unless defined($maintainer{$_[0]});
+ $tmaint= $maintainer{$_[0]};
+ return "Maintainer for $_[0] is <A href=\"../ma/l".
+ &maintencoded($tmaint).
+ ".html\">".&sani($tmaint)."</A>.\n<p>\n";
+ },
+ sub {
+ return unless defined($maintainer{$_[0]});
+ $tmaint= $maintainer{$_[0]};
+ return "<A href=\"../ma/l".
+ &maintencoded($tmaint).
+ ".html\">".&sani($tmaint)."</A>";
+ });
+
+&file('ix/summary.html','non',
+ $gSummaryIndex.
+ "<hr><pre>\n".
+ $shortindex.
+ "</pre><hr>\n".
+ $tail_html."</body></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.
+ "<hr><pre>\n$shorthead\n".
+ $bypackageindex.
+ "</pre><hr>\n".
+ $tail_html."</body></html>\n");
+
+open(P,"$gPseudoDescFile") ||
+ &quit("$gPseudoDescFile: $!");
+$ppd=''; while(<P>) { s/\s*\n$//; $ppd.= &sani($_)."\n"; } close(P);
+&file('ix/pseudopackages.html','non',
+ $gPseudoIndex.
+ "<hr><pre>\n$ppd".
+ "</pre><hr>\n".
+ $tail_html."</body></html>\n");
+
+$_= $gHTMLStamp; s/SUBSTITUTE_DTIME/$dtime/o;
+
+&file('ix/zstamp.html','non',$_."</body></html>\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= <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= <P>; $/= "\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;
+++ /dev/null
-#!/usr/bin/perl
-# $Id: db2html.in,v 1.22 2004/04/19 10:03:53 cjwatson Exp $
-# usage: db2html [-diff] [-stampfile=<stampfile>] [-lastrun=<days>] <wwwbase>
-
-#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',$_."</body></html>\n");
- print "noremoves";
-# print "db2html: no changes since last run\n";
- exit 0;
-}
-
-#parse maintainer file
-open(MM,"$gMaintainerFile") || &quit("open $gMaintainerFile: $!");
-while(<MM>)
-{ 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 <code>done\@$gEmailDomain</code>\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 <code>request@$gEmailDomain</code> (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= "<strong>Severity: $data->{severity}</strong>;\n";
- $addseverity= $data->{severity};
- } else
- { $showseverity= "Severity: <em>$data->{severity}</em>;\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: <A href=\"../$packfile\"><strong>".
- &sani($data->{package})."</strong></A>;\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."<A href=\"../$mfile.html\">#$m</A>";
- $mseparator= ",\n";
- }
- }
- $daysold=$submitted='';
- if (length($data->{done}))
- { $indexentry .= ";\n<strong>Done:</strong> ".&sani($data->{done});
- $indexpart= "done$addseverity";
- } elsif (length($data->{forwarded}))
- { $indexentry .= ";\n<strong>Forwarded</strong> 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 .= "</pre><h2>$msg:</h2><pre>\n$shorthead\n";
- $amonths= $cmonths;
- }
- $pad= 6-length(sprintf("%d",$f));
- $thissient=
- ($pad>0 ? ' 'x$pad : '').
- sprintf("<A href=\"../%s.html\">%d</A>",$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>" : '';
- $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".
- '<A href="../ma/l'.&maintencoded($tmaint).'.html">'.&sani($tmaint).'</A>.';
- $indexentry .= $daysold;
- $indexentry .= ".";
- }
- $indexadd='';
- $indexadd .= "<!--iid $iiref-->" if defined($iiref);
- $indexadd .= "<li><A href=\"../$linkto.html\">".$indexlink."</A>";
- $indexadd .= "<br>\n".$indexentry if length($indexentry);
- $indexadd .= "<!--/iid-->" 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= "<!--ii $iiref-->\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(<L>) {
- 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 .= "</pre>\n" if $normstate eq 'go' || $normstate eq 'go-nox';
- if ($normstate eq 'html') {
- $xmessage++;
- $this .= " <em><A href=\"../$linkto-b.html#m$xmessage\">Full text</A>".
- " available.</em>";
- }
- if ($suppressnext && $normstate ne 'html') {
- $ntis= $this; $ntis =~ s:\<pre\>:</A><pre>:i;
- $boring .= "<hr><A name=\"m$xmessage\">\n$ntis\n";
- } else {
- $log = $this. "<hr>\n". $log;
- }
- $suppressnext= $normstate eq 'html';
- $normstate= 'kill-end';
- } elsif (m/^\05$/) {
- $normstate eq 'kill-body' || &quit("^E in state $normstate");
- $this .= "<pre>\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 = "<h2>Message received at ".&sani("$1\@$2").":</h2><br>\n".
- "<pre>\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 = "<h2>Message sent:</h2><br>\n";
- } else {
- s/\04/, /g; s/\n$//;
- $this = "<h2>Message sent to ".&sani($_).":</h2><br>\n";
- }
- $normstate= 'kill-body';
- } elsif ($normstate eq 'autocheck') {
- next if !m/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
- $normstate= 'autowait';
- $this = "<h2>Message received at $2:</h2><br>\n";
- } elsif ($normstate eq 'autowait') {
- next if !m/^$/;
- $normstate= 'go-nox';
- $this .= "<pre>\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',
- "<html><head><title>$gProject $gBug report logs - ".
- "$short, boring messages</title>\n".
- "<link rev=\"made\" href=\"mailto:$gMaintainerEmail)\">\n".
- "</head>$gHTMLStart<h1>$gProject $gBugreport logs -".
- "\n <A href=\"../$linkto.html\">$short</A>,".
- " boring messages</h1>\n$boring\n<hr>\n".
- $tail_html."</body></html>\n");
- }
- &file("$linkto.html",'non',
- "<html><head><title>$gProject $gBug report logs - ".
- "$short</title>\n".
- "<link rev=\"made\" href=\"mailto:$gMaintainerEmail\">\n".
- "</head>$gHTMLStart<h1>$gProject $gBug report logs - $short<br>\n".
- &sani($data->{subject})."</h1>".
- "$descriptivehead\n".
- "\n<hr>\n".
- $log.
- $tail_html."</body></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).'<strong>'.&sani($sort1d.$sort2d).'</strong>'.&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.= "<hr>\n<h2>".&heading($pending,$severity).":</h2>\n".
- "(List of <A href=\"../si/$pending$severity.html\">all".
- " such $gBugs</A> is available.)\n<ul>\n".
- $$value.
- "</ul>\n";
- $anydone=1 if $pending eq 'done';
- }
- }
- $text.= $expirynote_html if $anydone;
- return $text;
-}
-
-&file("ix/full.html",'def',
- $gFullIndex.
- makeindex('$index',"",'').
- "<hr>\n".
- $tail_html."</body><html>\n");
-
-&file("ju/junk.html",'non',
- $gJunkIndex.
- "<hr>\n<h2>Junk (messages without a specific $gBug report number):</h2>\n".
- "(\`this week' is everything since last Wednesday.)\n<ul>\n".
- $indexunmatched.
- "</ul><hr>\n".
- $tail_html."</body><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 <A HREF=\"../../\">$gBug system top-level
-contents WWW page</A>.
-
-";
-
-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',
- "<html><head><title>$who_html $gBug reports: $headstring</title>\n".
- "<link rev=\"made\" href=\"mailto:".&sani($owner_addr)."\">\n".
- "</head>$gHTMLStart<h1>$who_html $gBug reports: $headstring</h1>\n".
- $otherindex_html.
- ($pending eq 'done' ? "<P>\n$expirynote_html" : '').
- "<hr>\n<ul>\n".
- $$value.
- "</ul>\n<hr>\n".
- $tail_html."</body></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 .= "<li><A href=\"../$tfilename\">".&$getdisplayref($tkey)."</A>"."\n".
- " ($xitext)\n";
- $backnext= '';
- if ($i>0) {
- $refto= $$keysref[$i-1];
- $xitext= &$getxindexref($refto);
- $xitext= " ($xitext)" if length($xitext);
- $backnext .= "<br>\nPrevious $what in list, <A href=\"../".
- &$getfilenameref($refto)."\">".&$getdisplayref($refto)."</A>".
- "$xitext\n";
- }
- if ($i<$#$keysref) {
- $refto= $$keysref[$i+1];
- $xitext= &$getxindexref($refto);
- $xitext= " ($xitext)" if length($xitext);
- $backnext .= "<br>\nNext $what in list, <A href=\"../".
- &$getfilenameref($refto)."\">".&$getdisplayref($refto)."</A>".
- "$xitext\n";
- }
- &file($tfilename,'ref',
- "<html><head><title>$gProject $gBug reports: $what $sani</title>\n".
- "<link rev=\"made\" href=\"mailto:$gMaintainerEmail\">\n".
- "</head>$gHTMLStart<h1>$gProject $gBug reports: $what $sani</h1>\n".
- &$getxinforef($tkey).
- $caveat.
- "See the <A href=\"../$filename\">listing of $whatplural</A>.\n".
- $backnext.
- &makeindex("\$per${abbrev}","{\$tkey}",$tkey).
- "<hr>\n".
- $tail_html."</body></html>\n");
- }
- &file($filename,'non',
- $ihead.
- "<hr><ul>\n".
- $itext.
- "</ul><hr>\n".
- $tail_html."</body></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.<P>",
- '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.<P>",
- 'packages',
- 'pack',
- $gPackageIndex,
- sub {
- return unless defined($maintainer{$_[0]});
- $tmaint= $maintainer{$_[0]};
- return "Maintainer for $_[0] is <A href=\"../ma/l".
- &maintencoded($tmaint).
- ".html\">".&sani($tmaint)."</A>.\n<p>\n";
- },
- sub {
- return unless defined($maintainer{$_[0]});
- $tmaint= $maintainer{$_[0]};
- return "<A href=\"../ma/l".
- &maintencoded($tmaint).
- ".html\">".&sani($tmaint)."</A>";
- });
-
-&file('ix/summary.html','non',
- $gSummaryIndex.
- "<hr><pre>\n".
- $shortindex.
- "</pre><hr>\n".
- $tail_html."</body></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.
- "<hr><pre>\n$shorthead\n".
- $bypackageindex.
- "</pre><hr>\n".
- $tail_html."</body></html>\n");
-
-open(P,"$gPseudoDescFile") ||
- &quit("$gPseudoDescFile: $!");
-$ppd=''; while(<P>) { s/\s*\n$//; $ppd.= &sani($_)."\n"; } close(P);
-&file('ix/pseudopackages.html','non',
- $gPseudoIndex.
- "<hr><pre>\n$ppd".
- "</pre><hr>\n".
- $tail_html."</body></html>\n");
-
-$_= $gHTMLStamp; s/SUBSTITUTE_DTIME/$dtime/o;
-
-&file('ix/zstamp.html','non',$_."</body></html>\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= <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= <P>; $/= "\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;
--- /dev/null
+# -*- 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;
+++ /dev/null
-# -*- 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;
--- /dev/null
+#!/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 <cjwatson@debian.org>
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>
+
+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;
+++ /dev/null
-#!/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 <cjwatson@debian.org>
-# Copyright 2007 by Don Armstrong <don@donarmstrong.com>
-
-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;
--- /dev/null
+#!/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')
+++ /dev/null
-#!/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')
--- /dev/null
+#!/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 &quit("remove html-data.gz: $!");
+
+sub nonawful ($) {
+ rename("stamp.html.run","stamp.html") or warn "warning: put back stamp.html: $!";
+ &quit($_[0]);
+}
+
+if (open(US,'updateseqs') && -f 'stamp.html') {
+ chop($lastmain=<US>);
+ chop($lastsub=<US>);
+ 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 <<END
+From: $gMaintainerEmail ($gProject $gBug Tracking System)
+To: $gMirrorList\@$gListDomain
+Subject: $gProject $gBugs autoupdate 259012
+Message-ID: <handle.htmlup.$seqmid\@$gEmailDomain>
+X-$gProject-PR: update $sequences
+
+END
+ ) or nonawful("write html-data.mail header: $!");
+} else {
+print(MM <<END
+From: $gMaintainerEmail ($gProject $gBug Tracking System)
+To: $gMaintainerEmail
+Subject: $gProject $gBugs autoupdate 259012
+Message-ID: <handle.htmlup.$seqmid\@$gEmailDomain>
+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 <html-data 2>&1",sub { &quit; });
+#runshell("gzip -9 html-data 2>&1",sub { &quit; });
+#runshell("btoa 2>&1 <html-data.gz >>html-data.mail",sub { &quit; });
+#runshell('2>&1 '.join(' ',('/usr/lib/sendmail','-f'."$gMaintainerEmail")).' -oem -oi -t <html-data.mail',
+# sub { &quit; });
+
+rename("stamp.html.new","stamp.html") or &quit("install new stamp.html: $!");
+
+unlink("html-data") or warn "remove html-data: $!";
+#unlink("html-data.gz") or warn "remove html-data.gz: $!";
+#unlink("html-data.mail") or warn "remove html-data.mail: $!";
+unlink("stamp.html.run") || $!==&ENOENT or warn "remove stamp.html.run: $!";
+
+print "sequences $lastmain $lastsub\n";
+
+&unfilelock();
+exit(0);
+++ /dev/null
-#!/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 &quit("remove html-data.gz: $!");
-
-sub nonawful ($) {
- rename("stamp.html.run","stamp.html") or warn "warning: put back stamp.html: $!";
- &quit($_[0]);
-}
-
-if (open(US,'updateseqs') && -f 'stamp.html') {
- chop($lastmain=<US>);
- chop($lastsub=<US>);
- 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 <<END
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $gMirrorList\@$gListDomain
-Subject: $gProject $gBugs autoupdate 259012
-Message-ID: <handle.htmlup.$seqmid\@$gEmailDomain>
-X-$gProject-PR: update $sequences
-
-END
- ) or nonawful("write html-data.mail header: $!");
-} else {
-print(MM <<END
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $gMaintainerEmail
-Subject: $gProject $gBugs autoupdate 259012
-Message-ID: <handle.htmlup.$seqmid\@$gEmailDomain>
-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 <html-data 2>&1",sub { &quit; });
-#runshell("gzip -9 html-data 2>&1",sub { &quit; });
-#runshell("btoa 2>&1 <html-data.gz >>html-data.mail",sub { &quit; });
-#runshell('2>&1 '.join(' ',('/usr/lib/sendmail','-f'."$gMaintainerEmail")).' -oem -oi -t <html-data.mail',
-# sub { &quit; });
-
-rename("stamp.html.new","stamp.html") or &quit("install new stamp.html: $!");
-
-unlink("html-data") or warn "remove html-data: $!";
-#unlink("html-data.gz") or warn "remove html-data.gz: $!";
-#unlink("html-data.mail") or warn "remove html-data.mail: $!";
-unlink("stamp.html.run") || $!==&ENOENT or warn "remove stamp.html.run: $!";
-
-print "sequences $lastmain $lastsub\n";
-
-&unfilelock();
-exit(0);
--- /dev/null
+#!/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=<STDIN>;
+ 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=<STDIN>) eq "that$filediff $file\n" or die die "not confirmed >$z<";
+ if ($filediff eq 'diff') {
+ $q= `ed -s <recv.tmp 2>&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 (<I>) {
+ 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 (<I>) {
+ 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 $!";
+++ /dev/null
-#!/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=<STDIN>;
- 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=<STDIN>) eq "that$filediff $file\n" or die die "not confirmed >$z<";
- if ($filediff eq 'diff') {
- $q= `ed -s <recv.tmp 2>&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 (<I>) {
- 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 (<I>) {
- 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 $!";
--- /dev/null
+#!/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 <<END || die "complete sendmail";
+From: $gMaintainerEmail ($gProject $gBug Tracking System)
+To: $gSummaryList\@$gListDomain
+Subject: $subject
+
+$intro
+$v
+Every Tuesday, the listing by package maintainer is posted.
+Every Friday, the listing by age of the report is posted.
+
+Please see the documentation for more information about how to
+use the $gBug tracking system. It is available on the WWW at
+<A HREF=\"http://$gWebDomain/txt/\">$gWebDomain/txt</A>
+END
+
+close(D);
+$? && die "sendmail failed $?: $!\n";
+
+print length($v)," bytes of summary posted.\n";
+++ /dev/null
-#!/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 <<END || die "complete sendmail";
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $gSummaryList\@$gListDomain
-Subject: $subject
-
-$intro
-$v
-Every Tuesday, the listing by package maintainer is posted.
-Every Friday, the listing by age of the report is posted.
-
-Please see the documentation for more information about how to
-use the $gBug tracking system. It is available on the WWW at
-<A HREF=\"http://$gWebDomain/txt/\">$gWebDomain/txt</A>
-END
-
-close(D);
-$? && die "sendmail failed $?: $!\n";
-
-print length($v)," bytes of summary posted.\n";
--- /dev/null
+#!/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=<M>;
+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= <<END;
+Received: via spool by $baddress\@$gEmailDomain id=$nn
+ (code $codeletter ref $tryref); $tdate
+END
+
+# header and decoded body respectively
+my (@headerlines, @bodylines);
+
+# whether maintainer addresses have been checked
+our $maintainerschecked = 0;
+#maintainer address for this message
+our @maintaddrs;
+# other src addresses
+our @addsrcaddrs;
+our @resentccs;
+our @bccs;
+
+my $resentccexplain='';
+
+# whether there's a new reference with this email
+our $newref = 0;
+
+our $brokenness = '';
+
+my $parser = new MIME::Parser;
+mkdir "$gSpoolDir/mime.tmp", 0777;
+$parser->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 <code>$tryref</code>.");
+ &sendmessage(create_mime_message(
+ [From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+ To => $replyto,
+ Subject => "Unknown problem report $gBug#$tryref ($subject)",
+ 'Message-ID' => "<handler.x.$nn.unknown\@$gEmailDomain>",
+ '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' => "<handler.x.$nn.warnignore\@$gEmailDomain>",
+ '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('',<O>); 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" => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
+ "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" => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
+ "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" => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
+ "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' => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
+ '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" => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
+ "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=<N>; $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(<<END,[$data->{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: <handler.$ref.$nn\@$gEmailDomain>
+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),
+ "<code>$gBug#$ref</code>".
+ (length($data->{package})? "; Package <code>".html_escape($data->{package})."</code>" : '').
+ ".");
+ &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
+Subject: $gBug#$ref: $newsubject
+Reply-To: $replyto, $ref\@$gEmailDomain
+Resent-From: $header{'from'}
+${orgsender}Resent-To: $gSubmitList\@$gListDomain
+${resentcc}Resent-Date: $tdate
+Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
+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,
+ "<code>$gBug#$ref</code>".
+ (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
+ ".");
+ } else {
+ &htmllog($newref ? "Report" : "Information", "stored",
+ "",
+ "<code>$gBug#$ref</code>".
+ (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
+ ".");
+ }
+ &sendmessage(<<END,[@resentccs],[@bccs]);
+Subject: $gBug#$ref: $newsubject
+Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
+Resent-From: $header{'from'}
+${orgsender}Resent-To: $resentccval
+Resent-Date: $tdate
+Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
+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) ? "<p>\n".html_escape($brokenness)."\n<p>\n" : '';
+$htmlbreak =~ s/\n\n/\n<P>\n\n/g;
+if (length($resentccval)) {
+ $htmlbreak = " Copy sent to <code>".html_escape($resentccval)."</code>.".
+ $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} = "<handler.$ref.$nn.ack${info}quiet\@$gEmailDomain>";
+ $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} = "<handler.$ref.$nn.ack{$info}maintonly\@$gEmailDomain>";
+ $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} = "<handler.$ref.$nn.ack${info}\@$gEmailDomain>";
+ $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".
+ "<strong>$whatobj $whatverb</strong>".
+ ($where eq '' ? "" : " to <code>".html_escape($where)."</code>").
+ ":<br>\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 (<MAINT>) {
+ 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 (<MAINT>) {
+ 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 (<SOURCES>) {
+ 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;
+}
+++ /dev/null
-#!/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=<M>;
-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= <<END;
-Received: via spool by $baddress\@$gEmailDomain id=$nn
- (code $codeletter ref $tryref); $tdate
-END
-
-# header and decoded body respectively
-my (@headerlines, @bodylines);
-
-# whether maintainer addresses have been checked
-our $maintainerschecked = 0;
-#maintainer address for this message
-our @maintaddrs;
-# other src addresses
-our @addsrcaddrs;
-our @resentccs;
-our @bccs;
-
-my $resentccexplain='';
-
-# whether there's a new reference with this email
-our $newref = 0;
-
-our $brokenness = '';
-
-my $parser = new MIME::Parser;
-mkdir "$gSpoolDir/mime.tmp", 0777;
-$parser->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 <code>$tryref</code>.");
- &sendmessage(create_mime_message(
- [From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
- To => $replyto,
- Subject => "Unknown problem report $gBug#$tryref ($subject)",
- 'Message-ID' => "<handler.x.$nn.unknown\@$gEmailDomain>",
- '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' => "<handler.x.$nn.warnignore\@$gEmailDomain>",
- '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('',<O>); 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" => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
- "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" => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
- "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" => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
- "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' => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
- '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" => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
- "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=<N>; $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(<<END,[$data->{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: <handler.$ref.$nn\@$gEmailDomain>
-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),
- "<code>$gBug#$ref</code>".
- (length($data->{package})? "; Package <code>".html_escape($data->{package})."</code>" : '').
- ".");
- &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
-Subject: $gBug#$ref: $newsubject
-Reply-To: $replyto, $ref\@$gEmailDomain
-Resent-From: $header{'from'}
-${orgsender}Resent-To: $gSubmitList\@$gListDomain
-${resentcc}Resent-Date: $tdate
-Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
-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,
- "<code>$gBug#$ref</code>".
- (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
- ".");
- } else {
- &htmllog($newref ? "Report" : "Information", "stored",
- "",
- "<code>$gBug#$ref</code>".
- (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
- ".");
- }
- &sendmessage(<<END,[@resentccs],[@bccs]);
-Subject: $gBug#$ref: $newsubject
-Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
-Resent-From: $header{'from'}
-${orgsender}Resent-To: $resentccval
-Resent-Date: $tdate
-Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
-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) ? "<p>\n".html_escape($brokenness)."\n<p>\n" : '';
-$htmlbreak =~ s/\n\n/\n<P>\n\n/g;
-if (length($resentccval)) {
- $htmlbreak = " Copy sent to <code>".html_escape($resentccval)."</code>.".
- $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} = "<handler.$ref.$nn.ack${info}quiet\@$gEmailDomain>";
- $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} = "<handler.$ref.$nn.ack{$info}maintonly\@$gEmailDomain>";
- $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} = "<handler.$ref.$nn.ack${info}\@$gEmailDomain>";
- $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".
- "<strong>$whatobj $whatverb</strong>".
- ($where eq '' ? "" : " to <code>".html_escape($where)."</code>").
- ":<br>\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 (<MAINT>) {
- 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 (<MAINT>) {
- 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 (<SOURCES>) {
- 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;
-}
--- /dev/null
+#!/usr/bin/perl
+# $Id: processall.in,v 1.13 2005/10/06 03:46:13 ajt Exp $
+#
+# Usage: processall
+#
+# Uses up: incoming/I<code><bugnum>.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);
+++ /dev/null
-#!/usr/bin/perl
-# $Id: processall.in,v 1.13 2005/10/06 03:46:13 ajt Exp $
-#
-# Usage: processall
-#
-# Uses up: incoming/I<code><bugnum>.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);
--- /dev/null
+#!/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;
+++ /dev/null
-#!/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;
--- /dev/null
+#!/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/\<//;
+}
+
+#remove everything from @ to end of line
+s/\@.*$//;
+
+#convert remaining upper case to lower case
+y/A-Z/a-z/;
+
+#set up to determine command
+%withbugaddressmap= ('-submit', 'B',
+ '', 'B',
+ '-maintonly', 'M',
+ '-quiet', 'Q',
+ '-forwarded', 'F',
+ '-done', 'D',
+ '-close', 'D',
+ '-request', 'R',
+ '-submitter', 'U',
+ # Used for bug subscription
+ #'-list-nothing-will-match-this', 'L',
+ );
+
+%withpkgaddressmap= ('-request', 'R');
+
+%withoutaddressmap= ('submit', 'B',
+ 'bugs', 'B',
+ 'maintonly', 'M',
+ 'quiet', 'Q',
+ 'forwarded', 'F',
+ 'done', 'D',
+ 'close', 'D',
+ 'request', 'R',
+ 'submitter', 'U',
+ 'control', 'C');
+
+#determine command
+if (s/^(\d{1,9})\b//) {
+ $bugnumber= $1;
+ if (not exists $withbugaddressmap{$_} and
+/-(?:(?:un)?subscribe|subhelp|help|ignore|(?:sub(?:yes|approve|reject)
+ |unsubyes|bounce|probe|approve|reject|
+ setlistyes|setlistsilentyes).*)/x
+ ) {
+ $map = 'L';
+ }
+ else {
+ $map= $withbugaddressmap{$_};
+ }
+ $addrrec= "$bugnumber$_";
+} elsif (s/^(\w+)-//) {
+ $bugnumber= $1;
+ $map= $withpkgaddressmap{"-$_"};
+ $addrrec= "$bugnumber-$_";
+} else {
+ $bugnumber= '';
+ $map= $withoutaddressmap{$_};
+ $addrrec= "$_";
+}
+
+#print no command received
+if (!defined($map)) {
+ print STDERR <<ENDTEXT;
+$gBadEmailPrefix
+$gBadEmailPrefix Unknown $gBug service address $_\@$gEmailDomain.
+$gBadEmailPrefix Recognised addresses are:
+$gBadEmailPrefix
+$gBadEmailPrefix General: Read $gBug# in Subject: $gBug# is NNNN:
+$gBadEmailPrefix
+$gBadEmailPrefix request submit $gBug NNNN NNNN-submit
+$gBadEmailPrefix control maintonly NNNN-maintonly
+$gBadEmailPrefix owner quiet NNNN-quiet
+$gBadEmailPrefix postmaster forwarded NNNN-forwarded
+$gBadEmailPrefix done close NNNN-done NNNN-close
+$gBadEmailPrefix submitter NNNN-submitter
+$gBadEmailPrefix
+$gBadEmailPrefix (all \@$gEmailDomain.)
+$gBadEmailPrefix
+$gBadEmailPrefix For instructions via the WWW see:
+$gBadEmailPrefix http://$gWebDomain/
+$gBadEmailPrefix http://$gWebDomain/Reporting$gHTMLSuffix
+$gBadEmailPrefix http://$gWebDomain/Developer$gHTMLSuffix
+$gBadEmailPrefix http://$gWebDomain/Access$gHTMLSuffix
+$gTextInstructions
+$gBadEmailPrefix For details of how to access $gBug report logs by email:
+$gBadEmailPrefix send \`request\@$gEmailDomain' the word \`help'
+$gBadEmailPrefix
+ENDTEXT
+ exit(100);
+}
+
+@months=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+($sec,$min,$hour,$mday,$mon,$year)= gmtime(time);
+
+$queue= "$map$bugnumber";
+
+chdir("$gSpoolDir/incoming") || &failure("chdir to spool: $!");
+
+$id= time.$$;
+open(FILE,">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(<STDIN>) { 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
+}
+++ /dev/null
-#!/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/\<//;
-}
-
-#remove everything from @ to end of line
-s/\@.*$//;
-
-#convert remaining upper case to lower case
-y/A-Z/a-z/;
-
-#set up to determine command
-%withbugaddressmap= ('-submit', 'B',
- '', 'B',
- '-maintonly', 'M',
- '-quiet', 'Q',
- '-forwarded', 'F',
- '-done', 'D',
- '-close', 'D',
- '-request', 'R',
- '-submitter', 'U',
- # Used for bug subscription
- #'-list-nothing-will-match-this', 'L',
- );
-
-%withpkgaddressmap= ('-request', 'R');
-
-%withoutaddressmap= ('submit', 'B',
- 'bugs', 'B',
- 'maintonly', 'M',
- 'quiet', 'Q',
- 'forwarded', 'F',
- 'done', 'D',
- 'close', 'D',
- 'request', 'R',
- 'submitter', 'U',
- 'control', 'C');
-
-#determine command
-if (s/^(\d{1,9})\b//) {
- $bugnumber= $1;
- if (not exists $withbugaddressmap{$_} and
-/-(?:(?:un)?subscribe|subhelp|help|ignore|(?:sub(?:yes|approve|reject)
- |unsubyes|bounce|probe|approve|reject|
- setlistyes|setlistsilentyes).*)/x
- ) {
- $map = 'L';
- }
- else {
- $map= $withbugaddressmap{$_};
- }
- $addrrec= "$bugnumber$_";
-} elsif (s/^(\w+)-//) {
- $bugnumber= $1;
- $map= $withpkgaddressmap{"-$_"};
- $addrrec= "$bugnumber-$_";
-} else {
- $bugnumber= '';
- $map= $withoutaddressmap{$_};
- $addrrec= "$_";
-}
-
-#print no command received
-if (!defined($map)) {
- print STDERR <<ENDTEXT;
-$gBadEmailPrefix
-$gBadEmailPrefix Unknown $gBug service address $_\@$gEmailDomain.
-$gBadEmailPrefix Recognised addresses are:
-$gBadEmailPrefix
-$gBadEmailPrefix General: Read $gBug# in Subject: $gBug# is NNNN:
-$gBadEmailPrefix
-$gBadEmailPrefix request submit $gBug NNNN NNNN-submit
-$gBadEmailPrefix control maintonly NNNN-maintonly
-$gBadEmailPrefix owner quiet NNNN-quiet
-$gBadEmailPrefix postmaster forwarded NNNN-forwarded
-$gBadEmailPrefix done close NNNN-done NNNN-close
-$gBadEmailPrefix submitter NNNN-submitter
-$gBadEmailPrefix
-$gBadEmailPrefix (all \@$gEmailDomain.)
-$gBadEmailPrefix
-$gBadEmailPrefix For instructions via the WWW see:
-$gBadEmailPrefix http://$gWebDomain/
-$gBadEmailPrefix http://$gWebDomain/Reporting$gHTMLSuffix
-$gBadEmailPrefix http://$gWebDomain/Developer$gHTMLSuffix
-$gBadEmailPrefix http://$gWebDomain/Access$gHTMLSuffix
-$gTextInstructions
-$gBadEmailPrefix For details of how to access $gBug report logs by email:
-$gBadEmailPrefix send \`request\@$gEmailDomain' the word \`help'
-$gBadEmailPrefix
-ENDTEXT
- exit(100);
-}
-
-@months=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
-($sec,$min,$hour,$mday,$mon,$year)= gmtime(time);
-
-$queue= "$map$bugnumber";
-
-chdir("$gSpoolDir/incoming") || &failure("chdir to spool: $!");
-
-$id= time.$$;
-open(FILE,">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(<STDIN>) { 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
-}
--- /dev/null
+#!/usr/bin/perl
+# $Id: service.in,v 1.118 2005/10/19 01:22:14 don Exp $
+#
+# Usage: service <code>.nn
+# Temps: incoming/P<code>.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=<M>;
+@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(<<END);
+There is no $gProject $gBug mailing list. If you wish to review bug reports
+please do so via http://$gWebDomain/ or ask this mail server
+to send them to you.
+soon: MAILINGLISTS_TEXT
+END
+ } elsif (m/^unsubscribe/i) {
+ &transcript(<<END);
+soon: UNSUBSCRIBE_TEXT
+soon: MAILINGLISTS_TEXT
+END
+ } elsif (m/^user\s+(\S+)\s*$/i) {
+ my $newuser = $1;
+ if (Debbugs::User::is_valid_user($newuser)) {
+ my $olduser = ($user ne "" ? " (was $user)" : "");
+ &transcript("Setting user to $newuser$olduser.\n");
+ $user = $newuser;
+ $indicated_user = 1;
+ } else {
+ &transcript("Selected user id ($newuser) invalid, sorry\n");
+ $errors++;
+ $user = "";
+ $indicated_user = 1;
+ }
+ } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
+ $ok++;
+ my $catname = $1;
+ my $hidden = ($2 ne "");
+
+ my $prefix = "";
+ my @cats;
+ my $bad = 0;
+ my $catsec = 0;
+ if ($user eq "") {
+ &transcript("No valid user selected\n");
+ $errors++;
+ next;
+ }
+ if (not $indicated_user and defined $user) {
+ &transcript("User is $user\n");
+ $indicated_user = 1;
+ }
+ while (++$procline <= $#bodylines) {
+ unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
+ $procline--;
+ last;
+ }
+ &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(<<END);
+Unknown command or malformed arguments to command.
+(Use control\@$gEmailDomain to manipulate reports.)
+
+END
+ $errors++;
+ if (++$unknowns >= 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= <<END;
+From: $gMaintainerEmail ($gProject $gBug Tracking System)
+To: $data->{originator}
+Subject: $gBug#$ref acknowledged by developer
+ ($header{'subject'})
+References: $header{'message-id'} $data->{msgid}
+In-Reply-To: $data->{msgid}
+Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
+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= <<END;
+From: $gMaintainerEmail ($gProject $gBug Tracking System)
+To: $oldsubmitter
+Subject: $gBug#$ref submitter address changed
+ ($header{'subject'})
+References: $header{'message-id'} $data->{msgid}
+In-Reply-To: $data->{msgid}
+Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
+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=<N>; $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= <<END;
+From: $gMaintainerEmail ($gProject $gBug Tracking System)
+To: $replyto
+${maintccs}Subject: Processed${error_text}: $header{'subject'}
+In-Reply-To: $header{'message-id'}
+References: $header{'message-id'}
+Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
+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".
+ "<strong>Request received</strong> from <code>".
+ html_escape($header{'from'})."</code>\n".
+ "to <code>".html_escape($controlrequestaddr)."</code>\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(<D>) { $doc.=$_; }
+ close(D);
+ &transcript("Sending $description in separate message.\n");
+ &sendmailmessage(<<END.$doc,$replyto);
+From: $gMaintainerEmail ($gProject $gBug Tracking System)
+To: $replyto
+Subject: $gProject $gBug help: $description
+References: $header{'message-id'}
+In-Reply-To: $header{'message-id'}
+Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
+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(<L>) { $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(<<END.$doc,$replyto);
+From: $gMaintainerEmail ($gProject $gBug Tracking System)
+To: $replyto
+Subject: $gProject $gBugs information: $description
+References: $header{'message-id'}
+In-Reply-To: $header{'message-id'}
+Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
+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 (<MAINT>) {
+ 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 (<MAINT>) {
+ 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 (<SOURCES>) {
+ 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 $/; <P> };
+ close P;
+ } else {
+ &transcript("internal errror: info files location unknown.\n");
+ $ok++; return;
+ }
+ &transcript("Sending $description.\n");
+ &sendmailmessage(<<END.$doc,$replyto);
+From: $gMaintainerEmail ($gProject $gBug Tracking System)
+To: $replyto
+Subject: $gProject $gBugs information: $description
+References: $header{'message-id'}
+In-Reply-To: $header{'message-id'}
+Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
+Precedence: bulk
+X-$gProject-PR-Message: getinfo
+
+$description follows:
+
+END
+ $ok++;
+ &transcript("\n");
+}
+++ /dev/null
-#!/usr/bin/perl
-# $Id: service.in,v 1.118 2005/10/19 01:22:14 don Exp $
-#
-# Usage: service <code>.nn
-# Temps: incoming/P<code>.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=<M>;
-@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(<<END);
-There is no $gProject $gBug mailing list. If you wish to review bug reports
-please do so via http://$gWebDomain/ or ask this mail server
-to send them to you.
-soon: MAILINGLISTS_TEXT
-END
- } elsif (m/^unsubscribe/i) {
- &transcript(<<END);
-soon: UNSUBSCRIBE_TEXT
-soon: MAILINGLISTS_TEXT
-END
- } elsif (m/^user\s+(\S+)\s*$/i) {
- my $newuser = $1;
- if (Debbugs::User::is_valid_user($newuser)) {
- my $olduser = ($user ne "" ? " (was $user)" : "");
- &transcript("Setting user to $newuser$olduser.\n");
- $user = $newuser;
- $indicated_user = 1;
- } else {
- &transcript("Selected user id ($newuser) invalid, sorry\n");
- $errors++;
- $user = "";
- $indicated_user = 1;
- }
- } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
- $ok++;
- my $catname = $1;
- my $hidden = ($2 ne "");
-
- my $prefix = "";
- my @cats;
- my $bad = 0;
- my $catsec = 0;
- if ($user eq "") {
- &transcript("No valid user selected\n");
- $errors++;
- next;
- }
- if (not $indicated_user and defined $user) {
- &transcript("User is $user\n");
- $indicated_user = 1;
- }
- while (++$procline <= $#bodylines) {
- unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
- $procline--;
- last;
- }
- &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(<<END);
-Unknown command or malformed arguments to command.
-(Use control\@$gEmailDomain to manipulate reports.)
-
-END
- $errors++;
- if (++$unknowns >= 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= <<END;
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $data->{originator}
-Subject: $gBug#$ref acknowledged by developer
- ($header{'subject'})
-References: $header{'message-id'} $data->{msgid}
-In-Reply-To: $data->{msgid}
-Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
-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= <<END;
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $oldsubmitter
-Subject: $gBug#$ref submitter address changed
- ($header{'subject'})
-References: $header{'message-id'} $data->{msgid}
-In-Reply-To: $data->{msgid}
-Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
-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=<N>; $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= <<END;
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $replyto
-${maintccs}Subject: Processed${error_text}: $header{'subject'}
-In-Reply-To: $header{'message-id'}
-References: $header{'message-id'}
-Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
-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".
- "<strong>Request received</strong> from <code>".
- html_escape($header{'from'})."</code>\n".
- "to <code>".html_escape($controlrequestaddr)."</code>\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(<D>) { $doc.=$_; }
- close(D);
- &transcript("Sending $description in separate message.\n");
- &sendmailmessage(<<END.$doc,$replyto);
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $replyto
-Subject: $gProject $gBug help: $description
-References: $header{'message-id'}
-In-Reply-To: $header{'message-id'}
-Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
-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(<L>) { $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(<<END.$doc,$replyto);
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $replyto
-Subject: $gProject $gBugs information: $description
-References: $header{'message-id'}
-In-Reply-To: $header{'message-id'}
-Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
-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 (<MAINT>) {
- 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 (<MAINT>) {
- 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 (<SOURCES>) {
- 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 $/; <P> };
- close P;
- } else {
- &transcript("internal errror: info files location unknown.\n");
- $ok++; return;
- }
- &transcript("Sending $description.\n");
- &sendmailmessage(<<END.$doc,$replyto);
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $replyto
-Subject: $gProject $gBugs information: $description
-References: $header{'message-id'}
-In-Reply-To: $header{'message-id'}
-Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
-Precedence: bulk
-X-$gProject-PR-Message: getinfo
-
-$description follows:
-
-END
- $ok++;
- &transcript("\n");
-}
--- /dev/null
+#! /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<code><bugnum>.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;
+++ /dev/null
-#! /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<code><bugnum>.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;
--- /dev/null
+#!/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>) {
+ 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>) {
+ 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: $!");
+++ /dev/null
-#!/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>) {
- 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>) {
- 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: $!");
--- /dev/null
+# -*- 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 = "<p>Copies of the logs are available on the World Wide Web at<BR>
+# <A HREF=\"http://mirror1.domain\"><CODE>http://mirror1.domain</CODE></A><BR>
+# <A HREF=\"http://mirror2.domain\"><CODE>http://mirror2.domain</CODE></A>";
+############################################################################
+$gHTMLCopies = "";
+
+
+############################################################################
+# notice other links you want to note, like your list archives or project
+# home page.
+#
+#$gHTMLOtherPages = "Other Links of note:<BR>
+# <A HREF=\"http://www.debian.org/\">The Debian Project</A><BR>
+# <A HREF=\"http://another.domain\">Description of URL</A>";
+############################################################################
+$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 = "<LI><A HREF=\"http://www.debian.org/\">
+# The Debian Project</A>
+# <LI><A HREF=\"http://another.domain\">Description of URL</A>";
+############################################################################
+$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 = "<p>There are some pseudo-packages available for putting in
+# the <CODE>Package</CODE> line when reporting a $gBug in something other than an
+# actual $gProject software package. There is
+# <A HREF="db/ix/pseudopackages.html"> a list of these</A> on the $gBugs WWW
+# pages.";
+############################################################################
+$gHTMLPseudoDesc = "";
+
+
+############################################################################
+# List any extra information you would like included in bug reports. For
+# example:
+# $gXtraBugInfo = "<li>What kernel version you're using (type
+# <code>uname -a</code>), your shared C library (type <code>ls -l
+# /lib/libc.so.6</code> or <code>dpkg -s libc6 | grep ^Version</code>), 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 <code>perl -v</code> or
+# <code>dpkg -s perl-5.005 | grep ^Version:</code>).";
+############################################################################
+$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 = "<DT><CODE>critical</CODE>
+ <DD>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.
+
+ <DT><CODE>grave</CODE>
+ <DD>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.
+
+ <DT><CODE>normal</CODE>
+ <DD>the default value, for normal $gBugs.
+
+ <DT><CODE>wishlist</CODE>
+ <DD>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 = "
+<dt><code>patch</code>
+ <dd>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.
+
+<dt><code>wontfix</code>
+ <dd>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.
+
+<dt><code>moreinfo</code>
+ <dd>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?
+
+<dt><code>unreproducible</code>
+ <dd>This $gBug can\'t be reproduced on the maintainer\'s system. Assistance
+ from third parties is needed in diagnosing the cause of the problem.
+
+<dt><code>fixed</code>
+ <dd>This $gBug is fixed or worked around, but there\'s still an issue that
+ needs to be resolved.
+
+<dt><code>stable</code>
+ <dd>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 = "<BODY>";
+
+############################################################################
+# shows up at the end of (most) html pages.
+############################################################################
+$gHTMLTail = "
+ <ADDRESS>$gMaintainer <<A HREF=\"mailto:$gMaintainerEmail\">$gMaintainerEmail</A>>.
+ Last modified:
+ <!--timestamp-->
+ SUBSTITUTE_DTIME
+ <!--timestamp-->
+
+ <P>
+ <A HREF=\"http://$gWebDomain/\">Debian $gBug tracking system</A><BR>
+ Copyright (C) 1999 Darren O. Benham,
+ 1997,2003 nCipher Corporation Ltd,
+ 1994-97 Ian Jackson.
+ </ADDRESS>
+";
+
+############################################################################
+# 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 = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+ <HTML><HEAD><TITLE>$gProject $gBugs - timestamp page</TITLE>
+ <LINK REV=\"made\" HREF=\"mailto:$gMaintainerEmail\">
+ </HEAD>$gHTMLStart<H1>Is this $gBug log or mirror up to date?</H1>
+
+ 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.
+ <P>
+ The last
+ <!--updateupdate-->update<!--/updateupdate-->
+ was at
+ <STRONG><!--updatetime-->SUBSTITUTE_DTIME<!--/updatetime--></STRONG>;
+ The logs are usually checked every hour and updated if necessary.
+ <P>
+ For the $gBug index or for other information about $gProject and the $gBug
+ system, see the <A HREF=\"../../\">$gBug system main contents page</A>.
+
+ <HR>
+ <ADDRESS>
+ <A HREF=\"mailto:$gMaintainerEmail\">$gMaintainerEmail</A>,
+ through the <A HREF=\"../../\">$gProject $gBug database</a>
+ </ADDRESS>
+ <!--version 1.0-4.3-->";
+
+############################################################################
+# Makeup of the indices pages
+############################################################################
+$gFullIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+ <HTML><HEAD><TITLE>$gProject $gBugs - full index</TITLE>
+ <LINK REV=\"make\" HREF=\"mailto:$gMaintainerEmail\">
+ </HEAD>$gHTMLStart<H1>$gProject $gBug report logs - index</H1>
+
+ This index gives access to $gBugs sent to <CODE>submit\@$gEmailDomain</CODE>
+ 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).
+ <P>
+ For other kinds of indices or for other information about $gProject and
+ the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
+ page</A>.
+
+
+ ";
+
+$gJunkIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+ <HTML><HEAD><TITLE>$gProject $gBug reports - Junk</TITLE>
+ <LINK REV=\"made\" HREF=\"$gMaintainerEmail\">
+ </HEAD>$gHTMLStart<H1>$gProject $gBug reports - Junk</H1>
+
+ This is the index page for logs of messages not associated with a specific
+ $gBug report.
+ <P>
+ For other kinds of indices or for other information about $gProject and
+ the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
+ page</A>.
+
+
+ ";
+
+$gMaintIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+ <HTML><HEAD><TITLE>$gProject $gBug reports by maintainer</TITLE>
+ <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
+ </HEAD>$gHTMLStart<H1>$gProject $gBug reports by maintainer</H1>
+
+ 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 <CODE>Maintainer</CODE>
+ package control file field may appear several times.<P>
+ If the maintainers information here is not accurate, please see
+ <A HREF=\"../../Developer.html#maintincorrect\">the developers\'
+ instructions</A> to find how this can happen and what to do about it. <P>
+ For other kinds of indices or for other information about $gProject and
+ the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
+ page</A>.
+
+
+ ";
+
+$gPackageIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+ <HTML><HEAD><TITLE>$gProject $gBug reports by package</TITLE>
+ <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
+ </HEAD>$gHTMLStart<H1>$gProject $gBug reports by package</H1>
+
+ 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).<P>
+ For other kinds of indices or for other information about $gProject and
+ the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
+ page</A>.
+
+
+ ";
+
+$gSummaryIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+ <HTML><HEAD><TITLE>$gProject $gBug report logs - summary index</TITLE>
+ <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
+ </HEAD>$gHTMLStart<H1>$gProject $gBug report logs - summary index</H1>
+
+ This summary index briefly lists $gBugs sent to <CODE>submit\@$gEmailDomain
+ </CODE> 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).<P>
+ For other kinds of indices or for other information about $gProject and
+ the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
+ page</A>.
+
+ <P>The * column lists the first letter of the severity of the $gBug.
+
+
+ ";
+
+$gPackageLog = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+ <HTML><HEAD><TITLE>$gProject $gBug report logs - index by package</TITLE>
+ <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
+ </HEAD>$gHTMLStart<H1>$gProject $gBug report logs - index by package</H1>
+
+ This summary index briefly lists $gBugs sent to <CODE>submit\@$gEmailDomain
+ </CODE> but not yet marked as done, or as forwarded to an upstream author.
+ Here they are sorted by package name.<P>
+ For other kinds of indices or for other information about $gProject and
+ the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
+ page</A>.
+
+
+ ";
+
+$gPseudoIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+ <HTML><HEAD><TITLE>$gProject $gBug report pseudo-packages</TITLE>
+ <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
+ </HEAD>$gHTMLStart<H1>$gProject $gBug report pseudo-packages</H1>
+
+ This page lists the pseudo-packages available for use in the
+ <CODE>Package:</CODE> line in $gBug reports.<P>
+
+ See the <A HREF=\"../../Reporting.html\">instructions for reporting a
+ $gBug</A> for details of how to specify a <CODE>Package:</CODE> line.<P>
+ For other kinds of indices or for other information about $gProject and
+ the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
+ page</A>.
+
+
+ ";
+++ /dev/null
-# -*- 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 = "<p>Copies of the logs are available on the World Wide Web at<BR>
-# <A HREF=\"http://mirror1.domain\"><CODE>http://mirror1.domain</CODE></A><BR>
-# <A HREF=\"http://mirror2.domain\"><CODE>http://mirror2.domain</CODE></A>";
-############################################################################
-$gHTMLCopies = "";
-
-
-############################################################################
-# notice other links you want to note, like your list archives or project
-# home page.
-#
-#$gHTMLOtherPages = "Other Links of note:<BR>
-# <A HREF=\"http://www.debian.org/\">The Debian Project</A><BR>
-# <A HREF=\"http://another.domain\">Description of URL</A>";
-############################################################################
-$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 = "<LI><A HREF=\"http://www.debian.org/\">
-# The Debian Project</A>
-# <LI><A HREF=\"http://another.domain\">Description of URL</A>";
-############################################################################
-$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 = "<p>There are some pseudo-packages available for putting in
-# the <CODE>Package</CODE> line when reporting a $gBug in something other than an
-# actual $gProject software package. There is
-# <A HREF="db/ix/pseudopackages.html"> a list of these</A> on the $gBugs WWW
-# pages.";
-############################################################################
-$gHTMLPseudoDesc = "";
-
-
-############################################################################
-# List any extra information you would like included in bug reports. For
-# example:
-# $gXtraBugInfo = "<li>What kernel version you're using (type
-# <code>uname -a</code>), your shared C library (type <code>ls -l
-# /lib/libc.so.6</code> or <code>dpkg -s libc6 | grep ^Version</code>), 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 <code>perl -v</code> or
-# <code>dpkg -s perl-5.005 | grep ^Version:</code>).";
-############################################################################
-$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 = "<DT><CODE>critical</CODE>
- <DD>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.
-
- <DT><CODE>grave</CODE>
- <DD>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.
-
- <DT><CODE>normal</CODE>
- <DD>the default value, for normal $gBugs.
-
- <DT><CODE>wishlist</CODE>
- <DD>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 = "
-<dt><code>patch</code>
- <dd>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.
-
-<dt><code>wontfix</code>
- <dd>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.
-
-<dt><code>moreinfo</code>
- <dd>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?
-
-<dt><code>unreproducible</code>
- <dd>This $gBug can\'t be reproduced on the maintainer\'s system. Assistance
- from third parties is needed in diagnosing the cause of the problem.
-
-<dt><code>fixed</code>
- <dd>This $gBug is fixed or worked around, but there\'s still an issue that
- needs to be resolved.
-
-<dt><code>stable</code>
- <dd>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 = "<BODY>";
-
-############################################################################
-# shows up at the end of (most) html pages.
-############################################################################
-$gHTMLTail = "
- <ADDRESS>$gMaintainer <<A HREF=\"mailto:$gMaintainerEmail\">$gMaintainerEmail</A>>.
- Last modified:
- <!--timestamp-->
- SUBSTITUTE_DTIME
- <!--timestamp-->
-
- <P>
- <A HREF=\"http://$gWebDomain/\">Debian $gBug tracking system</A><BR>
- Copyright (C) 1999 Darren O. Benham,
- 1997,2003 nCipher Corporation Ltd,
- 1994-97 Ian Jackson.
- </ADDRESS>
-";
-
-############################################################################
-# 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 = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
- <HTML><HEAD><TITLE>$gProject $gBugs - timestamp page</TITLE>
- <LINK REV=\"made\" HREF=\"mailto:$gMaintainerEmail\">
- </HEAD>$gHTMLStart<H1>Is this $gBug log or mirror up to date?</H1>
-
- 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.
- <P>
- The last
- <!--updateupdate-->update<!--/updateupdate-->
- was at
- <STRONG><!--updatetime-->SUBSTITUTE_DTIME<!--/updatetime--></STRONG>;
- The logs are usually checked every hour and updated if necessary.
- <P>
- For the $gBug index or for other information about $gProject and the $gBug
- system, see the <A HREF=\"../../\">$gBug system main contents page</A>.
-
- <HR>
- <ADDRESS>
- <A HREF=\"mailto:$gMaintainerEmail\">$gMaintainerEmail</A>,
- through the <A HREF=\"../../\">$gProject $gBug database</a>
- </ADDRESS>
- <!--version 1.0-4.3-->";
-
-############################################################################
-# Makeup of the indices pages
-############################################################################
-$gFullIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
- <HTML><HEAD><TITLE>$gProject $gBugs - full index</TITLE>
- <LINK REV=\"make\" HREF=\"mailto:$gMaintainerEmail\">
- </HEAD>$gHTMLStart<H1>$gProject $gBug report logs - index</H1>
-
- This index gives access to $gBugs sent to <CODE>submit\@$gEmailDomain</CODE>
- 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).
- <P>
- For other kinds of indices or for other information about $gProject and
- the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
- page</A>.
-
-
- ";
-
-$gJunkIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
- <HTML><HEAD><TITLE>$gProject $gBug reports - Junk</TITLE>
- <LINK REV=\"made\" HREF=\"$gMaintainerEmail\">
- </HEAD>$gHTMLStart<H1>$gProject $gBug reports - Junk</H1>
-
- This is the index page for logs of messages not associated with a specific
- $gBug report.
- <P>
- For other kinds of indices or for other information about $gProject and
- the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
- page</A>.
-
-
- ";
-
-$gMaintIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
- <HTML><HEAD><TITLE>$gProject $gBug reports by maintainer</TITLE>
- <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
- </HEAD>$gHTMLStart<H1>$gProject $gBug reports by maintainer</H1>
-
- 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 <CODE>Maintainer</CODE>
- package control file field may appear several times.<P>
- If the maintainers information here is not accurate, please see
- <A HREF=\"../../Developer.html#maintincorrect\">the developers\'
- instructions</A> to find how this can happen and what to do about it. <P>
- For other kinds of indices or for other information about $gProject and
- the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
- page</A>.
-
-
- ";
-
-$gPackageIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
- <HTML><HEAD><TITLE>$gProject $gBug reports by package</TITLE>
- <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
- </HEAD>$gHTMLStart<H1>$gProject $gBug reports by package</H1>
-
- 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).<P>
- For other kinds of indices or for other information about $gProject and
- the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
- page</A>.
-
-
- ";
-
-$gSummaryIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
- <HTML><HEAD><TITLE>$gProject $gBug report logs - summary index</TITLE>
- <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
- </HEAD>$gHTMLStart<H1>$gProject $gBug report logs - summary index</H1>
-
- This summary index briefly lists $gBugs sent to <CODE>submit\@$gEmailDomain
- </CODE> 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).<P>
- For other kinds of indices or for other information about $gProject and
- the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
- page</A>.
-
- <P>The * column lists the first letter of the severity of the $gBug.
-
-
- ";
-
-$gPackageLog = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
- <HTML><HEAD><TITLE>$gProject $gBug report logs - index by package</TITLE>
- <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
- </HEAD>$gHTMLStart<H1>$gProject $gBug report logs - index by package</H1>
-
- This summary index briefly lists $gBugs sent to <CODE>submit\@$gEmailDomain
- </CODE> but not yet marked as done, or as forwarded to an upstream author.
- Here they are sorted by package name.<P>
- For other kinds of indices or for other information about $gProject and
- the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
- page</A>.
-
-
- ";
-
-$gPseudoIndex = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
- <HTML><HEAD><TITLE>$gProject $gBug report pseudo-packages</TITLE>
- <LINK REF=\"made\" HREF=\"mailto:$gMaintainerEmail\">
- </HEAD>$gHTMLStart<H1>$gProject $gBug report pseudo-packages</H1>
-
- This page lists the pseudo-packages available for use in the
- <CODE>Package:</CODE> line in $gBug reports.<P>
-
- See the <A HREF=\"../../Reporting.html\">instructions for reporting a
- $gBug</A> for details of how to specify a <CODE>Package:</CODE> line.<P>
- For other kinds of indices or for other information about $gProject and
- the $gBug system, see <A HREF=\"../../\">$gBug system top-level contents WWW
- page</A>.
-
-
- ";
projects / debbugs.git / commitdiff