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.
  • [get | view] (2005-09-12 12:13:40, 3.0 KB) [[attachment:dispatch-VERP.patch]]
 All files | Selected Files: delete move to page copy to page

You are not allowed to attach a file to this page.