#!/usr/local/bin/perl -w ######################################### # poetry_publisher.cgi v1.0 # # # #Written by John Drury - 2003 # #Email johnadrury@brighterhorizons.com # # # #You may use and alter this script in # #any way. # # # # # # ######################################### use Socket; $|=1; ####################################### # PROGRAM CONFIGURATION SECTION ####################################### @okaydomains=(); $DAYS=30000; # USE EITHER SMTP OR SEND_MAIL $SMTP_SERVER="localhost"; #$SEND_MAIL="/usr/lib/sendmail -t"; $HOMEDIR="/home/brighterhorizons/www"; $BASEDIR="/home/brighterhorizons/www/poems"; $SITEURL="http://brighterhorizons.com"; $BASEURL="$SITEURL/poems"; $SITENAME="Brighter Horizons Community"; $EXT=".htm"; $PROGNAME="/cgi-bin/poetry_test.cgi"; $MAILLOG="/data/authorlog.txt"; $MAINDB="/cgi-bin/rating/db/main.db"; $basedata="/cgi-bin/rating/db"; $SUBJECT ="Your poem has been published!"; ####################################### &main_driver; ####################################### ####################################### sub poem_published { ####################################### if ($MAILLOG ne "") { open (ML,">>$BASEDIR/$MAILLOG"); print ML "$fields{'author_name'}|$fields{'author_email'}|$fields{'poem_title'}|$URL_NAME\n"; close(ML); } if ($MAINDB ne "") { open (ML,">>$HOMEDIR/$MAINDB"); print ML "$id\|$fields{'poem_title'}\n"; close(ML); } open(NEW,">$HOMEDIR/$basedata/$id.db") || &error("The ID database file failed to be created."); print NEW "$id\|$fields{'poem_title'}\|0\|0\|0"; close(NEW); open(NEWIP,">$HOMEDIR/$basedata/ip$id.db") || &error("The IP Log database file failed to be created."); print NEWIP ""; close(NEWIP); print "Content-type: text/html\n\n"; print <<__STOP_OF_PUBLISHED__;

Congratulations!

Your poem has been published.
You may view your poem anytime at:

$URL_NAME

Alternatively, you may find your poem by clicking HERE.

__STOP_OF_PUBLISHED__ } ####################################### sub setup_letter { ####################################### $msgtext =<<__STOP_OF_MESSAGE__; Greetings $fields{'author_name'}, You have just published "$fields{'poem_title'}" in the online poetry section of Brighter Horizons community. All rights to your poetry shall remain yours. Your poem has been published on $date EST. We have formatted a permanent webpage for $fields{'poem_title'} at $URL_NAME. We recommend that you save this email since it also serves as a dated proof of copyright for your poem. __STOP_OF_MESSAGE__ } ####################################### sub poem_page { ####################################### $poembody =<<__END_OF_POEM_BODY__; $fields{'poem_title'} by $fields{'author_name'} $BODYTAG $params

$fields{'poem_title'}

$fields{'poem_body'}

- $fields{'author_name'}

Copyright © 2003

__END_OF_POEM_BODY__ } ####################################### sub pass_params { ####################################### $params=<<__END_OF_PARAMS__;

You agree that by publishing this poem that you are the author and that this is an original work written by you. To publish your poem, click on the "Publish" button. To return to the poem edit screen without sending, please press your browser's "BACK" button.

__END_OF_PARAMS__ } ####################################### sub sendmail { ####################################### # 1 success # -1 $smtphost unknown # -2 socket() failed # -3 connect() failed # -4 service not available # -5 unspecified communication error # -6 local user $to unknown on host $smtp # -7 transmission of message failed # -8 argument $to empty # # Sample call: # # &sendmail($from, $reply, $to, $smtp, $subject, $message ); # # Note that there are several commands for cleaning up possible bad inputs - if you # are hard coding things from a library file, so of those are unnecesssary # my ($fromaddr, $replyaddr, $to, $smtp, $subject, $message) = @_; $to =~ s/[ \t]+/, /g; # pack spaces and add comma $fromaddr =~ s/.*<([^\s]*?)>/$1/; # get from email address $replyaddr =~ s/.*<([^\s]*?)>/$1/; # get reply email address $replyaddr =~ s/^([^\s]+).*/$1/; # use first address $message =~ s/^\./\.\./gm; # handle . as first character $message =~ s/\r\n/\n/g; # handle line ending $message =~ s/\n/\r\n/g; $smtp =~ s/^\s+//g; # remove spaces around $smtp $smtp =~ s/\s+$//g; if (!$to) { return(-8); } if ($SMTP_SERVER ne "") { my($proto) = (getprotobyname('tcp'))[2]; my($port) = (getservbyname('smtp', 'tcp'))[2]; my($smtpaddr) = ($smtp =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) ? pack('C4',$1,$2,$3,$4) : (gethostbyname($smtp))[4]; if (!defined($smtpaddr)) { return(-1); } if (!socket(MAIL, AF_INET, SOCK_STREAM, $proto)) { return(-2); } if (!connect(MAIL, pack('Sna4x8', AF_INET, $port, $smtpaddr))) { return(-3); } my($oldfh) = select(MAIL); $| = 1; select($oldfh); $_ = ; if (/^[45]/) { close(MAIL); return(-4); } print MAIL "helo $SMTP_SERVER\r\n"; $_ = ; if (/^[45]/) { close(MAIL); return(-5); } print MAIL "mail from: <$fromaddr>\r\n"; $_ = ; if (/^[45]/) { close(MAIL); return(-5); } foreach (split(/, /, $to)) { print MAIL "rcpt to: <$_>\r\n"; $_ = ; if (/^[45]/) { close(MAIL); return(-6); } } print MAIL "data\r\n"; $_ = ; if (/^[45]/) { close MAIL; return(-5); } } if ($SEND_MAIL ne "") { open (MAIL,"| $SEND_MAIL"); } print MAIL "To: $to\n"; print MAIL "From: $fromaddr\n"; print MAIL "Reply-to: $replyaddr\n" if $replyaddr; print MAIL "X-Mailer: Perl Powered Socket Mailer\n"; print MAIL "Subject: $subject\n\n"; print MAIL "$message"; print MAIL "\n.\n"; if ($SMTP_SERVER ne "") { $_ = ; if (/^[45]/) { close(MAIL); return(-7); } print MAIL "quit\r\n"; $_ = ; } close(MAIL); return(1); } ####################################### sub no_email { ####################################### print <<__STOP_OF_NOMAIL__; Content-type: text/html SORRY! Your request could not be processed because of missing e-mail address(es). Please use your browser's back button to return to the poem entry page. __STOP_OF_NOMAIL__ } ####################################### sub send_mail { ####################################### &setup_letter; $mailresult=&sendmail($fields{sender_email}, $fields{sender_email}, $fields{author_email}, $SMTP_SERVER, $SUBJECT, $msgtext); } ####################################### sub poem_expire { ####################################### local(@items, $item); opendir(POEMDIR, "$BASEDIR"); @items = grep(/[0-9]$EXT/,readdir(POEMDIR)); closedir(POEMDIR); foreach $item (@items) { if (-M "$BASEDIR/$item" > $DAYS) { unlink("$BASEDIR/$item"); } } } ####################################### sub valid_address { ####################################### $testmail = $fields{'author_email'}; if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ || $testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) { return 0; } else { return 1; } } ####################################### sub bad_email { ####################################### print <<__STOP_OF_BADMAIL__; Content-type: text/html SORRY! Your request could not be processed because of an improper e-mail address. Please use your back button to return to the card screen and try again! __STOP_OF_BADMAIL__ } ####################################### sub test_basedir { ####################################### if (not -w $BASEDIR) { print <<__STOP_OF_BADBASE__; Content-type: text/html The script cannot either find or write to the
$BASEDIR directory. Please check this setting if the BASEDIR variable, and the permissions of the directory. If you have them set to 755, please change them to 777. __STOP_OF_BADBASE__ exit; } } ####################################### sub valid_page { ####################################### if (@okaydomains == 0) {return;} $DOMAIN_OK=0; $RF=$ENV{'HTTP_REFERER'}; $RF=~tr/A-Z/a-z/; foreach $ts (@okaydomains) { if ($RF =~ /$ts/) { $DOMAIN_OK=1; } } if ( $DOMAIN_OK == 0) { print "Content-type: text/html\n\n Sorry, This script cannot be run from here...."; exit; } } ####################################### sub decode_vars { ####################################### #This part of the program splits up our data and gets it #ready for formatting. $i=0; read(STDIN,$temp,$ENV{'CONTENT_LENGTH'}); @pairs=split(/&/,$temp); foreach $item(@pairs) { ($key,$content)=split(/=/,$item,2); $content=~tr/+/ /; $content=~s/%(..)/pack("c",hex($1))/ge; $content=~s/\0//g; #strip nulls $content =~ s///g; $fields{$key}=$content; $i++; $item{$i}=$key; $response{$i}=$content; } } ####################################### sub get_file_name { ####################################### $proc=$$; $newnum=time; $newnum=substr($newnum,4,5); $date=localtime(time); ($day, $month, $num, $time, $year) = split(/\s+/,$date); $month=~tr/A-Z/a-z/; $PREF = "$month$num-"; $id="$PREF$newnum$proc"; $FILE_NAME="$BASEDIR/$PREF$newnum$proc$EXT"; $URL_NAME="$BASEURL/$PREF$newnum$proc$EXT"; } ####################################### sub create_file { ####################################### open(OUTFILE,">$FILE_NAME") ; print OUTFILE "$poembody\n"; close (OUTFILE); } ####################################### sub do_preview { ####################################### $fields{'poem_body'} =~s/\"/\'/g; &pass_params; &poem_page; print "Content-type: text/html\n\n"; print "$poembody\n"; } ####################################### sub main_driver { ####################################### &valid_page; &test_basedir; &decode_vars; if ($fields{'author_email'} eq "") { &no_email; exit; } if (&valid_address == 0) { &bad_email; exit; } if ($fields{'sender_email'} eq "") { &no_email; exit; } if ($fields{'background'} ne "") { $BODYTAG="";} else { $BODYTAG="" ; } if ($fields{'action_code'} eq "NEW") { &do_preview; } if ($fields{'action_code'} eq "APPROVED") { &poem_page; &get_file_name; &create_file; &setup_letter; $mailresult=&sendmail($fields{sender_email}, $fields{sender_email}, $fields{author_email}, $SMTP_SERVER, $SUBJECT, $msgtext); &poem_published; if ($DAYS > 0) {&poem_expire;} } } ##

##