[9011] in Perl-Users-Digest

home	help	back	first	fref	pref	prev	next	nref	lref	last	post

Perl-Users Digest, Issue: 2629 Volume: 8

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon May 18 14:12:23 1998

Date: Mon, 18 May 98 11:01:42 -0700
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Mon, 18 May 1998     Volume: 8 Number: 2629

Today's topics:
        Is this WEB-BASED mail script good? <vanderpan@hotmail.com>
    Re: Need a Perl Data Processing Example <monty@primenet.com>
    Re: On nt, How to invoke perl script as cgi program usi <rootbeer@teleport.com>
    Re: Please help understand $| <rootbeer@teleport.com>
    Re: regexp: replacing new line followed by "+" <jdf@pobox.com>
    Re: regexp: replacing new line followed by "+" (Mark-Jason Dominus)
        Relative Newbie Question: Multiple Form Inputs Into a L (Martin Olson)
    Re: Relative Newbie Question: Multiple Form Inputs Into <rootbeer@teleport.com>
    Re: Scanning Perl scripts for Y2K problems <keithmur@mindspring.com>
        Thinking in ed [Was: Re: New IDE for Perl] <jdf@pobox.com>
    Re: Timing a script <rootbeer@teleport.com>
    Re: uniq in perl <ravn@imada.ou.dk>
    Re: while, each & assoc array (John Moreno)
        Why does Glob change caption in Win32 console window? (Benjamin Smith)
        Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Mon, 18 May 1998 18:55:21 +0200
From: "Paul van der Pan" <vanderpan@hotmail.com>
Subject: Is this WEB-BASED mail script good?
Message-Id: <6jpp63$nh6$1@news2.xs4all.nl>


I found this perl cgi-script for Web based email (should work on Linux) on
the net,
can somebody tell me if there are big security holes in this script?

Paul

Here it is:


#!/usr/bin/perl
#
# POP3-to-WWW gateway
# GNU copyrights, freeware but al further developed versions should be
freeware as well, and
# should be spread with the source code

# Version number
$version="1.0";

# Location of the HTML form
$formpage="/~joe/popcgi.html";

# SMTP host for delivering mail, set this to a LOCAL host!
$smtphost='mail.koepoort.tudelft.nl';

# The hostname of the machine popcgi is running on. This better be correct
# if your smtphost is restrictive about HELO messages!
$hostname='mail.hotmail.com';

# Where should E-mail errors go? CHANGE THIS!
$errors='joe@hotmail.com';

print "Content-type: text/html\n\n";

use Socket;
$SIG{ALRM} = 'timeout';
$qprintable=0;

&readform;

$user=$form{"user"};
$passwd=$form{"password"};
$passwd=uuencode($passwd) if($form{"txtpwd"});
$remote=$form{"pophost"};
$mailbox=$form{"mailbox"};
$mailbox="" if ($mailbox eq "default");
$port=110; # POP3 tcp/ip port
$sport=25; # SMTP tcp/ip port

Die("You have to specify a username, password and hostname.\n")
if((!($user)) || (!($passwd)) || (!($remote)));


&popconnect;
&poplogin;
&popstat;

if($compose=$form{"compose"}) {
$message=$form{"message"};
$message=-1 if(!$message);
if($smtpto=$form{"smtpto"}) {
&header("Sending message for $user\@$remote");
&buttons;
print "<HR size=3 noshade>\n\n";

$smtpsubj=$form{"smtpsubj"};
$smtpsubj="(no subject)" if(!$smtpsubj);
$fullname=$form{"fullname"};
$smtpref=$form{"smtpref"};
$smtpdate=$form{"smtpdate"};
$smtpfrom=$form{"smtpfrom"};
$smtpcc=$form{"smtpcc"};
$smtptext=$form{"smtptext"};
$smtpself=$form{"smtpself"};

Die("Only addresses of the form user\@host.domain can be accepted.\n")
if(!is_email($smtpto) || !is_email($smtpfrom));
Die("Only addresses of the form user\@host.domain can be accepted.\n")
if($smtpcc && !is_email($smtpcc));

$smtpcc =~ s/\s+/, /go;
$smtpcc.=", " if($smtpcc && $smtpself);
$smtpcc.=$smtpfrom if($smtpself);

&smtpconnect;
&smtpsend;
&smtplogout;

print "<HR size=3 noshade>\n\n";
print "The above message was successfully sent.<P>\n";
&buttons;

} else {
&header("Composing message for $user\@$remote");
&buttons;
print "<HR size=3 noshade>\n\n";
&smtpform(-1);
print "<HR size=3 noshade>\n\n";
&buttons;
}
} elsif($reply=$form{"reply"}) {
$message=$reply;
&header("Reply to message $reply/$num of $user\@$remote $mailbox");
$quote=$form{"quote"};
&buttons;
print "<HR size=3 noshade>\n\n";
&smtpform($reply);
print "<HR size=3 noshade>\n\n";
&buttons;
} elsif($delete=$form{"delete"}) {
&header("Delete $delete/$num of $user\@$remote $mailbox");
$message=$delete;
&popdelete($delete);
print "<HR size=3 noshade>\n\n";
&buttons;
} elsif($message=$form{"message"}) {
&header("Message $message/$num of $user\@$remote $mailbox");
&buttons;
print "<HR size=3 noshade>\n\n";
&popread($message);
print "<HR size=3 noshade>\n\n";
&buttons;
} else {
&header("Mailbox $mailbox of $user\@$remote");
&indexbuttons;
print "<HR size=3 noshade>\n\n";
&popindex;
print "<HR size=3 noshade>\n\n";
&indexbuttons;
}
print "<HR size=3 noshade>\n\n";
&footer;
&poplogout;

exit;


sub uuencode {
local($uue);
$uue = pack("u",$_[0]);
chomp $uue;
$uue=~s/>/~~gt~~/go;
$uue=~s/</~~lt~~/go;
$uue=~s/"/~~qt~~/go;
$uue;
}

sub uudecode {
local($tmp,$uud);
$tmp=$_[0];
$tmp=~s/~~gt~~/>/go;
$tmp=~s/~~lt~~/</go;
$tmp=~s/~~qt~~/"/go;
$uud = unpack("u",$tmp);
$uud;
}

sub smtpconnect {
   $action="initializing connect";
   $server=$smtphost;
   alarm 60;
           $sockaddr = 'S n a4 x8';

           ($name, $aliases, $proto) = getprotobyname('tcp');
           ($name, $aliases, $sport) = getservbyname($sport, 'tcp')
               unless $sport =~ /^\d+$/;
           ($name, $aliases, $type, $len, $thisaddr) =
gethostbyname($hostname);
           ($name, $aliases, $type, $len, $thataddr) =
gethostbyname($smtphost);

           $this = pack($sockaddr, AF_INET, 0, $thisaddr);
           $that = pack($sockaddr, AF_INET, $sport, $thataddr);

           socket(SMTP, PF_INET, SOCK_STREAM, $proto) || Die("smtp socket:
$!");
           bind(SMTP, $this) || Die("smtp bind: $!");

           connect(SMTP, $that) || Die("smtp connect: $!");
           select(SMTP); $| = 1; select(STDOUT);
   alarm 0;
   smtpwait("connecting");
   print SMTP "helo $hostname\r\n";
   smtpwait("shaking hands");
}

sub popconnect {
   $action="initializing connect";
   $server=$remote;
   alarm 60;
           $sockaddr = 'S n a4 x8';
#          chomp($hostname = `hostname`);

           ($name, $aliases, $proto) = getprotobyname('tcp');
           ($name, $aliases, $port) = getservbyname($port, 'tcp')
               unless $port =~ /^\d+$/;
           ($name, $aliases, $type, $len, $thisaddr) =
gethostbyname($hostname);
           ($name, $aliases, $type, $len, $thataddr) =
gethostbyname($remote);

           $this = pack($sockaddr, AF_INET, 0, $thisaddr);
           $that = pack($sockaddr, AF_INET, $port, $thataddr);

           socket(POP, PF_INET, SOCK_STREAM, $proto) || Die("pop socket:
$!");
           bind(POP, $this) || Die("pop bind: $!");

           connect(POP, $that) || Die("pop connect: $!");

           select(POP); $| = 1; select(STDOUT);
   alarm 0;
}

sub poplogin {

waitforline("connecting");
print POP "user $user\n";
waitforline("sending username");
print POP "pass " . uudecode($passwd) . "\n";
waitforline("sending password");
if($mailbox) {
print POP "mbox $mailbox\n";
waitforline("changing mailbox");
}
}

sub popstat {

print POP "stat\n";
$_=waitforline("getting mailbox status");
($stat,$num,$bytes)=split;
}

sub popindex {
local($i,$v);
if($num<1) {
print "Mailbox $mailbox is empty.\n";
return;
}
print POP "list\n";
waitforline("reading index");
alarm 60;
loop: while(<POP>) {
chomp;
last loop if(/^\.[^\.]/o);
s/^\.\./\./o if (/^\.\./o);
($i,$v)=split;
$size[$i]=$v;
}
alarm 0;
print "<TABLE border=1>\n";
print "<tr><th></th><th>From</th>     <th><I>Subject</I></th>     ";
print "<th>Date</th>     <th>Size</th></tr>\n";
for($i=1;$i<=$#size;$i++) {
print POP "top $i 1\n";
waitforline("reading header of message " . $i);
alarm 60;
loop: while(<POP>) {
chomp;
last loop if(/^\.[^\.]/o);
s/^\.\./\./o if (/^\.\./o);
$from[$i]=$foo if(($foo)=/^From:\s+(.*)/o);
$date[$i]=$foo if(($foo)=/^Date:\s+(.*)/o);
$subject[$i]=$foo if(($foo)=/^Subject:\s+(.*)/o);
}
alarm 0;
print "<tr>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=message  VALUE=\"$i\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<td><INPUT TYPE=submit VALUE=\"$i\"></td>\n";
print "</FORM>\n";
print "<td>" . escape($from[$i]) . "\n";
print "<td><I>" . escape($subject[$i]) . "</I>\n";
print "<td>" . escape($date[$i]) . "\n";
print "<td>" . escape($size[$i]) . " bytes\n\n";
}
print "</TABLE>\n";
}

sub popread {
local($num)=$_[0];
print POP "retr $num\n";
waitforline("reading message $num");
print "<PRE>\n";
alarm 60;
loop: while(<POP>) {
last loop if(/^\.[^\.]/o);
s/^\.\./\./o if (/^\.\./o);
$qprintable=1
if (/Content-transfer-encoding: quoted-printable/io);
print escape($_);
}
alarm 0;
print "</PRE>\n";
}

sub smtplogout {
print SMTP "quit\r\n";
smtpwait("logging out");
}

sub poplogout {
if(!$delete && $num>0) {
# Some (novell) servers delete all viewed messages, so we have to do a
reset.
print POP "rset\n";
waitforline("resetting mailbox");
}
print POP "quit\n";
waitforline("logging out");
}

sub timeout {
Die("<H2>TIMEOUT</H2>\nServer $server timed out during $action.\n");
}

sub waitforline {
$action=$_[0];
$server=$remote;
alarm 30;
line: while(<POP>) {
if (/^-ERR/o) {
s/^-ERR //o;
Die("ERROR while $action: $_");
}
last line if (/^\+OK/o);
}
alarm 0;
$_;
}

sub smtpwait {
$action=$_[0];
$server=$smtphost;
alarm 30;
local($line);
recv(SMTP,$line,255,0);
local($stat,$rest)=split(/\s+/o,$line,2);
Die("ERROR while $action: $line") if($stat >= 500);
alarm 0;
$line;
}

sub readform {
local($bytes,$readbytes,$rest,$string,@pairs,$pair,$name,$value);
Die("Only POST type is supported.\n")
if ($ENV{"REQUEST_METHOD"} ne "POST");
Die("Content type not supported.\n")
      if ($ENV{"CONTENT_TYPE"} ne "application/x-www-form-urlencoded");

$bytes=$ENV{"CONTENT_LENGTH"};
$readbytes=0;
$rest=$bytes;
$string="";

while($readbytes<$bytes) {
$readbytes+=read(STDIN,$string,$rest,$readbytes);
}

@pairs = split(/\&/o,$string);

foreach $pair (@pairs) {
($name,$value)=split(/=/o,$pair);
$form{urldecode($name)}=urldecode($value);
}
}

sub urldecode {
local(@tokens,$tok,$res);
$_[0]=~s/\+/ /go;
@tokens=split(/(%..)/o,$_[0]);
foreach $tok (@tokens) {
if($tok =~ /^%/o) {
$tok=pack("H2",substr($tok,1,2));
}
$res .= $tok;
}
$res;
}

sub unquoted {
local(@tokens,$tok,$res);
@tokens=split(/(=[A-Ea-e0-9][A-Ea-e0-9])/o,$_[0]);
foreach $tok (@tokens) {
if($tok =~ /^=[A-Ea-e0-9][A-Ea-e0-9]/o) {
$tok=pack("H2",substr($tok,1,2));
}
$res .= $tok;
}
$res;
}

sub Die {
print @_;
exit;
}

sub escape {
$_ = $_[0];
if($qprintable) {
s/=(.)$/$1/o;
$_=&unquoted($_);
}
s/&/&amp;/go;
s/>/&gt;/go;
s/</&lt;/go;
s/"/&quot;/go;
return $_ if($_[1]);
# Why have mailto: links when we have SMTP! :)
# s#([^()<>&;"'` ]+@[^()<>&;"'` ]+\.[a-z]+)#<A HREF="mailto:$1">$1</A>#go;
s#([a-z]+://[^()<>&; ]+)#<A HREF="$1">$1</A>#go;
$_;
}

sub header {
print "<TITLE>" . escape($_[0],1) . "</TITLE>\n\n";
print "<H2>" . escape($_[0],1) . "</H2>\n\n";
}

sub footer {
local($hp)="http://www.neuroactive.com/~joe/popcgi.html";
print "<A HREF=\"$hp\">Popcgi</A> version $version<BR>\n";
print "&copy; 1997 joe B. (<A
HREF=mailto:joe\@neuroactive.com>joe\@neuroactive.com</A>)<P>\n";
}

sub buttons {
local($i,$j)=($message+1,$message-1);
print "<TABLE BORDER=0>\n<TR>\n";
if(!$reply && !$compose && !$delete) {
print "<TD>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=reply    VALUE=\"$message\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=submit VALUE=\"Reply\">\n";
print "</FORM>\n";
}
if(!$delete) {
print "<TD>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=delete   VALUE=\"$message\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=submit VALUE=\"Delete\">\n";
print "</FORM>\n";
}
if($j>0) {
print "<TD>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=message  VALUE=\"$j\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=submit VALUE=\"Previous\">\n";
print "</FORM>\n";
}
if(($compose || $delete) && $message>0 && $message<=$num) {
print "<TD>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=message  VALUE=\"$message\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=submit VALUE=\"Read ($message/$num)\">\n";
print "</FORM>\n";
}
if($i>0 && $i<=$num && !$delete) {
print "<TD>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=message  VALUE=\"$i\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=submit VALUE=\"Next\">\n";
print "</FORM>\n";
}
if(!$compose) {
print "<TD>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=hidden NAME=message  VALUE=\"$message\">\n";
print "<INPUT TYPE=hidden NAME=compose  VALUE=\"1\">\n";
print "<INPUT TYPE=submit VALUE=\"Compose\">\n";
print "</FORM>\n";
}
print "<TD>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=submit VALUE=\"Index\">\n";
print "</FORM>\n";
print "<TD>\n";
print "<FORM METHOD=GET ACTION=\"$formpage\">\n";
print "<INPUT TYPE=submit VALUE=\"Popcgi form\">\n";
print "</FORM>\n";
print "</TABLE>\n";
}

sub smtpform {
    local($nn)=($_[0]);
    local($new)=($nn<=0);
    if(!$new) {
print POP "retr $nn\n";
waitforline("reading message $nn");
$server=$remote;
alarm 60;
loop: while(<POP>) {
chomp;
last loop if(/^\s*$/);
s/^\.\./\./o if (/^\.\./o);
$smtpto=$foo if(($foo)=/^Return-Path:\s+<(\S+)>/oi);
$smtpto=&getaddress($_,$smtpto) if(/^From /oi);
$smtpto=&getaddress($_,$smtpto) if(/^From:\s+/oi);
$smtpto=&getaddress($_,$smtpto) if(/^Reply-To:\s+/oi);
$smtpsubj=$foo if(($foo)=/^Subject:\s+(.*)/oi);
$smtpref=$foo if(($foo)=/^Message-Id:*\s+<(.*)>/oi);
$smtpdate=$foo if(($foo)=/^Date:\s+(.*)/oi);
$qprintable=1
if (/Content-transfer-encoding: quoted-printable/io);
}
$smtpsubj = "Re: " . $smtpsubj if($smtpsubj !~ /^Re:/io);
$smtpto .= '@' . $remote if(($smtpto !~ /@/o) && ($smtpto !~ /!/o));


if(!$quote) {
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=reply    VALUE=\"$reply\">\n";
print "<INPUT TYPE=hidden NAME=quote    VALUE=\"1\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=submit VALUE=\"Quote original message\">\n";
print "</FORM>\n";
print "<P>\n";
}
    }

    print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
    print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
    print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
    print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
    print "<INPUT TYPE=hidden NAME=message  VALUE=\"$message\">\n";
    print "<INPUT TYPE=hidden NAME=compose  VALUE=\"1\">\n";
    print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
    print "<INPUT TYPE=hidden NAME=smtpto   VALUE=\"$smtpto\">\n"
if(!$compose);
    print "<INPUT TYPE=hidden NAME=smtpref  VALUE=\"$smtpref\">\n";
    print "<INPUT TYPE=hidden NAME=smtpdate VALUE=\"$smtpdate\">\n";

    print "<TABLE BORDER=0>\n";
    print "<TR>\n<TD>\nFrom (name):\n";
    print "<TD>\n<INPUT SIZE=40 NAME=fullname VALUE=\"\">\n";
    print "<TR>\n<TD>\nFrom (E-mail):\n";
    print "<TD>\n<INPUT SIZE=40 NAME=smtpfrom VALUE=\"$user\@$remote\">\n";
    if($compose) {
print "<TR>\n<TD>\nTo (E-mail):\n";
print "<TD>\n<INPUT SIZE=40 NAME=smtpto VALUE=\"$smtpto\">\n";
    } else {
print "<TR>\n<TD>To:\n<TD>\n$smtpto\n";
    }
    print "<TR>\n<TD>\nSubject:\n";
    print "<TD>\n<INPUT SIZE=40 NAME=smtpsubj VALUE=\"$smtpsubj\">\n";
    print "<TR>\n<TD>\nCopy to self:\n";
    print "<TD>\n<INPUT TYPE=checkbox NAME=smtpself VALUE=\"yes\">\n";
    print "<TR>\n<TD>\nCc:\n";
    print "<TD>\n<INPUT SIZE=40 NAME=smtpcc VALUE=\"\">\n";
    print "</TABLE>\n\n<P>\n";
    print "<TEXTAREA NAME=smtptext COLS=75 ROWS=20>\n";
    if(!$new) {
loop: while(<POP>) {
last loop if(/^\.[^\.]/o);
s/^\.\./\./o if (/^\.\./o);
print "| " . escape($_,1) if($quote);
}
    }
    alarm 0;
    print "</TEXTAREA>\n";
    print "<P>\n\n";
    print "<TABLE border=0>\n<TR>\n";
    print "<TD>\n<INPUT TYPE=submit VALUE=\"Send message\">\n";
    print "<TD>\n<INPUT TYPE=reset VALUE=\"Reset form\">\n";
    print "</FORM>\n\n";
    if(!$new && !$quote) {
print "<TD>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=reply    VALUE=\"$reply\">\n";
print "<INPUT TYPE=hidden NAME=quote    VALUE=\"1\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=submit VALUE=\"Quote original message\">\n";
print "</FORM>\n";
    }
    print "</TABLE>\n\n";

}

sub getaddress {
local($str,$old)=($_[0],$_[1]);
local($email);
$str =~ s/^[^:]+://o;
return $email if(($email)=($str =~ /\s+<(\S+@\S+)>\s*/));
return $email if(($email)=($str =~ /\s+(\S+@\S+)\s*/));
return $old;
}

sub indexbuttons {
print "<TABLE border=0>\n<TR>\n";
print "<TD>\n";
print "<FORM METHOD=POST ACTION=\"".$ENV{"SCRIPT_NAME"}."\">\n";
print "<INPUT TYPE=hidden NAME=user     VALUE=\"$user\">\n";
print "<INPUT TYPE=hidden NAME=password VALUE=\"$passwd\">\n";
print "<INPUT TYPE=hidden NAME=pophost  VALUE=\"$remote\">\n";
print "<INPUT TYPE=hidden NAME=mailbox  VALUE=\"$mailbox\">\n"
if($mailbox);
print "<INPUT TYPE=hidden NAME=message  VALUE=\"$message\">\n";
print "<INPUT TYPE=hidden NAME=compose  VALUE=\"1\">\n";
print "<INPUT TYPE=submit VALUE=\"Compose\">\n";
print "</FORM>\n";
print "<TD>\n";
print "<FORM METHOD=GET ACTION=\"$formpage\">\n";
print "<INPUT TYPE=submit VALUE=\"Popcgi form\">\n";
print "</FORM>\n";
print "</TABLE>\n";
}

sub smtpsend {

$date=&timestr;
print SMTP "mail from:$smtpfrom\n";
smtpwait("specifying sender");
print SMTP "rcpt to:$smtpto\n";
smtpwait("specifying recipient");
foreach $address (split(/[,\s]+/,$smtpcc)) {
print SMTP "rcpt to:$address\n";
smtpwait("specifying copy-recipient");
}
print SMTP "data\n";
smtpwait("starting message text");

print "<TABLE BORDER=0>\n";
print SMTP "Received: from $ENV{'REMOTE_HOST'} by $hostname with POPCGI
$version; $date\n";
print SMTP "From: $smtpfrom";
print "<TR><TD>From:<TD>$smtpfrom\n";
print SMTP " ($fullname)" if($fullname);
print "($fullname)" if($fullname);
print SMTP "\r\nTo: $smtpto\r\n";
print "<TR><TD>To:<TD>$smtpto\n";
print SMTP "Errors-To: $errors\r\n" if($errors);
print SMTP "Date: $date\r\n";
print "<TR><TD>Date:<TD>$date\n";
print SMTP "Subject: $smtpsubj\r\n";
print "<TR><TD>Subject:<TD>$smtpsubj\n";
print SMTP "Cc: $smtpcc\r\n" if($smtpcc);
print "<TR><TD>Cc:<TD>$smtpcc\n" if($smtpcc);
print "</TABLE>\n<P>\n";
print SMTP "In-Reply-To: <$smtpref> at $smtpdate\r\n" if($smtpref);
print SMTP "X-Mailer: POPCGI $version:
http://www.hotmail.com/~joe/popcgi.html\r\n";
print SMTP "Comments: Authenticated sender is <$user\@$remote>\r\n";
print SMTP "\r\n";
        $smtptext =~ s/\r\n/\n/go;
        @text=split(/\n/,$smtptext);
print "<PRE>\n";
foreach $line (@text) {
print escape("$line\n",1);
$line =~ s/^\./../o;
print SMTP "$line\r\n";
}
print "</PRE>\n";

print SMTP ".\r\n";
smtpwait("sending message text");

}

sub timestr {
    @days=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
    @months=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct',
'Nov','Dec');
    @epoch = localtime(0);
    $tzmin = $epoch[2] * 60 + $epoch[1];        # minutes east of GMT
    if ($tzmin > 0) {
        $tzmin = 24 * 60 - $tzmin;              # minutes west of GMT
        $tzmin -= 24 * 60 if $epoch[5] == 70;   # account for the date line
    }

    $tzmin/=60;

    if($tzmin<0) {
$tz='+';
    } else {
$tz='-';
    }
    $tz.='0' if(abs($tzmin)<10);
    $tz.= 100 * abs($tzmin);

    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

    $sec='0'.$sec if($sec<10);
    $min='0'.$min if($min<10);
    $hour='0'.$hour if($hour<10);
    $year+=1900;
    $year+=100 if($year<1950);

    "$days[$wday], $mday $months[$mon] $year $hour:$min:$sec $tz";
}

sub is_email {
local($str)=$_[0];
$_[0] =~ /\S+@[\S\.]+\.[\S\.]+/o;
}

sub popdelete {
Die("ERROR: Delete number out of range!\n") if($_[0]<1 || $_[0]>$num);

print POP "dele $_[0]\n";
waitforline("deleting message $_[0]");
print "Message $_[0] deleted successfully.\n";
$num--;
}





------------------------------

Date: 18 May 1998 09:29:00 -0700
From: Jim Monty <monty@primenet.com>
Subject: Re: Need a Perl Data Processing Example
Message-Id: <6jpnkc$ohg@nntp02.primenet.com>

Randal Rayborn <rrayborn@slip.net> wrote:
> I have two fixed field data files which I need to read in, join together on
> a merge key (say one for simplicity) and write out as a complete file. Does
> anyone have a good code example for this? I am specifically interested in
> the process of reading a record from one file then looping through and
> matching the key field on the other file. This is a very "COBOL-like"
> operation.
>
> Randal Rayborn, MCSE

By posting this inquiry, you demonstrate that you don't want to re-invent
the wheel, which is admirable. The "COBOL-like" two-file match program has
been written, and its name is join (the UNIX "join" command). It couples
nicely with other utilities such as sort, uniq, cut, sed, awk, Perl, etc.
Yes, the name "join" comes from where you think it comes from:  relational
data base theory.

Curiously, the join command is not covered on the MCSE exam.

-- 
Jim Monty
monty@primenet.com
Tempe, Arizona USA


------------------------------

Date: Mon, 18 May 1998 16:47:14 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: James <hyang@flash.net>
Subject: Re: On nt, How to invoke perl script as cgi program using apache?
Message-Id: <Pine.GSO.3.96.980518094500.28732S-100000@user2.teleport.com>

On Mon, 18 May 1998, James wrote:

> On nt, how to invoke perl script as cgi program using apache?

You configure your server properly. If you're not sure how to do that,
check with the many sources of server-related information, such as docs,
FAQs, and newsgroups about servers in general and your server in
particular. If you get your server to call the script and have questions
about CGI scripting, there are docs, FAQs, and newsgroups about CGI
scripting as well. Good luck! 

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



------------------------------

Date: Mon, 18 May 1998 16:51:40 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: Yong Huang <yong@shell.com>
Subject: Re: Please help understand $|
Message-Id: <Pine.GSO.3.96.980518095026.28732U-100000@user2.teleport.com>

On Mon, 18 May 1998, Yong Huang wrote:

> Isn't flushing every "print"ed string immediately called "buffer is
> turned off"?

No; it's called "putting text into the buffer, then flushing the buffer".
Hope this helps!

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



------------------------------

Date: 18 May 1998 13:08:18 -0500
From: Jonathan Feinberg <jdf@pobox.com>
To: "Lemaitre, Laurent" <r29173@email.sps.mot.com>
Subject: Re: regexp: replacing new line followed by "+"
Message-Id: <som7zc31.fsf@mailhost.panix.com>

"Lemaitre, Laurent" <r29173@email.sps.mot.com> writes:

> In a text file I want to replace a newline by a space
> only when the newline is followed by a +.

   s{               # replace
      \n            # a newline
      (?= \+ )      # followed by a literal +
    }{\ }xg;        # with a space

> I tried different options (/s,/m/ and so on) but all failed.

Throwing modifiers at a regex without understanding their meaning is
considered harmful.  The /s modifier makes the . metacharacter match
newlines; the /m modifier makes the ^ and $ metacharacters match at
the beginning and end of any *line* within a string, as opposed to
only at the beginning and end of the whole string.  The important
concept here is the zero-width lookahead assertion.  Please see the
perlre doc for details.  I hope this helps.

-- 
Jonathan Feinberg   jdf@pobox.com   Sunny Brooklyn, NY
http://pobox.com/~jdf/


------------------------------

Date: 18 May 1998 13:27:10 -0400
From: mjd@op.net (Mark-Jason Dominus)
Subject: Re: regexp: replacing new line followed by "+"
Message-Id: <6jpr1e$btv$1@monet.op.net>
Keywords: carryover credo titillate vogue


In article <356052BC.670E@email.sps.mot.com>,
Lemaitre, Laurent <r29173@email.sps.mot.com> wrote:
>In a text file I want to replace a newline by a space
>only when the newline is followed by a +.

	#!/usr/bin/perl
	$complete_line = '';
	$CONTINUATION_PAT = '^\+'; # Continuation lines begin with `+'.
	while (<>) {
	  if (/$CONTINUATION_PAT/o) {
	    chomp $complete_line;
	    $complete_line .= ' ' . $_;
	    next;
	  } else {
	    print $complete_line;
	    $complete_line = $_;
	  }
	}
	print $complete_line;


This may also work:

	$/ = undef;
	($file = <>) =~ s/\n\+/ +/g;
	print $file;




------------------------------

Date: Mon, 18 May 1998 12:50:35 -0400
From: martin@dissemination.com (Martin Olson)
Subject: Relative Newbie Question: Multiple Form Inputs Into a List Array
Message-Id: <martin-1805981250370001@1cust47.tnt6.nyc3.da.uu.net>

Hey there...
   I've been working on this script and though I've got some exprience
with Perl, oddly enough I've never had to figure this out before... So the
Question is:

How do I get a bunch of form fields which all have the same name into a
List array using something like cgi-lib or cgi.pm?

These would be coming from input like, say for example  

"http://www.domain.com/cgi-bin/ascript.pl?venue=new+york&date=12598&venue=sheboingan&date=13598"

What kind of code do I need to write to get this to happen. I'm sure it's
something glaringly simple, but I can't figure it out for the life of
me...

thanks in advance.

-Martin


------------------------------

Date: Mon, 18 May 1998 17:54:36 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: Martin Olson <martin@dissemination.com>
Subject: Re: Relative Newbie Question: Multiple Form Inputs Into a List Array
Message-Id: <Pine.GSO.3.96.980518105314.28732a-100000@user2.teleport.com>

On Mon, 18 May 1998, Martin Olson wrote:

> Subject: Relative Newbie Question: Multiple Form Inputs Into a List Array

Please check out this helpful information on choosing good subject
lines. It will be a big help to you in making it more likely that your
requests will be answered.

    http://www.perl.com/CPAN/authors/Dean_Roehrich/subjects.post

> How do I get a bunch of form fields which all have the same name into a
> List array using something like cgi-lib or cgi.pm? 

(You probably mean "array", not "list array" - there's no such thing as a
"list array"! :-)  CGI.pm explains this in its docs. Hope this helps! 

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



------------------------------

Date: Mon, 18 May 1998 11:21:32 -0500
From: "Keith G. Murphy" <keithmur@mindspring.com>
Subject: Re: Scanning Perl scripts for Y2K problems
Message-Id: <3560600C.43A634B9@mindspring.com>

Bart Lateur wrote:
> 
> Randal Schwartz wrote:
> 
> >Bart> localtime() Y2K compliant? Yeah, right. Calculating years since 1900 is
> >Bart> dubious, to say the least.
> 
> >Uh?  Huh?  Maybe dubious to you.  Not at all dubious to me.
> 
> >I'm just not following.
> 
> You're doing this on purpose? ;-)
> 
> Well OK. Why did they pick 1900 as a starting date? Why not 1922? That
> would make just as much sense. So now we're in year 66. Makes sense. :-)
> 
> It would, at least, have the benifit of preventing people into treating
> it as a 2-digit representation of the year. Whoops, there go most of the
> Y2K bugs. In short: it is part of the problem.
> 
> >Or are you saying that anything that references Unix Epoch (seconds
> >since jan 1, 1970) is *also* dubious because it has a basepointer
> >that's not the year 0?
> 
> 1970 was picked ONLY because if they had taken 1900 as a starting date,
> they would have already run out of seconds (in a 32-bit integer
> representation) by the time they started.
> 
> OTOH, I don't think anybody should start counting seconds since the
> beginning of Christian time, as different countries have corrected their
> calendar at different moments in time. But all before 1970. And even
> before 1900.
> 
Mmmm, if you mean the Julian-to-Gregorian conversion, the big exception
would be Russia, which didn't convert until the Revolution.


------------------------------

Date: 18 May 1998 12:58:48 -0500
From: Jonathan Feinberg <jdf@pobox.com>
Subject: Thinking in ed [Was: Re: New IDE for Perl]
Message-Id: <u36nzciv.fsf_-_@mailhost.panix.com>

lassehp@imv.aau.dk (Lasse Hillerxe Petersen) writes:

> (I *still* can't remember what the code is to get out of EMACS,
> except ^Z and a kill; at least ESC :q makes _some_ sense)

Only to a dyed-in-the-wool Unix monger does ESC :q "feel right" as a
way to quit a program.  It reminds me of my Bar Mitzvah, in which (I
was told), during my translation of the day's Torah passage, several
chunks came out in Hebrew.  I *thought* I was translating, but "eretz
mitzraim" just felt right.

Is this OT?  (Off topic?  Old Testament?)

-- 
Jonathan Feinberg   jdf@pobox.com   Sunny Brooklyn, NY
http://pobox.com/~jdf/


------------------------------

Date: Mon, 18 May 1998 16:49:46 GMT
From: Tom Phoenix <rootbeer@teleport.com>
To: Andrew Hearn <andrew@ctec.org.uk>
Subject: Re: Timing a script
Message-Id: <Pine.GSO.3.96.980518094831.28732T-100000@user2.teleport.com>

On Mon, 18 May 1998, Andrew Hearn wrote:

> Can any one tell me how I can get the time the script takes to run?
> 
> EG. in a search script, the script searches and returns the result with
> the time it took.

Perhaps you want the time function, documented in perlfunc. You may wish
to call it at the start of your routine and again at the end. Hope this
helps! 

-- 
Tom Phoenix       Perl Training and Hacking       Esperanto
Randal Schwartz Case:     http://www.rahul.net/jeffrey/ovs/



------------------------------

Date: Mon, 18 May 1998 18:32:29 +0200
From: Thorbjoern Ravn Andersen <ravn@imada.ou.dk>
Subject: Re: uniq in perl
Message-Id: <3560629D.41C6@imada.ou.dk>

Scott Webster Wood - TheWild Webster wrote:

> I have a short 'uniq' like routine that I wrote for a script at one point.

When the whole file fits in memory, it is much nicer to use an
associative array:

$ cat whatever | perl -ne 'print if (! $seen_before{$_}++)'


Regards
--
  Thorbjxrn Ravn Andersen               "...and...Tubular Bells!"
  http://www.mip.ou.dk/~ravn/
  <<Replies get spamfiltered.  See URL for fast reply-address>>


------------------------------

Date: Mon, 18 May 1998 16:18:40 GMT
From: phenix@interpath.com (John Moreno)
Subject: Re: while, each & assoc array
Message-Id: <1d982ps.1cdon0b158dtq3N@roxboro0-027.dyn.interpath.net>

Tom Christiansen <tchrist@mox.perl.com> wrote:

> Probably what's happening here is that you have CBD (C brain damage).
> This is causes by the fact that an if, while, or for statement
> can take as its target either one single statement, sans braces, or 
> or a multiline block enclosed with braces.  The perpetual fear, not
> altogether without justification, is that someone might forget the opening
> brace, and end up with 

-snip-

Yeah, I don't know who should be given the credit for it, but perls
alternative for the single statement  (statement condition;) is much
better.

-- 
John Moreno


------------------------------

Date: Mon, 18 May 1998 12:31:30 -0500
From: benbean@yahoo.com (Benjamin Smith)
Subject: Why does Glob change caption in Win32 console window?
Message-Id: <MPG.fca2c6943d8bdfc989680@news.ionet.net>

Hi,

I'm using Glob within a Win32 Perl script. The process that it creates 
appears to take over the original console process so that the caption in 
the console window changes to "PERLGLOB".

Does anybody know how to prevent this?

Thanks!


------------------------------

Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 8 Mar 97)
Message-Id: <null>


Administrivia:

The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc.  For subscription or unsubscription requests, send
the single line:

	subscribe perl-users
or:
	unsubscribe perl-users

to almanac@ruby.oce.orst.edu.  

To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.

The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.

The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.

For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V8 Issue 2629
**************************************

home	help	back	first	fref	pref	prev	next	nref	lref	last	post