#!/usr/local/bin/perl # guestbook.cgi # the first line of this script may have to be changed # if your system's Perl interpreter is not located in /usr/bin/perl # Written by P. Lutus Ashland, Oregon lutusp@arachnoid.com -- July 30, 1997 # This script reads a web page form output and creates a guest book entry # the field names are (in order, case-sensitive): # name, email, homepage, pagename, reference, other, message # this program currently requires name and email to have nonblank entries. # call this program from a Web page form like this: #
# # See my page at http://www.arachnoid.com/lutusp/guestbook/template.html for an example # # notice that you can have as many Ownername entries that you want, each creates its own guest book file. # # 8/20/96 modification. You can now send E-mail for each guestbook entry. # # if the variable $recipemail is nonblank, # this script will automatically send e-mail to the specified address # containing the data in the guest book entry. # # the directory in which this program is located must have world read and write permission, # this Perl script must have world execute permission. # # Because this script uses sockets, the Perl resource file sockets.pm must be made available # to the Perl interpreter. $local = $ENV{'PERLXS'}; # only defined locally if($local) { # local machine testing only $localhost = $ENV{'COMPUTERNAME'}; # only works on NT $remotehost = "pl_gamma.com"; $recipname = "Paul Lutus"; $recipemail = "test\@pl_gamma.com"; } else { # chop($localhost = `hostname`); $localhost = "arachnoid.com"; $remotehost = "arachnoid.com"; $recipname = "Paul Lutus"; $recipemail = "lutus\@arachnoid.com"; } $smtpPort = 25; # reader section $maxflds = 7; # fields in submission $maxrecs = 25; # This program throws away any records older than $maxrecs, you can set any value $recipient = "lutus\@arachnoid.com"; @blacklist = ( # people who cannot use the guestbook ); # # End user-defined values # $username = "Anonymous"; if($ENV{'QUERY_STRING'} ne "") { $username = $ENV{'QUERY_STRING'}; # the real mailbox owner } $title = "$username\'s Guest Book"; # the title block that appears in the output $heading = "Please sign $username\'s Guest Book"; # the message block that appears in the output $error1 = ""; $error2 = ""; @envname = ( # these are fields that are stored along with the visible message 'REMOTE_ADDR', 'REMOTE_HOST', 'HTTP_REFERER', 'HTTP_USER_AGENT', 'HTTP_ACCEPT', ); $mailok = 0; $resetfields = 0; test_entry(); make_page(); sub test_entry { if ($ENV{'REQUEST_METHOD'} eq 'POST') { read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @pairs = split(/&/, $buffer); $top = 0; foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; $name =~ s/~!/ ~!/g; # Stop people from using subshells to execute commands $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; $value =~ s/\r//g; # wipe out carriage returns $value =~ s/\n/\f/g; # replace linefeeds with formfeeds to not confuse the parser $value =~ s/~!/ ~!/g; # Stop people from using subshells to execute commands $FORM{$name} = $value; $allData .= " " . $value; # this is used for blacklist test $anams[$top] = $name; $avals[$top++] = $value; } if(!($FORM{'homepage'} =~ "http://")) { $FORM{'homepage'} = "http://" . $FORM{'homepage'}; } $tempname = $username . ".tmp"; $mbxname = $username . ".mbx"; $testmsg = $FORM{'message'}; $emailerr = (!($FORM{'email'} =~ /[\w|\.]+\@[\w|\.]+/)); # is this e-mail address? if(!$emailerr) { $emailerr = test_email_address($FORM{'email'}); # is the email address valid? } $htmlerr = ($testmsg =~ s/<.*>//isg); # HTML tags in message $blacklisterr = test_blacklist($allData); if((!$htmlerr) && ($FORM{'message'} ne "") && ($FORM{'name'} ne "") && (!$emailerr) # valid entry must have these three nonblank && (!$blacklisterr)) { # valid entry must have these three nonblank open (OUTPUT,">$tempname") || die "Can't open $tempname!"; $dt = &readtime; print OUTPUT "$dt"; # first field is date and time for($i = 0;$i < $maxflds;$i++) { print OUTPUT "\t$avals[$i]"; } foreach $envlbl (@envname) { # these special fields are not normally visible print OUTPUT "\t$ENV{$envlbl}"; } print OUTPUT "\n"; if(-e $mbxname) { open (INPUT,$mbxname); $r = 0; while() { if($r < $maxrecs) { # This tosses old messages > $maxrecs print OUTPUT; } $r++; } close INPUT; } close OUTPUT; # now move temp file onto mailbox file open(INDATA,"$tempname"); undef $/; open (OUTDATA,">$mbxname"); $q = ; print OUTDATA $q; close INDATA; close OUTDATA; $/ = "\n"; # send mail if set up if($recipemail ne "") { setupSocket($localhost,$remotehost,$smtpPort); queryAndResp("",0); queryAndResp("HELO arachnoid.com",0); send_mail($FORM{'name'},$FORM{'email'},$recipname,$recipemail); queryAndResp("QUIT",0); close MAIL; } $heading = "Thanks for signing $username\'s Guest Book!"; } else { # not enough entries if($htmlerr) { $heading = "Sorry!"; $error1 .= "Your message contains HTML tags."; $error2 .= "Please submit a text-only message."; } elsif($emailerr) { $heading = "Sorry!"; $error1 .= "You have not provided a valid e-mail address (or your ISP is not responding)."; $error2 .= "Please provide more information."; } elsif($blacklisterr) { $heading = "Sorry!"; $error1 .= "You have been blacklisted for misuse of this guestbook."; $error2 .= "Please e-mail lutusp\@arachnoid.com if you believe this to be in error."; } else { $heading = "Sorry!"; $error1 .= "You must enter at least your name, E-mail address and a message."; $error2 .= "Please provide more information."; } $resetfields = 1; # put field values back } } } # end test_entry # generator section # This is the main routine that creates a web page from a guest book DB file sub make_page { open(DATA,"template.html"); undef $/; $data = ; close DATA; $/ = "\n"; $block = makeblock($username); if($error1 ne "") { $error1 .= "
"; } if($error2 ne "") { $error2 .= "
"; } $data =~ s/\[messages\]/$block/s; $data =~ s/\[title\]/$title/s; $data =~ s/\[heading\]/$heading/s; $data =~ s/\[error1\]/$error1/s; $data =~ s/\[error2\]/$error2/s; if(!$resetfields) { undef %FORM; undef @FORM; } if(!$FORM{'homepage'}) { # make default entry $FORM{'homepage'} = "http://"; } $data =~ s/\[namefield\]/$FORM{'name'}/s; $data =~ s/\[emailfield\]/$FORM{'email'}/s; $data =~ s/\[homepagefield\]/$FORM{'homepage'}/s; $data =~ s/\[pagenamefield\]/$FORM{'pagename'}/s; $data =~ s/\[otherfield\]/$FORM{'other'}/s; $msg = $FORM{'message'}; $msg =~ s/\f/\n/g; # get back the linefeeds $data =~ s/\[messagefield\]/$msg/s; if(!$local) { print "Content-type:text/HTML\n\n"; } print "$data\n"; } # this is the subroutine that reads the database and converts it into HTML sub makeblock { local ($user) = @_; @title = ( "
\"(letter ", "'s Guest Book Messages:

" ); $table_head = "

\n
\n"; @table_line = ( "\n" ); $table_tail = "
", "", "

\n

\n"; @fieldname = ( 'Message Time', 'Name', 'E-mail Address', 'Home Page', 'Home Page Name', 'How Found', 'How Found', 'Message' ); $str_space = "   "; $char_tab = 9; $char_lf = 10; $char_ff = 12; $datablock = ""; open(INPUT,"$user.mbx"); while () { chop; # throw out the last lf s//>/g; # replace all > with equivalent literal s/\f/
/g; # replace all ff with
tags @vals = split(/\t/); # split on tabs $datablock .= $table_head; for ($i = 0;$i < 8;$i++) { if(($i==2) && ($vals[$i] ne "")) { $datablock .= "$table_line[0]$fieldname[$i]:"; if($vals[$i] ne "") { $datablock .= "$table_line[1]$vals[$i]"; } $datablock .= $table_line[2]; } elsif ($i==3) { if(($vals[$i] ne "") && ($vals[$i] ne "http://")) { $datablock .= "$table_line[0]$fieldname[$i]:"; if($vals[$i+1] ne "") { # use provided name or link name if not $hpn = $vals[$i+1]; } else { $hpn = $vals[$i]; } if(($vals[$i] ne "") && (!($vals[$i] =~ /http:\/\//))) { $vals[$i] = "http://" . $vals[$i]; # must have prefix } $datablock .= "$table_line[1]$hpn"; $datablock .= $table_line[2]; } $i++; # an extra increment -- pass up the home page name } elsif($i == 5) { if(($vals[$i] ne "") && ($vals[$i] ne "Other - enter below")) { $datablock .= "$table_line[0]$fieldname[$i]:$str_space$table_line[1]$vals[$i]$table_line[2]\n"; } } else { if($vals[$i] ne "") { $datablock .= "$table_line[0]$fieldname[$i]:$str_space$table_line[1]$vals[$i]$table_line[2]\n"; } } } $datablock .= $table_tail; } close INPUT; return $datablock; } # end makeblock sub readtime { local (@wdnames) = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); local (@mnames) = ('January','February','March','April','May','June','July','August','September','October','November','December'); local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); sprintf ("%s, %s %2.0f, %4.0f %2.0f:%02.0f:%02.0f",$wdnames[$wday],$mnames[$mon],$mday,($year>50)?$year+1900:$year+2000, $hour,$min,$sec); # on stack for return } sub send_mail { # mail to address in hidden "sendmail" field local ($fromname,$fromaddr,$toname,$toaddr) = @_; # I just love named variables. local $print_format = "%-24s = %s\n"; # set this up once and use it on all lines if(!($fromaddr =~ /[\w|\.]+\@[\w|\.]+/)) { # if not a valid e-mail address $fromaddr = "nobody\@arachnoid.com"; } $fromaddr = "<$fromaddr>"; $toaddr = "<$toaddr>"; queryAndResp("MAIL From: $fromaddr",0); queryAndResp("RCPT To: $toaddr",0); queryAndResp("DATA",0); $dt = readtime(); $message = "To: $toname $toaddr\n"; $message .= "From: $fromname $fromaddr\n"; $message .= "Subject: Guestbook Entry from $fromname\n\n"; $message .= sprintf $print_format,"Date/Time",$dt; for($i = 0; $i < $maxflds;$i++) { if($anams[$i] eq "message") { $avals[$i] =~ s/\f/\n/g; # replace formfeeds with linefeeds so mail can stand it $avals[$i] =~ s/\n\./\n\.\./sg; # don't let terminating line through $avals[$i] = "\n\n************\n\n" . $avals[$i] . "\n\n************\n"; # dress up the message block } $message .= sprintf $print_format,$anams[$i],$avals[$i]; } foreach $envlbl (@envname) { # these special fields are not normally visible $message .= sprintf $print_format,$envlbl,$ENV{$envlbl}; } queryAndResp($message . "\n.\n",0); } sub test_blacklist { local($data) = @_; $blerr = 0; for $t (@blacklist) { $blerr ||= ($data =~ /$t/sig); } return $blerr; } sub test_email_address { # test using VRFY and RCPT as required local ($email) = @_[0]; local ($account,$server) = split("\@",$email); local ($err) = setupSocket($localhost,$server,$smtpPort); # mormal form servername.com if($err) { $err = setupSocket($localhost,"mail\." . $server,$smtpPort); # try mail.servername.com if($err) { $err = setupSocket($localhost,"smtp\." . $server,$smtpPort); # try smtp.servername.com if($err) { return 1; } } } $mailerr = 0; queryAndResp("",0); queryAndResp("HELO arachnoid.com",0); queryAndResp("MAIL From: elvis\@graceland.com",0); local ($ckresp) = queryAndResp("RCPT To: $email",0); # non-relay sites will fail this call $mailerr = (!($ckresp =~ m/^250/)); if($mailerr) { $ckresp = queryAndResp("VRFY $email",0); # non-verify sites will fail this call $mailerr = (!($ckresp =~ m/^250/)); } queryAndResp("QUIT",0); close MAIL; return $mailerr; } sub setupSocket { # local host, remote host, port use Socket; my($localhost,$remote,$port) = @_; my($iaddr, $paddr, $proto, $line, $output); $sockaddr = 'S n a4 x8'; if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') } return 1 unless $port; ($name,$aliases,$addrtype,$length,@alladdr) = gethostbyname($localhost) || return 1; $thisaddr = $alladdr[$#alladdr]; # use last on list -- usually assigned address $thataddr = gethostbyname($remote) || return 1; $this = pack($sockaddr, AF_INET, 0, $thisaddr); $that = pack($sockaddr, AF_INET, $port, $thataddr); $proto = getprotobyname('tcp'); socket(MAIL, PF_INET, SOCK_STREAM, $proto) || return 1; bind(MAIL, $this) || return 1; connect(MAIL, $that) || return 1; select(MAIL); $| = 1; select(STDOUT); return 0; } sub queryAndResp { local ($query,$multi) = @_; if($query ne "") { print MAIL "$query\n"; } $data = ""; local $inline; do { $inline = ; $inline =~ s/[\r|\n]//g; # remove all cr/lf chars $data .= $inline . "\n"; } while(($multi) && ($inline ne ".")); # multi-line terminator return $data; } sub trace { local ($tracedata) = @_[0]; open (DATA,">>temp.txt"); print DATA "$tracedata\n"; close DATA; print "Content-type:text/plain\n\n$tracedata\n"; }