Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Instead of fetchmail

by moodster (Hermit)
on Apr 17, 2002 at 14:43 UTC ( [id://159830]=CUFP: print w/replies, xml ) Need Help??

Stranded on a Win32 machine and in desperate need of fetchmail? Look no further... :)

This is a simple script that will pull mail from a POP3 account on a remote server and forward them to an SMTP server. We have an helpdesk system at work which accepts request by mail, so I wrote this piece to transfer mail from a certain account on our ISP's server to the helpdesk system (which has its own built-in SMTP) and used the Task Scheduling mechanism on Win2000 to run it every 5 minutes or so.

This is in no way a replacement for fetchmail, but it's simple to install and set up and it works (so far anyway).

#!c:\perl\bin\perl.exe # # A small fetchmail-like script that pulls mail from a POP3 server # and forwards it to a SMTP server. # use strict; use warnings; use Net::POP3; use Net::SMTP; # Init parameters my $pophost = 'mail.mydomain.com'; # Name or IP address of POP3 + server my $popuser = 'my_pop_account_name'; # Account name on POP3 ser +ver my $poppass = 'my_pop_account_password'; # Password for account my $smtphost = 'localhost'; # SMTP server to forward mail t +o my $smtprcpt = 'recipient@localhost'; # Account on SMTP server +that'll receive mail # Runtime parameters my $keep = 0; # Set to 1 to keep messages on remote server my $debug = 0; # Set to 1 to display debug messages # Actual program starts here my $pop = Net::POP3->new( $pophost ); my $nomsg = ( $pop->login( $popuser, $poppass ) || die "Couldn't log o +n to $pophost using $popuser/$poppass.\n" ); # Bail out if there are no messages waiting if( $nomsg eq '0E0' ) { $debug && print "No messages in mailbox.\n"; $pop->quit( ); exit( 0 ); } my $smtp = Net::SMTP->new( $smtphost ) || die "Couldn't connect to $sm +tphost.\n"; # Get the message numbers my $msgnums = $pop->list( ); # For each message, pop it and deliver it to the SMTP server for my $msgnum ( keys %{ $msgnums } ) { $debug && print "Fetching message $msgnum...\n"; my $msglines = $pop->get( $msgnum ); # find the 'From:' line my @from = grep /^From:\s/, @{ $msglines }; if( scalar( @from ) != 1 ) { $debug && print "Message $msgnum has too many or too few From: lin +es.\n"; next; } my( $from ) = $from[ 0 ] =~ /^From:\s(.*)/; # Deliver the message $debug && print "Delivering message $msgnum from $from...\n"; $smtp->mail( $from ); $smtp->to( $smtprcpt ); $smtp->data( ); for my $line ( @{ $msglines } ) { $smtp->datasend( $line ); } $smtp->dataend( ); if( ! $keep ) { $debug && print "Deleting message $msgnum from $pophost..."; $pop->delete( $msgnum ); } } $smtp->quit( ); $pop->quit( );

Cheers,
--Moodster

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://159830]
Approved by VSarkiss
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2024-03-28 20:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found