Attachment 'dispatch-VERP.patch'
Download 1 ? bin/verptest.pl
2 Index: bin/dispatch.pl
3 ===================================================================
4 RCS file: /cvs/qa/pts/bin/dispatch.pl,v
5 retrieving revision 1.10
6 diff -u -r1.10 dispatch.pl
7 --- bin/dispatch.pl 10 Jun 2003 21:36:23 -0000 1.10
8 +++ bin/dispatch.pl 17 Apr 2005 11:30:06 -0000
9 @@ -9,6 +9,8 @@
10
11 use Mail::Internet;
12 use Mail::Address;
13 +use Net::SMTP;
14 +use Mail::Verp;
15 use DB_File;
16
17 use strict;
18 @@ -25,7 +27,6 @@
19 require "common.pl";
20
21 # Local configuration variables
22 -my $nb_by_group = 20; # Number of emails sent together (in the same sendmail)
23 my $debug = 0;
24 my $spamc = '';
25 my $needs_approval = 1;
26 @@ -147,19 +148,30 @@
27 $mail->head()->add("X-Unsubscribe",
28 "echo 'unsubscribe $package' | mail pts\@qa.debian.org");
29
30 -# Forward the mail ... by group of $nb_by_group addresses
31 -my @send;
32 +# Forward the mail ...
33 +$pts_bounceaddr =~ s/PKG/$package/;
34 +
35 +my $smtp = Net::SMTP->new(Host => $pts_mailhost,
36 + Hello => $pts_mailhello);
37 while (defined($_ = shift @emails)) {
38 - push @send, $_;
39 - if (scalar(@send) == $nb_by_group) {
40 - send_mail(@send);
41 - @send = ();
42 - }
43 + mail_send($_);
44 }
45 -send_mail(@send) if (scalar(@send));
46 +$smtp->quit();
47 +
48 +
49 +sub mail_send {
50 + my $verp = Mail::Verp->encode($pts_bounceaddr, $_[0]);
51 +
52 + $smtp->mail($verp) or goto mailreset;
53 + $smtp->to($_[0]) or goto mailreset;
54 +
55 + $smtp->data() or goto mailreset;
56 + $smtp->datasend($mail->as_string()) or goto mailreset;
57 + $smtp->datend() or goto mailreset;
58 +
59 + return;
60
61 -sub send_mail {
62 - open(MAIL, "| $sendmail -oi @_") || die "Can't fork sendmail: $!\n";
63 - $mail->print(\*MAIL);
64 - close MAIL or warn "Problem happened with sendmail: $!\n";
65 + mailreset:
66 + $smtp->reset();
67 + # mail not sent for this address ... the PTS lacks a logging facility.
68 }
69 Index: perl/common.pl
70 ===================================================================
71 RCS file: /cvs/qa/pts/perl/common.pl,v
72 retrieving revision 1.10
73 diff -u -r1.10 common.pl
74 --- perl/common.pl 1 Feb 2005 13:08:15 -0000 1.10
75 +++ perl/common.pl 17 Apr 2005 11:30:07 -0000
76 @@ -1,7 +1,8 @@
77 # Configuration and some common code
78
79 use vars qw($pts_dir $spool_dir $conf_template $db_filename $db_tags_filename
80 - $sendmail $sendmailnobody $sources $pts_email @available_tags @default_tags
81 + $sendmail $sendmailnobody $pts_mailhost $pts_mailhello $pts_bounceaddr
82 + $sources $pts_email @available_tags @default_tags
83 %db_content $db %db_tags_content $db_tags
84 %bin2src %src $open_count);
85
86 @@ -13,6 +14,10 @@
87 $db_tags_filename = "$pts_dir/db/tags.db";
88 $sendmail = '/usr/sbin/sendmail -f owner@packages.qa.debian.org';
89 $sendmailnobody = '/usr/sbin/sendmail -f nobody@packages.qa.debian.org';
90 +$pts_mailhost = "localhost";
91 +$pts_mailhello = "localhost";
92 +# PKG will be replaced by the package name
93 +$pts_bounceaddr = "ptsbounce-PKG@packages.qa.debian.org";
94 $sources = "/org/packages.qa.debian.org/www/incoming/sources";
95 $pts_email = 'pts@qa.debian.org';
96 @available_tags = qw(default bts bts-control cvs summary ddtp
Attached Files
To refer to attachments on a page, use attachment:filename, as shown below in the list of files. Do NOT use the URL of the [get] link, since this is subject to change and can break easily.You are not allowed to attach a file to this page.