T
thawkins
I posted the below in the Perl Module usergroup by mistake. So I'm
re-posting here.
I went searching for a script that will delete emails in one of my user
accounts. I found the script below. I set it up as a crons job, which
seems to be running fine. It connects to the user account, reads the
number of messages but doesn't delete any messages. Perl is not a
language that I am familiar with. I did spend time looking at the
script and to me it should be deleting the email messages. I was
hoping someone here could look at it and tell me why it is not working.
Thanks in Advance.
# ! /usr/bin/perl -w
use strict;
use warnings;
use Net:
OP3;
my ($popserver, $user, $pass, $maxmsg, @validusers);
my ($numDeleted,$numLeft) = (0,0);
my $pop;
# run control parameters - should be in a separate file
$popserver = 'mail.anyaddress.usa'; # pop3 server address
$user='(e-mail address removed)'; # enter your
pop3 username
$pass='XXXXXXXXXX'; # and password here
$maxmsg=100; # number of
messages to process in a single batch
@validusers = qw(postmaster webmaster);
# names NOT to delete messages for
# - enter with a space between. eg: qw(bob andy terry)
#--------- end parameters.
print "connecting to server $popserver..\n";
if ($pop = Net:OP3->new($popserver,Debug=>0)) {
print qq(Connected. Logging on as $user\n);
if (my $msgcnt = $pop->login($user,$pass)) {
if ($msgcnt > 0) {
print "$msgcnt messages....\n";
$msgcnt = $maxmsg if $msgcnt > $maxmsg; #
limit to just the max I have set
getmsg:
for my $msgnum (1..$msgcnt){
my ($hdr) = $pop->top($msgnum,0);
my @headers = (@$hdr);
my $nh = $#headers;
my $j=0;
for my $i (0..$#headers) { #
loop through the headers
$_=$headers[$i];
# putting multi-line onto one.
if (/^\S+:/) {
#print "$j
$headers[$j]\n";
$j = $i;
}
else {
$headers[$j] .=
$headers[$i];
$headers[$i] = "";
}
$headers[$j] =~ s/\s+/ /g;
# remove multiple spaces
$headers[$j] =~ s/(^ )|( $)//g;
# remove leading/trailing space
}
for(@headers) {print "$_\n";}
my $sj = "";
my @sjhdr = grep(/^Subject:/,
@headers); # get the Subject Header
if ( exists $sjhdr[0] && $sjhdr[0] =~
m/(^Subject: +)(.+)/ ) {
$sj= substr($2,0,40);
}
# print "$nh headers!\n";
my @rechdr = grep(/^Received:/,
@headers); # scan the received
for (@rechdr) {
# header for the
if
(m/(^Received:.+for\s+)(.+)(\@$user)/) { # envelope addressee
my $rcpt = $2;
for (@validusers) {
# check this recipient against
if (lc($rcpt) eq
$_){ # our list of valid users
print
qq(Leaving msg $msgnum for "$rcpt\@$user" "$sj"\n);
$numLeft++;
next
getmsg; # skip if we want to keep it
}
}
print qq(Deleting msg
$msgnum for "$rcpt\@$user" "$sj"\n);
$pop->delete($msgnum);
# otherwise delete it
$numDeleted++;
next getmsg;
}
}
}
print "$numDeleted deleted, $numLeft left\n";
}
else {
print qq(No messages on the server\n);
}
$pop->quit();
}
else {
print "Error logging on to server $popserver\n";
}
}
else {
print "Error Connecting to $popserver, $!\n";
}
sleep 5;
re-posting here.
I went searching for a script that will delete emails in one of my user
accounts. I found the script below. I set it up as a crons job, which
seems to be running fine. It connects to the user account, reads the
number of messages but doesn't delete any messages. Perl is not a
language that I am familiar with. I did spend time looking at the
script and to me it should be deleting the email messages. I was
hoping someone here could look at it and tell me why it is not working.
Thanks in Advance.
# ! /usr/bin/perl -w
use strict;
use warnings;
use Net:
OP3;my ($popserver, $user, $pass, $maxmsg, @validusers);
my ($numDeleted,$numLeft) = (0,0);
my $pop;
# run control parameters - should be in a separate file
$popserver = 'mail.anyaddress.usa'; # pop3 server address
$user='(e-mail address removed)'; # enter your
pop3 username
$pass='XXXXXXXXXX'; # and password here
$maxmsg=100; # number of
messages to process in a single batch
@validusers = qw(postmaster webmaster);
# names NOT to delete messages for
# - enter with a space between. eg: qw(bob andy terry)
#--------- end parameters.
print "connecting to server $popserver..\n";
if ($pop = Net:
OP3->new($popserver,Debug=>0)) {print qq(Connected. Logging on as $user\n);
if (my $msgcnt = $pop->login($user,$pass)) {
if ($msgcnt > 0) {
print "$msgcnt messages....\n";
$msgcnt = $maxmsg if $msgcnt > $maxmsg; #
limit to just the max I have set
getmsg:
for my $msgnum (1..$msgcnt){
my ($hdr) = $pop->top($msgnum,0);
my @headers = (@$hdr);
my $nh = $#headers;
my $j=0;
for my $i (0..$#headers) { #
loop through the headers
$_=$headers[$i];
# putting multi-line onto one.
if (/^\S+:/) {
#print "$j
$headers[$j]\n";
$j = $i;
}
else {
$headers[$j] .=
$headers[$i];
$headers[$i] = "";
}
$headers[$j] =~ s/\s+/ /g;
# remove multiple spaces
$headers[$j] =~ s/(^ )|( $)//g;
# remove leading/trailing space
}
for(@headers) {print "$_\n";}
my $sj = "";
my @sjhdr = grep(/^Subject:/,
@headers); # get the Subject Header
if ( exists $sjhdr[0] && $sjhdr[0] =~
m/(^Subject: +)(.+)/ ) {
$sj= substr($2,0,40);
}
# print "$nh headers!\n";
my @rechdr = grep(/^Received:/,
@headers); # scan the received
for (@rechdr) {
# header for the
if
(m/(^Received:.+for\s+)(.+)(\@$user)/) { # envelope addressee
my $rcpt = $2;
for (@validusers) {
# check this recipient against
if (lc($rcpt) eq
$_){ # our list of valid users
qq(Leaving msg $msgnum for "$rcpt\@$user" "$sj"\n);
$numLeft++;
next
getmsg; # skip if we want to keep it
}
}
print qq(Deleting msg
$msgnum for "$rcpt\@$user" "$sj"\n);
$pop->delete($msgnum);
# otherwise delete it
$numDeleted++;
next getmsg;
}
}
}
print "$numDeleted deleted, $numLeft left\n";
}
else {
print qq(No messages on the server\n);
}
$pop->quit();
}
else {
print "Error logging on to server $popserver\n";
}
}
else {
print "Error Connecting to $popserver, $!\n";
}
sleep 5;