Download | Plain Text | No Line Numbers 

  1. --- autoresponder-0.8.pl	2025-09-12 10:36:21.235780551 +0200
  2. +++ autoresponder-0.8.pl	2025-09-12 10:38:44.924798079 +0200
  3. @@ -1,8 +1,7 @@
  4.  #!/usr/bin/perl
  5.  #
  6. -# Copyright (C) 2008-2016 Manuel Mausz (manuel@mausz.at)
  7. +# Copyright (C) 2008-2025 Manuel Mausz (manuel@mausz.at)
  8.  # http://manuel.mausz.at/coding/autoresponder/
  9. -# Origin code copyright (c) 2004-2008 Parallels GmbH (http://www.parallels.com)
  10.  #
  11.  # This program is free software; you can redistribute it and/or
  12.  # modify it under the terms of the GNU General Public License
  13. @@ -30,9 +29,10 @@
  14.  use strict;
  15.  use warnings;
  16.  use utf8;
  17. +use v5.38;
  18.  binmode(STDOUT, ':utf8');
  19.  
  20. -my $VERSION = '0.7';
  21. +my $VERSION = '0.8';
  22.  
  23.  #-------------------------------------------------------------------------------
  24.  # DATABASE TABLE LAYOUT
  25. @@ -88,7 +88,7 @@
  26.  
  27.  # this/these header/s will be added to every generated reply
  28.  # and checked to detect some loops more easily
  29. -my %myheader = ('X-Mailer' => 'Confixx Autoresponder');
  30. +my %myheader = ('X-Mailer' => 'UD::Autoresponder');
  31.  
  32.  # this can be enabled if its important to exit with exitcode 0 (=success)
  33.  # on all errors. this means "mail sent successfully" although an error occured.
  34. @@ -107,7 +107,7 @@
  35.  #-------------------------------------------------------------------------------
  36.  
  37.  my %args = ();
  38. -my $getopt = new Getopt::Long::Parser();
  39. +my $getopt = Getopt::Long::Parser->new();
  40.  $getopt->configure('prefix_pattern=--|-');
  41.  $getopt->getoptions(
  42.    \%args,
  43. @@ -130,7 +130,7 @@
  44.  # create logger
  45.  $args{'d'} = $args{'d'} || $debuglvl || 0;
  46.  $args{'l'} = $args{'l'} || $logfile  || undef;
  47. -our $log = new Logger(($args{'l'}) ? (file => $args{'l'}) : (handle => \*STDERR), level => $args{'d'})
  48. +our $log = Logger->new(($args{'l'}) ? (file => $args{'l'}) : (handle => \*STDERR), level => $args{'d'})
  49.    or die("Couldn't create logger: $!");
  50.  
  51.  # fetch ident
  52. @@ -169,7 +169,7 @@
  53.  ) or die("Unable to execute database query: ", DBI->errstr);
  54.  if (scalar($cnt[0]) > 0)
  55.  {
  56. -  $log->info("Loop detected.", $/);
  57. +  $log->warning("Loop detected.", $/);
  58.    exit(0);
  59.  }
  60.  
  61. @@ -201,11 +201,11 @@
  62.  # send mail via mailer executable
  63.  $log->debug("Sending reply...", $/);
  64.  my @args = ($mailer, '-ti', '-f', $reply->{'from'}->address());
  65. -open(MAIL, '|-') || exec { $args[0] } @args
  66. +open(my $mailfh, '|-') || exec { $args[0] } @args
  67.    or die("Unable to open mailer: $!");
  68. -binmode(MAIL, ':utf8');
  69. -$reply->{'reply'}->print(\*MAIL);
  70. -close(MAIL);
  71. +$mailfh->binmode(':utf8');
  72. +$reply->{'reply'}->print($mailfh);
  73. +$mailfh->close;
  74.  
  75.  # insert sender into database
  76.  $log->debug("Inserting sender into database...", $/);
  77. @@ -246,11 +246,11 @@
  78.      if ($hvalue = $headers->get($hname))
  79.      {
  80.        chomp($hvalue);
  81. -      die("Message is either invalid, bounced or from a mailer daemon.")
  82. +      die("Message is either invalid, bounced or from a mailer daemon.\n")
  83.          if ($hvalue eq '<>' || $hvalue eq "#@[]" || $hvalue =~ /MAILER-DAEMON$/i);
  84. -      die("Unable to parse mail address.")
  85. +      die("Unable to parse mail address.\n")
  86.          if (!(@addrs = Mail::Address->parse($hvalue)));
  87. -      die("Value isn't exactly one mail address.")
  88. +      die("Value isn't exactly one mail address.\n")
  89.          if (scalar(@addrs) != 1);
  90.        push(@sender, $addrs[0]);
  91.      }
  92. @@ -258,14 +258,14 @@
  93.      # check From
  94.      $hname = 'From';
  95.      $headers->unfold($hname);
  96. -    die("No value.")
  97. +    die("No value.\n")
  98.        if (!($hvalue = $headers->get($hname)));
  99.      chomp($hvalue);
  100. -    die("Message is either invalid or from a mailer daemon.")
  101. +    die("Message is either invalid or from a mailer daemon.\n")
  102.        if ($hvalue =~ /MAILER-DAEMON$/i || $hvalue =~ /Mail Delivery (?:Sub)?(?:system|service)/i);
  103. -    die("Unable to parse mail address.")
  104. +    die("Unable to parse mail address.\n")
  105.        if (!(@addrs = Mail::Address->parse($hvalue)));
  106. -    die("Value isn't exactly one mail address.")
  107. +    die("Value isn't exactly one mail address.\n")
  108.        if (scalar(@addrs) != 1);
  109.      push(@sender, $addrs[0]);
  110.  
  111. @@ -275,17 +275,27 @@
  112.      if ($hvalue = $headers->get($hname))
  113.      {
  114.        chomp($hvalue);
  115. -      die("Message is either junk, bulk or from mailing list.")
  116. +      die("Message is either junk, bulk or from mailing list.\n")
  117.          if ($hvalue =~ /(?:junk|list|bulk|autoreply)/i);
  118.      }
  119.  
  120. +    # check Auto-Submitted
  121. +    $hname = 'Auto-Submitted';
  122. +    $headers->unfold($hname);
  123. +    if ($hvalue = $headers->get($hname))
  124. +    {
  125. +      chomp($hvalue);
  126. +      die("Message is flagged as auto submitted.\n")
  127. +        if ($hvalue !~ /no/i);
  128. +    }
  129. +
  130.      # check X-Auto-Response-Suppress
  131.      $hname = 'X-Auto-Response-Suppress';
  132.      $headers->unfold($hname);
  133.      if ($hvalue = $headers->get($hname))
  134.      {
  135.        chomp($hvalue);
  136. -      die("Message is has auto response suppress header.")
  137. +      die("Message has active uto response suppression.\n")
  138.          if ($hvalue =~ /(?:all|oof|autoreply)/i);
  139.      }
  140.  
  141. @@ -295,7 +305,7 @@
  142.      if ($hvalue = $headers->get($hname))
  143.      {
  144.        chomp($hvalue);
  145. -      die("Message is junk.")
  146. +      die("Message is junk.\n")
  147.          if ($hvalue =~ /yes/i);
  148.      }
  149.  
  150. @@ -305,7 +315,7 @@
  151.               'X-Mailing-List', 'X-ML-Name', 'X-List')
  152.      {
  153.        $hname = $_; # explicit assignment needed
  154. -      die("Message is from mailing list.")
  155. +      die("Message is from mailing list.\n")
  156.          if (($hvalue = $headers->get($hname)) && chomp($hvalue));
  157.      }
  158.  
  159. @@ -315,16 +325,16 @@
  160.      if ($hvalue = $headers->get($hname))
  161.      {
  162.        chomp($hvalue);
  163. -      die("Message is bounced.")
  164. +      die("Message is bounced.\n")
  165.          if ($hvalue =~ /^Delivery Status Notification \(Failure\)$/i || $hvalue =~ /Automated reply/i);
  166.        $subject = $hvalue;
  167.      }
  168.  
  169.      # check my own headers
  170. -    foreach (keys(%$myheader))
  171. +    foreach (keys($myheader->%*))
  172.      {
  173.        $hname = $_; #  explicit assignment needed
  174. -      die("Message is signed by myself. Probably looping.")
  175. +      die("Message is signed by myself. Probably looping.\n")
  176.          if (($hvalue = $headers->get($hname)) && chomp($hvalue) && $hvalue eq $myheader->{$hname});
  177.      }
  178.  
  179. @@ -342,7 +352,7 @@
  180.    if ($@)
  181.    {
  182.      my $error = $@;
  183. -    $log->info("Invalid header '", $hname, "': ", $error);
  184. +    $log->warning("Unexpected header value '", $hname, "': ", $error);
  185.      $log->debug("Header value: '", $hvalue, "'.", $/);
  186.      exit(0);
  187.    };
  188. @@ -403,6 +413,9 @@
  189.      Type     => 'text/plain; charset=UTF-8',
  190.    ) or die("Unable to create reply object.");
  191.  
  192. +  # remove MIME::Lite added header
  193. +  $reply->delete('X-Mailer');
  194. +
  195.    # create message-id + threading
  196.    my ($seconds, $microseconds) = gettimeofday();
  197.    my $messageid = sprintf("<%x.%06d.%x@%s>", $seconds, $microseconds,
  198. @@ -414,10 +427,8 @@
  199.      if (length($hdata->{'references'}) || length($hdata->{'messageid'}));
  200.  
  201.    # add some other headers
  202. -  foreach (keys(%$myheader))
  203. -  {
  204. -    $reply->add($_ = $myheader->{$_});
  205. -  }
  206. +  $reply->add($_, $myheader->{$_})
  207. +    foreach (keys($myheader->%*));
  208.    $reply->add('Precedence',     'bulk');
  209.    $reply->add('Auto-Submitted', 'auto-replied');
  210.    $reply->add('X-Auto-Response-Suppress', 'All');
  211. @@ -440,6 +451,7 @@
  212.  use Carp;
  213.  use strict;
  214.  use warnings;
  215. +use v5.38;
  216.  use constant ERROR   => 0;
  217.  use constant WARNING => 1;
  218.  use constant INFO    => 2;
  219. @@ -455,26 +467,26 @@
  220.  
  221.    bless($self, $class);
  222.  
  223. -  @{$self->{'handles'}} = ();
  224. +  $self->{'handles'}->@* = ();
  225.    if (defined($args{'handle'}))
  226.    {
  227. -    my $fh = new IO::Handle();
  228. +    my $fh = IO::Handle->new();
  229.      $fh->fdopen($args{'handle'}, 'w')
  230.        or return undef;
  231.      binmode($fh, ':utf8');
  232. -    push(@{$self->{'handles'}}, $fh);
  233. +    push($self->{'handles'}->@*, $fh);
  234.    }
  235.    if (defined($args{'file'}))
  236.    {
  237. -    my $fh = new IO::File($args{'file'}, "a")
  238. +    my $fh = IO::File->new($args{'file'}, "a")
  239.        or return undef;
  240.      # this is needed for standard confixx qmail installation
  241.      chmod(0660, $args{'file'});
  242.      binmode($fh, ':utf8');
  243. -    push(@{$self->{'handles'}}, $fh);
  244. +    push($self->{'handles'}->@*, $fh);
  245.    }
  246.    croak("No logging destination defined")
  247. -    if (scalar(@{$self->{'handles'}}) <= 0);
  248. +    if (scalar($self->{'handles'}->@*) <= 0);
  249.  
  250.    $self->{'level'} = (defined($args{'level'})) ? $args{'level'} : WARNING;
  251.  
  252. @@ -484,10 +496,8 @@
  253.  sub print
  254.  {
  255.    my ($self) = shift;
  256. -  foreach my $fh (@{$self->{'handles'}})
  257. -  {
  258. -    $fh->print(POSIX::strftime("[%Y.%m.%d-%H:%M:%S] ", localtime(time)), @_);
  259. -  }
  260. +  $_->print(POSIX::strftime("[%Y.%m.%d-%H:%M:%S] ", localtime(time)), @_)
  261. +    foreach ($self->{'handles'}->@*);
  262.    return 1;
  263.  }
  264.  
  265. @@ -507,10 +517,8 @@
  266.  sub close
  267.  {
  268.    my ($self) = shift;
  269. -  foreach my $fh (@{$self->{'handles'}})
  270. -  {
  271. -    $fh->close();
  272. -  }
  273. +  $_->close()
  274. +    foreach ($self->{'handles'}->@*);
  275.  }
  276.  
  277.  #-------------------------------------------------------------------------------
  278.