Download | Plain Text | Line Numbers
--- autoresponder-0.8.pl 2025-09-12 10:36:21.235780551 +0200
+++ autoresponder-0.8.pl 2025-09-12 10:38:44.924798079 +0200
@@ -1,8 +1,7 @@
#!/usr/bin/perl
#
-# Copyright (C) 2008-2016 Manuel Mausz (manuel@mausz.at)
+# Copyright (C) 2008-2025 Manuel Mausz (manuel@mausz.at)
# http://manuel.mausz.at/coding/autoresponder/
-# Origin code copyright (c) 2004-2008 Parallels GmbH (http://www.parallels.com)
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
@@ -30,9 +29,10 @@
use strict;
use warnings;
use utf8;
+use v5.38;
binmode(STDOUT, ':utf8');
-my $VERSION = '0.7';
+my $VERSION = '0.8';
#-------------------------------------------------------------------------------
# DATABASE TABLE LAYOUT
@@ -88,7 +88,7 @@
# this/these header/s will be added to every generated reply
# and checked to detect some loops more easily
-my %myheader = ('X-Mailer' => 'Confixx Autoresponder');
+my %myheader = ('X-Mailer' => 'UD::Autoresponder');
# this can be enabled if its important to exit with exitcode 0 (=success)
# on all errors. this means "mail sent successfully" although an error occured.
@@ -107,7 +107,7 @@
#-------------------------------------------------------------------------------
my %args = ();
-my $getopt = new Getopt::Long::Parser();
+my $getopt = Getopt::Long::Parser->new();
$getopt->configure('prefix_pattern=--|-');
$getopt->getoptions(
\%args,
@@ -130,7 +130,7 @@
# create logger
$args{'d'} = $args{'d'} || $debuglvl || 0;
$args{'l'} = $args{'l'} || $logfile || undef;
-our $log = new Logger(($args{'l'}) ? (file => $args{'l'}) : (handle => \*STDERR), level => $args{'d'})
+our $log = Logger->new(($args{'l'}) ? (file => $args{'l'}) : (handle => \*STDERR), level => $args{'d'})
or die("Couldn't create logger: $!");
# fetch ident
@@ -169,7 +169,7 @@
) or die("Unable to execute database query: ", DBI->errstr);
if (scalar($cnt[0]) > 0)
{
- $log->info("Loop detected.", $/);
+ $log->warning("Loop detected.", $/);
exit(0);
}
@@ -201,11 +201,11 @@
# send mail via mailer executable
$log->debug("Sending reply...", $/);
my @args = ($mailer, '-ti', '-f', $reply->{'from'}->address());
-open(MAIL, '|-') || exec { $args[0] } @args
+open(my $mailfh, '|-') || exec { $args[0] } @args
or die("Unable to open mailer: $!");
-binmode(MAIL, ':utf8');
-$reply->{'reply'}->print(\*MAIL);
-close(MAIL);
+$mailfh->binmode(':utf8');
+$reply->{'reply'}->print($mailfh);
+$mailfh->close;
# insert sender into database
$log->debug("Inserting sender into database...", $/);
@@ -246,11 +246,11 @@
if ($hvalue = $headers->get($hname))
{
chomp($hvalue);
- die("Message is either invalid, bounced or from a mailer daemon.")
+ die("Message is either invalid, bounced or from a mailer daemon.\n")
if ($hvalue eq '<>' || $hvalue eq "#@[]" || $hvalue =~ /MAILER-DAEMON$/i);
- die("Unable to parse mail address.")
+ die("Unable to parse mail address.\n")
if (!(@addrs = Mail::Address->parse($hvalue)));
- die("Value isn't exactly one mail address.")
+ die("Value isn't exactly one mail address.\n")
if (scalar(@addrs) != 1);
push(@sender, $addrs[0]);
}
@@ -258,14 +258,14 @@
# check From
$hname = 'From';
$headers->unfold($hname);
- die("No value.")
+ die("No value.\n")
if (!($hvalue = $headers->get($hname)));
chomp($hvalue);
- die("Message is either invalid or from a mailer daemon.")
+ die("Message is either invalid or from a mailer daemon.\n")
if ($hvalue =~ /MAILER-DAEMON$/i || $hvalue =~ /Mail Delivery (?:Sub)?(?:system|service)/i);
- die("Unable to parse mail address.")
+ die("Unable to parse mail address.\n")
if (!(@addrs = Mail::Address->parse($hvalue)));
- die("Value isn't exactly one mail address.")
+ die("Value isn't exactly one mail address.\n")
if (scalar(@addrs) != 1);
push(@sender, $addrs[0]);
@@ -275,17 +275,27 @@
if ($hvalue = $headers->get($hname))
{
chomp($hvalue);
- die("Message is either junk, bulk or from mailing list.")
+ die("Message is either junk, bulk or from mailing list.\n")
if ($hvalue =~ /(?:junk|list|bulk|autoreply)/i);
}
+ # check Auto-Submitted
+ $hname = 'Auto-Submitted';
+ $headers->unfold($hname);
+ if ($hvalue = $headers->get($hname))
+ {
+ chomp($hvalue);
+ die("Message is flagged as auto submitted.\n")
+ if ($hvalue !~ /no/i);
+ }
+
# check X-Auto-Response-Suppress
$hname = 'X-Auto-Response-Suppress';
$headers->unfold($hname);
if ($hvalue = $headers->get($hname))
{
chomp($hvalue);
- die("Message is has auto response suppress header.")
+ die("Message has active uto response suppression.\n")
if ($hvalue =~ /(?:all|oof|autoreply)/i);
}
@@ -295,7 +305,7 @@
if ($hvalue = $headers->get($hname))
{
chomp($hvalue);
- die("Message is junk.")
+ die("Message is junk.\n")
if ($hvalue =~ /yes/i);
}
@@ -305,7 +315,7 @@
'X-Mailing-List', 'X-ML-Name', 'X-List')
{
$hname = $_; # explicit assignment needed
- die("Message is from mailing list.")
+ die("Message is from mailing list.\n")
if (($hvalue = $headers->get($hname)) && chomp($hvalue));
}
@@ -315,16 +325,16 @@
if ($hvalue = $headers->get($hname))
{
chomp($hvalue);
- die("Message is bounced.")
+ die("Message is bounced.\n")
if ($hvalue =~ /^Delivery Status Notification \(Failure\)$/i || $hvalue =~ /Automated reply/i);
$subject = $hvalue;
}
# check my own headers
- foreach (keys(%$myheader))
+ foreach (keys($myheader->%*))
{
$hname = $_; # explicit assignment needed
- die("Message is signed by myself. Probably looping.")
+ die("Message is signed by myself. Probably looping.\n")
if (($hvalue = $headers->get($hname)) && chomp($hvalue) && $hvalue eq $myheader->{$hname});
}
@@ -342,7 +352,7 @@
if ($@)
{
my $error = $@;
- $log->info("Invalid header '", $hname, "': ", $error);
+ $log->warning("Unexpected header value '", $hname, "': ", $error);
$log->debug("Header value: '", $hvalue, "'.", $/);
exit(0);
};
@@ -403,6 +413,9 @@
Type => 'text/plain; charset=UTF-8',
) or die("Unable to create reply object.");
+ # remove MIME::Lite added header
+ $reply->delete('X-Mailer');
+
# create message-id + threading
my ($seconds, $microseconds) = gettimeofday();
my $messageid = sprintf("<%x.%06d.%x@%s>", $seconds, $microseconds,
@@ -414,10 +427,8 @@
if (length($hdata->{'references'}) || length($hdata->{'messageid'}));
# add some other headers
- foreach (keys(%$myheader))
- {
- $reply->add($_ = $myheader->{$_});
- }
+ $reply->add($_, $myheader->{$_})
+ foreach (keys($myheader->%*));
$reply->add('Precedence', 'bulk');
$reply->add('Auto-Submitted', 'auto-replied');
$reply->add('X-Auto-Response-Suppress', 'All');
@@ -440,6 +451,7 @@
use Carp;
use strict;
use warnings;
+use v5.38;
use constant ERROR => 0;
use constant WARNING => 1;
use constant INFO => 2;
@@ -455,26 +467,26 @@
bless($self, $class);
- @{$self->{'handles'}} = ();
+ $self->{'handles'}->@* = ();
if (defined($args{'handle'}))
{
- my $fh = new IO::Handle();
+ my $fh = IO::Handle->new();
$fh->fdopen($args{'handle'}, 'w')
or return undef;
binmode($fh, ':utf8');
- push(@{$self->{'handles'}}, $fh);
+ push($self->{'handles'}->@*, $fh);
}
if (defined($args{'file'}))
{
- my $fh = new IO::File($args{'file'}, "a")
+ my $fh = IO::File->new($args{'file'}, "a")
or return undef;
# this is needed for standard confixx qmail installation
chmod(0660, $args{'file'});
binmode($fh, ':utf8');
- push(@{$self->{'handles'}}, $fh);
+ push($self->{'handles'}->@*, $fh);
}
croak("No logging destination defined")
- if (scalar(@{$self->{'handles'}}) <= 0);
+ if (scalar($self->{'handles'}->@*) <= 0);
$self->{'level'} = (defined($args{'level'})) ? $args{'level'} : WARNING;
@@ -484,10 +496,8 @@
sub print
{
my ($self) = shift;
- foreach my $fh (@{$self->{'handles'}})
- {
- $fh->print(POSIX::strftime("[%Y.%m.%d-%H:%M:%S] ", localtime(time)), @_);
- }
+ $_->print(POSIX::strftime("[%Y.%m.%d-%H:%M:%S] ", localtime(time)), @_)
+ foreach ($self->{'handles'}->@*);
return 1;
}
@@ -507,10 +517,8 @@
sub close
{
my ($self) = shift;
- foreach my $fh (@{$self->{'handles'}})
- {
- $fh->close();
- }
+ $_->close()
+ foreach ($self->{'handles'}->@*);
}
#-------------------------------------------------------------------------------