#!/usr/bin/perl -w

# Pick up mail from a pop3 server and forward them to local mailboxes 
+- 
easier
# to use than fetchmail!

# Copyright (C) 2002 Nigel Horne, Wharfedale Computers Ltd.
# njh@despammed.com
# 21/11/02:     Use DNS to check originating host exists to help stop 
+spam

use strict;
use Net::POP3;
use Net::DNS;

my $hostname = 'abc.co.uk';
my $server = 'pop3.isp.net';
my $user = 'xyzzy';
my $password = 'plugh';

my $pop3 = Net::POP3->new($server, Timeout => 60) or
        die "Cannot connect to $server: $!";

my $nummessages = $pop3->login($user, $password);

if(!defined $nummessages) {
        die "Cannot login to $server: $!";
}

if($nummessages eq 0) {
        print "Nothing to do";
        $pop3->quit();
        exit 0;
}

print "Retrieving $nummessages messages from $server\n";
        
my $messages = $pop3->list() or
        die "Cannot get list of messages from $server: $!";

my $resolver = Net::DNS::Resolver->new;

MESSAGE: foreach my $msgid (keys %$messages) {
        print "Forwarding message $msgid ...";

        my $message = $pop3->get($msgid);

        defined $message or die "\nCan't retrieve message $msgid: $!";
        
        print "\n";

        my $from = "";

        foreach my $line (@$message) {
                if($line =~ /^From: (.+)/) {
                        $from = $1;
                        if($from =~ .*\<.+\@(.+)\>) {
                                my $sendingHost = $1;
                                unless($resolver->search($1)) {
                                        warn "Unknown host $1 in $from
+, message not forwarded";
                                        # You may wish to comment this
+ out...
                                        $pop3->delete($msgid);
                                        next MESSAGE;
                                }
                        }
                        last;
                }
        }
        if(open(MAIL, "|/usr/lib/sendmail -t -odq")) {
                # Send UNIX style from as well as SMTP style
                print MAIL "From $from\n";

                # Send TO field first
                foreach my $line (@$message) {
                        if($line =~ /^To: (.+)\@$hostname(.*)/) {
                                print MAIL "To: $1$2\n";
                                print "To: $1$2\n";
                                last;
                        }
                }
                foreach my $line (@$message) {
                        (($line =~ /^From: (.+)/) && print "From: $1\n
+") ||
                            (($line =~ /^Subject: (.+)/) && print "Sub
+ject: $1\n") ||
                            (($line =~ /^To: (.+)\@$hostname(.*)/) && 
+next);

                        print MAIL $line;

                        # print $line;
                }
                if(close MAIL) {
                        $pop3->delete($msgid);
                } else {
                        warn "e-mail may have failed\n";
                        # You may wish to comment this out...
                        $pop3->delete($msgid);
                }
        }
}

$pop3->quit();
[download]