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