PERL Beginners - Need to write a pop3 attachment fetch program

Author

Need to write a pop3 attachment fetch program

C.F. Scheidecker Antunes

2004-07-14, 8:56 pm

Hello all,

Although I have done this same thing in PHP and Java before I have an
urgent need to accomplish it in Perl due to specific requirements.

What I need is to write an application that:
- Access a pop3 remote account
- Iterate through the list of messages on the server
- Download the attachments and save them localy on the machine
- delete all downloaded messages

requirements:
- only attachments ending with .txt and .zip should be saved, the rest
must be ignored.

OK, so I need help and directions on this.

What are the Perl CPAN modules to achieve it? Browsing CPAN I found:
Net-POP3_auth-0.03.tar.gz and Mail-POP3Client-2.16.tar.gz.

However I do not know how can I handle the mime attachment requirement.
Read the MIME body, save the attachment with its original name and only
..txt and .zip files.

After that, I will need to unzip all the .zip files saved to check
inside and do some processing.

I appreacite any help, any links to articles that teach how to do it in
perl.

Thanks in advance,

C.F.

Morbus Iff

2004-07-14, 8:56 pm

>What I need is to write an application that:
>- Access a pop3 remote account
>- Iterate through the list of messages on the server
>- Download the attachments and save them localy on the machine
>- delete all downloaded messages

See http://disobey.com/detergent/code/leecharoo/leechpop.pl
The code was further explained in my book 'Spidering Hacks'.

--
Morbus Iff ( and think about the bad things that I didn't do )
Technical: http://www.oreillynet.com/pub/au/779
Culture: http://www.disobey.com/ and http://www.gamegrene.com/
icq: 2927491 / aim: akaMorbus / yahoo: morbus_iff / jabber.org: morbus

Jupiterhost.Net

2004-07-22, 8:56 pm

C.F. Scheidecker Antunes wrote:
> Hello all,

Hello,

> Although I have done this same thing in PHP and Java before I have an
> urgent need to accomplish it in Perl due to specific requirements.
>
> What I need is to write an application that:
> - Access a pop3 remote account
> - Iterate through the list of messages on the server
> - Download the attachments and save them localy on the machine
> - delete all downloaded messages
>
> requirements:
> - only attachments ending with .txt and .zip should be saved, the rest
> must be ignored.
>
> OK, so I need help and directions on this.
>
> What are the Perl CPAN modules to achieve it? Browsing CPAN I found:
> Net-POP3_auth-0.03.tar.gz and Mail-POP3Client-2.16.tar.gz.
>
> However I do not know how can I handle the mime attachment requirement.
> Read the MIME body, save the attachment with its original name and only
> .txt and .zip files.

Sorry for the delay I've had this message waiting for a reply and
finally am getting to it :)

Ok, use Mail::POP3Client to connect and iterate through each message
then delete them

Mail::Internet is excellent for parsing email, althgough it doesn't do MIME.
I;ve used MIME::Parser for parsing the mime stuff.

Its a bit complicated, as all MIME can get due to evil MIME makers.

I'd start there, I also am aware of a module coming out that has a
single fucntion that breaks the email up into a hash, incuding a key
that is a hash of the attachements.

If you like I can send you more info about it, but its not due out for a
few more w

s give or take. It uses Mail::Internet and Mime::Parser
and does all the crazy stuff for you :)

So that you could do something like:

#connect
# get messages into an array of array refs
for(@messages) {
my $email = emailhash($_);
my %att = %{ $email->{ATTACHED}; # for easier reading :)
for(keys %att) {
my %part = %{ $att{$_} }; # again for easier reading :)
if($part{ctype} eq 'text/plain' && $part{filename} =~ m/\.txt$) {
# save file
}
}
}
#delete messages

> After that, I will need to unzip all the .zip files saved to check
> inside and do some processing.

Archive::Zip is what I've used to do this :)

> I appreacite any help, any links to articles that teach how to do it in
> perl.
>
> Thanks in advance,

HTH :)

Lee.M - JupiterHost.Net

James Derry

2004-07-22, 8:56 pm

this might not be the best-written script, but might this help?

#!/usr/bin/perl
# file: pop_fetch.pl
#text attachments are first appended to a single file, then that file is
re-opened for reading and its lines are first matched to one of two
regular expressions.
# depending on match, the line is then written to one of two text files

use strict;
use lib '.';

use PopParser;
use PromptUtil;
use Carp qw(carp confess);

$ENV{PATH} = '/bin:/usr/bin:/usr/X11/bin:/usr/local/bin';
delete $ENV{$_} foreach qw/ENV IFS BASH_ENV CDPATH/;

#my($username,$host) = shift =~ /([\w.-]+)@([\w.-]+)/;
my $username = "biosci\\user";
my $host = "localhost";
my $netfeed;
$username or die <<'USAGE';
Usage: pop_parse.pl username@pop.server
USAGE
;

my $entity;
$SIG{INT} = sub { exit 0 };

my $pop = PopParser->new($host) or die "Connect to host: $!\n";
my $passwd = "hoosier";

#create filehandles
my $OUT = "test.txt";
if (-e $OUT){
open(OUT, ">>test.txt");}
else {
`touch test.txt`;
open(OUT, ">test.txt");}

my $SWITCHPORT = "biosci_switchport_mac.txt";
if (-e $SWITCHPORT){
open(SWITCHPORT, ">>biosci_switchport_mac.txt");}
else {
`touch biosci_switchport_mac.txt`;
open(SWITCHPORT, ">biosci_switchport_mac.txt");}

my $IP = "biosci_mac_ip.txt";
if (-e $IP){
open(IP, ">>biosci_mac_ip.txt");
}
else {
`touch biosci_mac_ip.txt`;
open(IP, ">biosci_mac_ip.txt");
my $header = " ip_address\tmac_address\tfirst_seen\tlas
t_seen\n";
print IP $header;}

my $message_count = $pop->apop($username => $passwd)
|| $pop->login($username => $passwd)
or die "Can't log in: ",$pop->message,"\n";

for my $msgnum (1..$message_count) {

next unless $entity = $pop->get($msgnum);

display_entity($entity);
$entity->purge;
$pop->delete($msgnum);

} continue { print "\n" }

# view a message
sub display_entity {
my $entity = shift;

# A multipart message
if ($entity->is_multipart) {
handle_multipart($entity);
} else {
display_part($entity);
}
}

# called to process all the parts of a multipart entity
sub handle_multipart {
my $entity = shift;
my @parts = $entity->parts;

# separate text/plain parts from the others
my @text = grep $_->mime_type eq 'text/plain',@parts;
my @attachments = grep $_->mime_type ne 'text/html',@parts;

#print @attachments . "\n";

for (my $i=0;$i<@attachments;$i++) {
display_entity($attachments[$i])
}
}

# view the content of a message part
sub display_part {
my $part = shift;

my $head = $part->head;
my $type = $head->mime_type;
my $description = $head->get('Content-Description');
my ($default_name) = $head->get('Content-Disposition') =~
/filename="([^\"]+)"/;
my $body = $part->bodyhandle;

select(OUT);
$body->print;
}

END {
$entity->purge if defined $entity;
}

#text attachments are first appended to a single file, then that file is
re-opened for reading and its lines are first matched to one of two
regular expressions.
# depending on match, the line is then written to one of two text files

close OUT;
open(OUT, "test.txt");

my $count;
while(<OUT> )
{
if ((/^\w+\-\w+/) &&
(/\d+\.\d+\.\d+\.\d+\s\w+\/ \d+\sVlan\d+\s\w+\:\w+\:\w+:\w+:\w+:\w+\
s\d+\-\d+-\d+\s\d+\:\d+\:\d+\s\d+\-\d+-\d+\s\d+\:\d+:\d+\sACO/)
&& (!/\sPP\d+/))
{s/ACO#//;
print SWITCHPORT $_;}
if
(/^\d+\.\d+\.\d+\.\d+\s\w+\:\w+\:\w+:\w+:\w+:\w+\s\d+\-\d+-\d+\s\d+\:\d+\:\d+\s\d+\-\d+-\d+\s\d+\:\d+:\d+/){print
IP $_;}
}

close OUT;

close SWITCHPORT;
close IP;
$pop->quit;

#the glommed file is given a unique filename and archived.
my $dts = `date +%s`;

`cp test.txt archive/$dts`;
`rm test.txt`;

#END OF SCRIPT

goog luck,
james

JupiterHost.Net wrote:

>
>
> C.F. Scheidecker Antunes wrote:
>
>
>
> Hello,
>
>
>
> Sorry for the delay I've had this message waiting for a reply and
> finally am getting to it :)
>
> Ok, use Mail::POP3Client to connect and iterate through each message
> then delete them
>
> Mail::Internet is excellent for parsing email, althgough it doesn't do
> MIME.
> I;ve used MIME::Parser for parsing the mime stuff.
>
> Its a bit complicated, as all MIME can get due to evil MIME makers.
>
> I'd start there, I also am aware of a module coming out that has a
> single fucntion that breaks the email up into a hash, incuding a key
> that is a hash of the attachements.
>
> If you like I can send you more info about it, but its not due out for
> a few more w

s give or take. It uses Mail::Internet and
> Mime::Parser and does all the crazy stuff for you :)
>
> So that you could do something like:
>
> #connect
> # get messages into an array of array refs
> for(@messages) {
> my $email = emailhash($_);
> my %att = %{ $email->{ATTACHED}; # for easier reading :)
> for(keys %att) {
> my %part = %{ $att{$_} }; # again for easier reading :)
> if($part{ctype} eq 'text/plain' && $part{filename} =~ m/\.txt$) {
> # save file
> }
> }
> }
> #delete messages
>
>
>
> Archive::Zip is what I've used to do this :)
>
>
>
> HTH :)
>
> Lee.M - JupiterHost.Net
>

James Derry

2004-07-22, 8:56 pm

i should have mentioned that this is a modified script from lincoln
stein's book, network programming with perl, which i highly recommend.
james
james derry wrote:

> this might not be the best-written script, but might this help?
>
> #!/usr/bin/perl
> # file: pop_fetch.pl
> #text attachments are first appended to a single file, then that file
> is re-opened for reading and its lines are first matched to one of two
> regular expressions.
> # depending on match, the line is then written to one of two text files
>
> use strict;
> use lib '.';
>
> use PopParser;
> use PromptUtil;
> use Carp qw(carp confess);
>
> $ENV{PATH} = '/bin:/usr/bin:/usr/X11/bin:/usr/local/bin';
> delete $ENV{$_} foreach qw/ENV IFS BASH_ENV CDPATH/;
>
> #my($username,$host) = shift =~ /([\w.-]+)@([\w.-]+)/;
> my $username = "biosci\\user";
> my $host = "localhost";
> my $netfeed;
> $username or die <<'USAGE';
> Usage: pop_parse.pl username@pop.server
> USAGE
> ;
>
> my $entity;
> $SIG{INT} = sub { exit 0 };
>
> my $pop = PopParser->new($host) or die "Connect to host: $!\n";
> my $passwd = "hoosier";
>
> #create filehandles
> my $OUT = "test.txt";
> if (-e $OUT){
> open(OUT, ">>test.txt");}
> else {
> `touch test.txt`;
> open(OUT, ">test.txt");}
>
> my $SWITCHPORT = "biosci_switchport_mac.txt";
> if (-e $SWITCHPORT){
> open(SWITCHPORT, ">>biosci_switchport_mac.txt");}
> else {
> `touch biosci_switchport_mac.txt`;
> open(SWITCHPORT, ">biosci_switchport_mac.txt");}
> my $IP = "biosci_mac_ip.txt";
> if (-e $IP){
> open(IP, ">>biosci_mac_ip.txt");
> }
> else {
> `touch biosci_mac_ip.txt`;
> open(IP, ">biosci_mac_ip.txt");
> my $header = " ip_address\tmac_address\tfirst_seen\tlas
t_seen\n";
> print IP $header;}
>
>
> my $message_count = $pop->apop($username => $passwd)
> || $pop->login($username => $passwd)
> or die "Can't log in: ",$pop->message,"\n";
>
>
> for my $msgnum (1..$message_count) {
>
>
> next unless $entity = $pop->get($msgnum);
>
> display_entity($entity);
> $entity->purge;
> $pop->delete($msgnum);
>
> } continue { print "\n" }
>
> # view a message
> sub display_entity {
> my $entity = shift;
>
>
> # A multipart message
> if ($entity->is_multipart) {
> handle_multipart($entity);
> } else {
> display_part($entity);
> }
> }
>
> # called to process all the parts of a multipart entity
> sub handle_multipart {
> my $entity = shift;
> my @parts = $entity->parts;
>
> # separate text/plain parts from the others
> my @text = grep $_->mime_type eq 'text/plain',@parts;
> my @attachments = grep $_->mime_type ne 'text/html',@parts;
>
> #print @attachments . "\n";
>
> for (my $i=0;$i<@attachments;$i++) {
> display_entity($attachments[$i])
> }
> }
>
> # view the content of a message part
> sub display_part {
> my $part = shift;
>
> my $head = $part->head;
> my $type = $head->mime_type;
> my $description = $head->get('Content-Description');
> my ($default_name) = $head->get('Content-Disposition') =~
> /filename="([^\"]+)"/;
> my $body = $part->bodyhandle;
>
> select(OUT);
> $body->print;
> }
> END { $entity->purge if defined $entity;
> }
>
> #text attachments are first appended to a single file, then that file
> is re-opened for reading and its lines are first matched to one of two
> regular expressions.
> # depending on match, the line is then written to one of two text files
>
> close OUT;
> open(OUT, "test.txt");
>
> my $count;
> while(<OUT> )
> {
> if ((/^\w+\-\w+/) &&
> (/\d+\.\d+\.\d+\.\d+\s\w+\/ \d+\sVlan\d+\s\w+\:\w+\:\w+:\w+:\w+:\w+\
s\d+\-\d+-\d+\s\d+\:\d+\:\d+\s\d+\-\d+-\d+\s\d+\:\d+:\d+\sACO/)
> && (!/\sPP\d+/))
> {s/ACO#//;
> print SWITCHPORT $_;}
> if
> (/^\d+\.\d+\.\d+\.\d+\s\w+\:\w+\:\w+:\w+:\w+:\w+\s\d+\-\d+-\d+\s\d+\:\d+\:\d+\s\d+\-\d+-\d+\s\d+\:\d+:\d+/){print
> IP $_;}
> }
>
> close OUT;
>
> close SWITCHPORT;
> close IP;
> $pop->quit;
>
> #the glommed file is given a unique filename and archived.
> my $dts = `date +%s`;
>
> `cp test.txt archive/$dts`;
> `rm test.txt`;
>
> #END OF SCRIPT
>
> goog luck,
> james
>
> JupiterHost.Net wrote:
>
>
>

Sponsored Links