qmailadmin/autoreply.pl

   1 #!/usr/local/bin/perl
   2 # autoreply.pl
   3 # Simple autoreply script
   4
   5 # read qmail module config
   6 $p = -l $0 ? readlink($0) : $0;
   7 $p =~ /^(.*)\/[^\/]+$/;
   8 open(CONF, "$1/config") || die "Failed to open $1/config";
   9 while(<CONF>) {
  10         if (/^(\S+)=(.*)/) {
  11                 $config{$1} = $2;
  12                 }
  13         }
  14 close(CONF);
  15
  16 # read headers and body
  17 while(<STDIN>) {
  18         s/\r|\n//g;
  19         if (/^(\S+):\s+(.*)/) {
  20                 $header{lc($1)} = $2;
  21                 }
  22         elsif (!$_) { last; }
  23         }
  24 while(<STDIN>) {
  25         $body .= $_;
  26         }
  27 if ($header{'x-webmin-autoreply'}) {
  28         print STDERR "Cancelling autoreply to an autoreply\n";
  29         exit 1;
  30         }
  31 if ($header{'x-mailing-list'} ||
  32     $header{'list-id'} ||
  33     $header{'precedence'} =~ /junk|bulk|list/i ||
  34     $header{'to'} =~ /Multiple recipients of/i) {
  35         # Do nothing if post is from a mailing list
  36         exit 0;
  37         }
  38 if ($header{'from'} =~ /postmaster|mailer-daemon/i) {
  39         # Do nothing if post is a bounce
  40         exit 0;
  41         }
  42
  43 # work out the correct to address
  44 @to = ( &split_addresses($header{'to'}),
  45         &split_addresses($header{'cc'}),
  46         &split_addresses($header{'bcc'}) );
  47 $to = $to[0]->[0];
  48 foreach $t (@to) {
  49         if ($t->[0] =~ /^([^\@\s]+)/ && $1 eq $ARGV[1]) {
  50                 $to = $t->[0];
  51                 }
  52         }
  53
  54 # build list of default reply headers
  55 $rheader{'From'} = $to;
  56 $rheader{'To'} = $header{'reply-to'} ? $header{'reply-to'}
  57                                      : $header{'from'};
  58 $rheader{'Subject'} = "Autoreply to $header{'subject'}";
  59 $rheader{'X-Webmin-Autoreply'} = 1;
  60 $rheader{'X-Originally-To'} = $header{'to'};
  61
  62 # read the autoreply file
  63 if (open(AUTO, $ARGV[0])) {
  64         while(<AUTO>) {
  65                 s/\$SUBJECT/$header{'subject'}/g;
  66                 s/\$FROM/$header{'from'}/g;
  67                 s/\$TO/$to/g;
  68                 s/\$DATE/$header{'date'}/g;
  69                 s/\$BODY/$body/g;
  70                 if (/^(\S+):\s*(.*)/ && !$doneheaders) {
  71                         $rheader{$1} = $2;
  72                         }
  73                 else {
  74                         $rbody .= $_;
  75                         $doneheaders = 1;
  76                         }
  77                 }
  78         close(AUTO);
  79         }
  80 else {
  81         $rbody = "Failed to open autoreply file $ARGV[0] : $!";
  82         }
  83
  84 # Open the replies tracking DBM, if one was set
  85 if ($rheader{'Reply-Tracking'}) {
  86         $track_replies = dbmopen(%replies, $rheader{'Reply-Tracking'}, 0700);
  87         }
  88 if ($track_replies) {
  89         # See if we have replied to this address before
  90         $period = $rheader{'Reply-Period'} || 60*60;
  91         ($from) = &split_addresses($header{'from'});
  92         if ($from) {
  93                 $lasttime = $replies{$from->[0]};
  94                 $now = time();
  95                 if ($now < $lasttime+$period) {
  96                         # Autoreplied already in this period .. just halt
  97                         exit(0);
  98                         }
  99                 $replies{$from->[0]} = $now;
 100                 }
 101         }
 102 delete($rheader{'Reply-Tracking'});
 103 delete($rheader{'Reply-Period'});
 104
 105 # run qmail and feed it the reply
 106 open(MAIL, "|$config{'qmail_dir'}/bin/qmail-inject");
 107 foreach $h (keys %rheader) {
 108         print MAIL "$h: $rheader{$h}\n";
 109         }
 110 print MAIL "\n";
 111 print MAIL $rbody;
 112 close(MAIL);
 113
 114 # split_addresses(string)
 115 # Splits a comma-separated list of addresses into [ email, real-name ] pairs
 116 sub split_addresses
 117 {
 118 local (@rv, $str = $_[0]);
 119 while(1) {
 120         if ($str =~ /^[\s,]*(([^<>\(\)\s]+)\s+\(([^\(\)]+)\))(.*)$/) {
 121                 push(@rv, [ $2, $3, $1 ]);
 122                 $str = $4;
 123                 }
 124         elsif ($str =~ /^[\s,]*("([^"]+)"\s+<([^\s<>]+)>)(.*)$/ ||
 125                $str =~ /^[\s,]*(([^<>]+)\s+<([^\s<>]+)>)(.*)$/ ||
 126                $str =~ /^[\s,]*(([^<>\[\]]+)\s+\[mailto:([^\s\[\]]+)\])(.*)$/||
 127                $str =~ /^[\s,]*(()<([^\s<>]+)>)(.*)/ ||
 128                $str =~ /^[\s,]*(()([^\s<>,]+))(.*)/) {
 129                 push(@rv, [ $3, $2, $1 ]);
 130                 $str = $4;
 131                 }
 132         else {
 133                 last;
 134                 }
 135         }
 136 return @rv;
 137 }
 138