Pileus Git - ~andy/fetchmail/blob - contrib/poptest

   1 #!/usr/bin/perl
   2 # Copyright 2000 john Summerfield ,summer@os2.ami.com.au>
   3 # Your choice of licence: GPL 2 or later, or same licence as Perl.
   4 #
   5 # Warranty?                                     None
   6 # If it breaks?                                 The pieces are yours
   7 # If it breaks something?       You drove it.
   8 # Bugs?                                                 At least one.
   9
  10 # now we've cleared the air;
  11 #       This supposed to allow one to talk pop-3 to a mail server. If you're lucky (and know how)
  12 #               you might also be able to talk a few other Internet protocols with it.
  13 #       Typically, it's run thus:
  14 #               pop2test.1 <mailserver> [<mailport>]
  15 #       mailport's optional; default is 110 (pop-3).
  16 #
  17 #       Having started, you type away much as you would with telnet.
  18 #
  19 #
  20 #
  21 #       It has this great advantage over telnet: it reads its input from stdin and writes to stdout;
  22 #               you can prepare the entire sequence in a file, then run it this:
  23 #                       pop2test.1 <thefileyoujustcreated >theresultsyouwanttoperuse host port
  24 #
  25 #
  26 #       uses:
  27 #               1       Debugging POP3 (and maybe imap does anyone know?) mail problems
  28 #               2       Deleting the occasional piece of mail that's too big or stuffs fetchmail.
  29 #               3       Talking to sendmail
  30 #
  31 use Socket;
  32 sub hx;
  33 sub getreply;
  34 $timeout=1;
  35 $RemoteHost = $ARGV[0];shift;
  36 $RemotePort = $ARGV[0] || 110;shift;
  37 ($PRname,$PRaliases,$PRport,$PRproto) = getservbyname($RemotePort,'tcp');
  38 $PRport=$RemotePort unless $PRport;
  39 $proto=getprotobyname($PRproto);
  40 $RemoteIP = inet_aton $RemoteHost or die "Can't resolve $RemoteHost";
  41 $that = pack 'Sna4x8',AF_INET, $PRport, $RemoteIP;
  42 socket(REMOTESITE,AF_INET,SOCK_STREAM,$proto)
  43         or die "Can't create socket to $RemoteHost: $!\n";;
  44 connect(REMOTESITE, $that) or die "Can't connect: $!\n";
  45 select(REMOTESITE);$|=1;select STDOUT;
  46 $rin = $win = $ein = '';
  47 vec($rin,fileno(REMOTESITE),1) = 1;
  48 #vec($win,fileno(REMOTESITE),1) = 1;
  49 $ein = $rin | $win;
  50 getreply;
  51 while ($L=<STDIN>)
  52 {
  53         chomp $L;
  54         print REMOTESITE $L . "\r\n";
  55         print "send: " . $L . "\n";
  56         getreply;
  57 }
  58 print REMOTESITE "Quit\r\n";
  59 getreply;
  60 #print <REMOTESITE>;
  61 close REMOTESITE;
  62 exit;
  63 # P
  64 sub hx
  65 {
  66         $N=$_[0];shift;
  67         $S=$_[0];shift;
  68         return "$N(" . unpack("h", $S) . ") ";
  69 }
  70 sub getreply
  71 {
  72         while ('x')
  73         {
  74                 ($nfound,$timeleft) = select($rout=$rin, undef, $eout=$ein, $timeout);
  75                 last if $nfound == 0;
  76 #               print "nf($nfound) tl($timeleft) " . hx("rin",$rin) . hx("rout", $rout) . hx("ein",$ein) . hx("eout",$eout) . "\n";
  77                 $Reply= <REMOTESITE>;
  78                 print "recv: " . $Reply;
  79                 last if $Reply eq '';
  80                 $Reply =~ s/[\r\n]*//;
  81                 last if $Reply eq '.';
  82         }
  83 }
  84