rplctn/download.pl

   1 #! /perl/bin/perl -w
   2 #
   3 # Downloader: download RFC822 format messages from a POP server.
   4 #
   5 # Written by Ewen McNeill, 19/11/1997.
   6 #
   7 # All messages at the POP server are downloaded and stored in files
   8 # named by date, time, and sequence number (intended to give a unique
   9 # filename).  WARNING: filenames will be longer than 8.3.
  10 #
  11 # As each message is successfully downloaded it is marked for deletion.
  12 # If all messages are successfully downloaded a QUIT is done, which will
  13 # delete all the messages marked for deletion; otherwise the connection
  14 # is reset (leaving all messages intact).
  15 #
  16 #---------------------------------------------------------------------------
  17
  18 use 5;
  19
  20 use Net::POP3;                    # Talk nicely to a POP server
  21 use strict;
  22
  23 require "recvconf.ph";            # Configuration of Receiver
  24
  25 #---------------------------------------------------------------------------
  26
  27 # Mainline
  28
  29 my $seq = 0;
  30
  31 die "No inbound directory" if (! defined($RecvConf::downloaded));
  32 die "No POP server"        if (! defined($RecvConf::POPserver));
  33 die "No POP user"          if (! defined($RecvConf::login));
  34 die "No POP password"      if (! defined($RecvConf::password));
  35
  36 # Connect to the POP server
  37 my $pop = Net::POP3->new($RecvConf::POPserver);
  38
  39 if (! defined($pop))
  40 {
  41   die "Unable to establish connection to POP server \"$RecvConf::POPserver\": $!\n";
  42 }
  43
  44 # Login to the POP server
  45
  46 my $msgs = $pop -> login($RecvConf::login, $RecvConf::password);
  47
  48 # Cycle through the messages (if any) downloading them
  49
  50 my $i;
  51 my $problems = 0;
  52 for ($i = 1; $i <= $msgs; $i++)
  53 {
  54   # Figure out a filename to save this message in.
  55   #
  56   # WARNING: "long" filename; WARNING: race condition!
  57   #
  58   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  59   $year += 1900; $mon++;
  60
  61   my $filename;
  62   do    # Scan for a "unique" filename.
  63   {
  64     $seq++;
  65     $filename = sprintf("%04d-%02d-%02d-%02d-%02d-%03d.msg",
  66                         $year, $mon, $mday, $hour, $min, $seq);
  67   } while (-r "$RecvConf::downloaded/$filename" ||
  68            -f "$RecvConf::downloaded/$filename" ||
  69            -d "$RecvConf::downloaded/$filename");
  70
  71   if (open(MSG, ">$RecvConf::downloaded/$filename"))
  72   {
  73     # Grab a reference to the whole message.
  74     my $messageref = $pop->get($i);
  75
  76     # And save it out to our file.
  77     if (defined($messageref))
  78     {
  79       if (print MSG @$messageref)
  80       { # Message saved away, we can mark it for deletion.
  81         if (close(MSG))
  82         { $pop->delete($i) ||
  83             warn "Error encountered marking message $i for deletion\n";
  84         }
  85         else
  86         { warn "Errors closing file ($filename), message not deleted.\n";
  87           $problems++
  88         }
  89       }
  90       else
  91       {
  92         warn "Eeeek!  Failed to write message $i to $filename\n";
  93         $problems++;
  94       }
  95     }
  96     else
  97     {
  98       warn "Problems downloading message $i -- skipping\n";
  99       close(MSG);
 100       unlink("$RecvConf::downloaded/$filename") ||
 101         warn "Unable to remove partial message: $filename\n";
 102     }
 103   }
 104   else
 105   {
 106     warn "Unable to open file to save message $i -- skipping ($filename)\n";
 107   }
 108 }
 109
 110 if ($problems)
 111 { # Reset connection to try to leave messages on server.
 112   warn "Problems during download: resetting connection.\n";
 113   $pop -> reset();
 114 }
 115
 116 # Leave nicely
 117 $pop->quit();
 118
 119 if ($msgs > 0)
 120 {  exit $msgs;  }
 121 else
 122 {  exit 0; }
 123