Bug#34071: patch to add per bug subscription to the BTS
tag 34071 patch
thanks
The following patch adds per bug subscription to the BTS by sending
list control messages straight through to the appropriate control bot
on lists.debian.org, and then Bcc:'ing appropriate messages to
bugs=$ref\@$gListDomain; messages to control@ are also Bcc:'ed to all
of the appropriate bugs=$ref\@$glistDomain.
It is currently running on donbugs.donarmstrong.com and forwarding to
lists.debian.org. Pascal Hakim and Joachim Breitner have done the
heavy lifting on the lists.debian.org side, and deserve credit for the
hard bits of the implementation.
Feel free to test it out by creating a bug via
submit@donbugs.donarmstrong.com and then subscribing to it via
bugnum-subscribe@donbugs.donarmstrong.com
Don Armstrong
--
Tell me something interesting about yourself.
Lie if you have to.
-- hugh macleod http://www.gapingvoid.com/archives/batch20.php
http://www.donarmstrong.com http://rzlab.ucr.edu
Index: scripts/process.in
===================================================================
RCS file: /cvs/debbugs/source/scripts/process.in,v
retrieving revision 1.91
diff -u -r1.91 process.in
--- scripts/process.in 20 Apr 2005 04:40:18 -0000 1.91
+++ scripts/process.in 13 Jul 2005 18:18:28 -0000
@@ -27,7 +27,7 @@
defined( $intdate= time ) || &quit( "failed to get time: $!" );
$_=shift;
-m/^([BMQFDU])(\d*)\.\d+$/ || &quit("bad argument");
+m/^([BMQFDUL])(\d*)\.\d+$/ || &quit("bad argument");
$codeletter= $1;
$tryref= length($2) ? $2+0 : -1;
$nn= $_;
@@ -44,6 +44,7 @@
$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");
$baddressroot= $baddress;
$baddress= "$tryref-$baddress" if $tryref>=0;
@@ -324,6 +325,9 @@
&checkmaintainers;
+ # Add bug mailing lists as appropriate
+ push @maintaddrs, map {"bugs=$_\@$gListDomain"} ($ref, split (/ /, $data->{mergedwith}));
+
$noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
$noticeccval =~ s/\s+\n\s+/ /g;
$noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
@@ -637,6 +641,9 @@
push @bccs, "$gStrongList\@$gListDomain";
}
+# Send mail to the per bug list subscription too
+push @bccs, "bugs=$ref\@$gListDomain";
+
$veryquiet= $codeletter eq 'Q';
if ($codeletter eq 'M' && !@maintaddrs) {
$veryquiet= 1;
@@ -653,6 +660,7 @@
END
}
+
$resentccval.= join(', ',@resentccs);
$resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
if (length($resentccval)) {
@@ -1005,67 +1013,7 @@
push @$recips, @$bcc;
}
-#if debugging.. save email to a log
-# open AP, ">>debug";
-# print AP join( '|', @$recips )."\n>>";
-# print AP get_addresses( @$recips );
-# print AP "<<\n".$msg;
-# print AP "\n--------------------------------------------------------\n";
-# close AP;
-
- #start mailing
- $_ = '';
- $SIG{'CHLD'}='chldhandle';
- #print DEBUG "mailing sigchild set up<\n";
- $chldexit = 'no';
- $c= open(U,"-|");
- #print DEBUG "mailing opened pipe fork<\n";
- defined($c) || die $!;
- #print DEBUG "mailing opened pipe fork ok $c<\n";
- if (!$c) { # ie, we are in the child process
- #print DEBUG "mailing child<\n";
- unless (open(STDERR,">&STDOUT")) {
- #print DEBUG "mailing child opened stderr<\n";
- print STDOUT "redirect stderr: $!\n";
- #print DEBUG "mailing child opened stderr fail<\n";
- exit 1;
- #print DEBUG "mailing child opened stderr fail exit !?<\n";
- }
- #print DEBUG "mailing child opened stderr ok<\n";
- $c= open(D,"|-");
- #print DEBUG "mailing child forked again<\n";
- defined($c) || die $!;
- #print DEBUG "mailing child forked again ok $c<\n";
- if (!$c) { # ie, we are the child process
- #print DEBUG "mailing grandchild<\n";
- exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odq','-oem','-oi',get_addresses(@$recips);
- #print DEBUG "mailing grandchild exec failed<\n";
- die $!;
- #print DEBUG "mailing grandchild died !?<\n";
- }
- #print DEBUG "mailing child not grandchild<\n";
- print(D $msg) || die $!;
- #print DEBUG "mailing child printed msg<\n";
- close(D);
- #print DEBUG "mailing child closed pipe<\n";
- die "\n*** command returned exit status $?\n" if $?;
- #print DEBUG "mailing child exit status ok<\n";
- exit 0;
- #print DEBUG "mailing child exited ?!<\n";
- }
- #print DEBUG "mailing parent<\n";
- $results='';
- #print DEBUG "mailing parent results emptied<\n";
- while( $chldexit eq 'no' ) { $results.= $_; }
- #print DEBUG "mailing parent results read >$results<\n";
- close(U);
- #print DEBUG "mailing parent results closed<\n";
- $results.= "\n*** child returned exit status $?\n" if $?;
- #print DEBUG "mailing parent exit status ok<\n";
- $SIG{'CHLD'}='DEFAULT';
- #print DEBUG "mailing parent sigchild default<\n";
- if (length($results)) { &quit("running sendmail: $results"); }
- #print DEBUG "mailing parent results ok<\n";
+ send_mail_message($msg,$recips);
}
sub checkmaintainers {
@@ -1130,4 +1078,120 @@
push(@maintaddrs, $addmaint) unless
$addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
}
+}
+
+=head2 send_mail_message
+
+ send_mail_message($message,[@recipients],$envelope_from)
+
+Sends a mail message out to a set of recepients with envelope sender
+$envelope_from; if $envelope_from is not set, defaults to
+$gMaintainerEmail.
+
+=cut
+
+sub send_mail_message{
+ my ($message,$recipients,$envelope_from) = @_;
+
+ # Default to $gMaintainerEmail
+ $envelope_from ||= $gMaintainerEmail;
+
+ print DEBUG "sending mail to ".join(', ',@$recipients)." with -f $envelope_from";
+ local $_ = '';
+ $SIG{'CHLD'}='chldhandle';
+ #print DEBUG "mailing sigchild set up<\n";
+ our $chldexit = 'no';
+ our $c= open(U,"-|");
+ #print DEBUG "mailing opened pipe fork<\n";
+ defined($c) || die $!;
+ #print DEBUG "mailing opened pipe fork ok $c<\n";
+ if (!$c) { # ie, we are in the child process
+ #print DEBUG "mailing child<\n";
+ unless (open(STDERR,">&STDOUT")) {
+ #print DEBUG "mailing child opened stderr<\n";
+ print STDOUT "redirect stderr: $!\n";
+ #print DEBUG "mailing child opened stderr fail<\n";
+ exit 1;
+ #print DEBUG "mailing child opened stderr fail exit !?<\n";
+ }
+ #print DEBUG "mailing child opened stderr ok<\n";
+ $c= open(D,"|-");
+ #print DEBUG "mailing child forked again<\n";
+ defined($c) || die $!;
+ #print DEBUG "mailing child forked again ok $c<\n";
+ if (!$c) { # ie, we are the child process
+ #print DEBUG "mailing grandchild<\n";
+ exec '/usr/lib/sendmail', (defined $envelope_from?'-f'.$envelope_from:''),'-odq','-oem','-oi',
+ @{$recipients};
+ #print DEBUG "mailing grandchild exec failed<\n";
+ die $!;
+ #print DEBUG "mailing grandchild died !?<\n";
+ }
+ #print DEBUG "mailing child not grandchild<\n";
+ print(D $message) || die $!;
+ #print DEBUG "mailing child printed msg<\n";
+ close(D);
+ #print DEBUG "mailing child closed pipe<\n";
+ die "\n*** command returned exit status $?\n" if $?;
+ #print DEBUG "mailing child exit status ok<\n";
+ exit 0;
+ #print DEBUG "mailing child exited ?!<\n";
+ }
+ #print DEBUG "mailing parent<\n";
+ $results='';
+ #print DEBUG "mailing parent results emptied<\n";
+ while( $chldexit eq 'no' ) { $results.= $_; }
+ #print DEBUG "mailing parent results read >$results<\n";
+ close(U);
+ #print DEBUG "mailing parent results closed<\n";
+ $results.= "\n*** child returned exit status $?\n" if $?;
+ #print DEBUG "mailing parent exit status ok<\n";
+ $SIG{'CHLD'}='DEFAULT';
+ #print DEBUG "mailing parent sigchild default<\n";
+ if (length($results)) { &quit("running sendmail: $results"); }
+ #print DEBUG "mailing parent results ok<\n";
+
+
+}
+
+=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) = @_;
+ my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
+
+ local $/ = undef;
+ my $bug_message = <$bug_fh>;
+ my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
+ $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
+ my $envelope_from = $1;
+ 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/;
+ }
+ 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 $bug_message;
+ send_mail_message($bug_message,
+ ["bugs=$bug_address\@$gListDomain"],
+ $envelope_from,
+ );
+ unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");
+ exit 0;
}
Index: scripts/processall.in
===================================================================
RCS file: /cvs/debbugs/source/scripts/processall.in,v
retrieving revision 1.10
diff -u -r1.10 processall.in
--- scripts/processall.in 20 Mar 2004 15:13:52 -0000 1.10
+++ scripts/processall.in 13 Jul 2005 18:18:28 -0000
@@ -53,7 +53,7 @@
print(STDOUT "[$nf] $id service ...") || die $!;
defined($c=fork) || die $!;
if (!$c) { exec("$lib_path/service",$id); die $!; }
- } elsif ($id =~ m/^[BMQFDU]/) {
+ } elsif ($id =~ m/^[BMQFDUL]/) {
print(STDOUT "[$nf] $id process ...") || die $!;
defined($c=fork) || die $!;
if (!$c) { exec("$lib_path/process",$id); die $!; }
Index: scripts/receive.in
===================================================================
RCS file: /cvs/debbugs/source/scripts/receive.in,v
retrieving revision 1.16
diff -u -r1.16 receive.in
--- scripts/receive.in 13 Jan 2004 18:55:53 -0000 1.16
+++ scripts/receive.in 13 Jul 2005 18:18:28 -0000
@@ -45,7 +45,10 @@
'-done', 'D',
'-close', 'D',
'-request', 'R',
- '-submitter', 'U');
+ '-submitter', 'U',
+ # Used for bug subscription
+ #'-list-nothing-will-match-this', 'L',
+ );
%withpkgaddressmap= ('-request', 'R');
@@ -63,7 +66,16 @@
#determine command
if (s/^(\d{1,9})\b//) {
$bugnumber= $1;
- $map= $withbugaddressmap{$_};
+ if (not exists $withbugaddressmap{$_} and
+/-(?:(?:un)?subscribe|subhelp|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;
Index: scripts/service.in
===================================================================
RCS file: /cvs/debbugs/source/scripts/service.in,v
retrieving revision 1.100
diff -u -r1.100 service.in
--- scripts/service.in 26 May 2005 13:30:21 -0000 1.100
+++ scripts/service.in 13 Jul 2005 20:02:54 -0000
@@ -47,6 +47,9 @@
# 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 stupid bug twice.
+my (%bug_affected);
if ($entity and $entity->head->tags) {
@headerlines = @{$entity->head->header};
@@ -245,6 +248,7 @@
} elsif (m/^close\s+\#?(-?\d+)$/i) {
$ok++;
$ref= $1;
+ $bug_affected{$ref}=1;
if (&setbug) {
&transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n";);
if (length($data->{done})) {
@@ -296,6 +300,7 @@
} elsif (m/^reassign\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
$ok++;
$ref= $1; $newpackage= $2;
+ $bug_affected{$ref}=1;
$newpackage =~ y/A-Z/a-z/;
if (&setbug) {
if (length($data->{package})) {
@@ -316,6 +321,7 @@
m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
$ok++;
$ref= $1;
+ $bug_affected{$ref}=1;
if (&setbug) {
if (!length($data->{done})) {
&transcript("$gBug is already open, cannot reopen.\n\n");
@@ -335,6 +341,7 @@
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};
}
@@ -387,6 +394,7 @@
} 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.";
@@ -407,6 +415,7 @@
} 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");
@@ -423,6 +432,7 @@
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".
@@ -445,6 +455,7 @@
} 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 "-");
@@ -499,6 +510,7 @@
} 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};
}
@@ -523,6 +535,7 @@
} 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");
@@ -532,6 +545,7 @@
$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) ? ''
@@ -579,6 +593,7 @@
for $ref (@newmergelist) {
&getbug || die "huh ? $gBug $ref disappeared during merge";
&addmaintainers($data);
+ @bug_affected{@newmergelist} = 1 x @newmergelist;
$data->{mergedwith}= join(' ',grep($_ ne $ref,@newmergelist));
$data->{keywords}= join(' ', keys %tags);
&savebug;
@@ -594,6 +609,7 @@
$newbugsneeded = scalar(@newclonedids);
$ref = $origref;
+ $bug_affected{$ref} = 1;
if (&setbug) {
if (length($data->{mergedwith})) {
&transcript("$gBug is marked as being merged with others.\n\n");
@@ -616,6 +632,7 @@
&getnextbug;
my $ohash = get_hashname($origref);
$ref = $firstref;
+ @bug_affected{@newclonedids} = 1 x @newclonedids;
for $newclonedid (@newclonedids) {
$clonebugs{$newclonedid} = $ref;
@@ -645,6 +662,7 @@
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.";
@@ -663,6 +681,7 @@
} 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 " .
@@ -720,6 +739,9 @@
&transcript("MC|@maintccs|\n") if $dl>2;
$maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
}
+
+# 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";
Reply to: