#!/usr/bin/perl # Do NOT remove the line above. Set this to the location of your Perl implementation ############################################################################### # TalkBack $version = "v1.0"; # Copyright 2000 - Way to the Web Limited # URL: http://www.waytotheweb.com # Email: sales@waytotheweb.com ############################################################################### # Start User Configurable Variables # # This software is distributed under the GNU GPL, which you can read at this # link: http://www.gnu.org/copyleft/gpl.html. This is essential reading. It will # outline the limits to which you may use/install/modify this product. # # Change this password now. It allows you to enter the Administrative sections of # TalkBack and should be changed as all installations are sent with this set. $admin_password = "zachary"; # # Set this to 0 if you do not wish to receive notification when a new response is # added. $send_admin = 1; # # Set your mail address for receiving notification when a new response is added. # remember that you must prefix the @ with a \ # (e.g. support@waytotheweb.com would be written support\@waytotheweb.com) $admin_mail = "webmaster\@FrugalVillage.net"; # # Set your local SMTP server for sending notification mails through. If you do not # have a local SMTP server, set the $send_admin variable to 0 so that no attempt is # made to send mail. # (e.g. mail.waytotheweb.com) $smtp_server = "mail.serve.com"; # # Enter the url to this script # (e.g. http//www.waytotheweb.com/cgi-bin/money.cgi) $talkbackscripturl = "http://www.FrugalVillage.com/articles/money.cgi"; # # Enter the path (not url) to the talkback files directory - remember REQUIRES trailing / # (e.g. /www/chirpy/talkback/) $talkbackdir = "/home/virtual/site1/fst/var/www/html/articles/talkback/"; # # If you have problems when file updates are meant to occur, it could be that your # server software does not support file locking. You can disable file locking by setting # $flock = 0; However, you must be aware that without file locking, there is always the # possibility that file corruption problems can occur. # $flock = 1; # # End User Configurable Variables ############################################################################### # start $articles_file = $talkbackdir."money.txt"; $template_file = $talkbackdir."template.txt"; $article_template_file = $talkbackdir."money_temp.txt"; &main; sub end { ©right; exit; } ############################################################################### # start main sub main { &process_form; print "Content-type: text/html\n\n"; $admin = 0; if ($FORM{'admin'} eq "on") {$admin = 1;} if (($FORM{'action'} eq "list") or ($buffer eq "")) {&list_articles;} if ($FORM{'action'} eq "view") {&view_article;} if ($FORM{'action'} eq "admin") {&view_admin;} if (($FORM{'action'} eq "Preview") or ($FORM{'action'} eq "Preview Again")) {&preview_article;} if ($FORM{'action'} eq "Add Response") {&add_reply;} if ($FORM{'password'} ne $admin_password) {&password_failure;} if ($FORM{'action'} eq "Administration") {&administration;} if ($FORM{'action'} eq "Delete Reply") {&delete_reply;} if ($FORM{'action'} eq "Delete Article") {&delete_article;} if ($FORM{'action'} eq "Add Article") {&add_article;} } # end main ############################################################################### # start view_admin sub view_admin { print "
$article\n". "\n"; } else { $display_articles .= "$title by \n". "$author \n
$total_replies $response_text
$article\n". "\n"; } if ($x > 0) {$display_articles .= "
$total_replies $response_text
\n"; $article_detail[@article_detail] .= ""; } else { @article_detail = "$article_head
\n"; } else { $article_detail[$replytitle] = "[Respond to this Article] [Return to Articles List] \n". "
".($x+1).". \n". "Response from $author\n"; } $num_reply++; } push (@article_detail, "[Return to Articles List] \n". "$nextprev Respond to this article:
\n". "\n". "[Return to Articles List] \n"); $template_rec =~ s//@article_detail/; print $template_rec; } else { print "$template_rec\n"; } } close (TEMPLATEFILE); &end; } # end view_article ############################################################################### # start preview_article sub preview_article { print " TalkBack Administration "; if ($FORM{'author'} eq "") { print "Author Field incomplete "; &end; } if ($FORM{'email'} eq "") { print "Email Field incomplete "; &end; } if ($FORM{'reply'} eq "") { print "Response Field incomplete "; &end; } if ((length $FORM{'email'} < 5) || ($FORM{'email'} !~ /@/)) { print "Invalid Email Field "; &end; } print ""; &end; } # end preview_article ############################################################################### # start delete_reply sub delete_reply { $article_file = $FORM{'name'}.".txt"; open (ARTICLEFILE,"<$talkbackdir$article_file") or die "Cannot open $article_file"; while ($article = Your Response will appear as follows:
\n"; print "\n"; print "
"; print "\n"; print "Response from $FORM{'author'} on $fulldate\n"; $FORM{'reply'} =~ s/\r//g; $reply = $FORM{'reply'}; $FORM{'reply'} =~ s/\n/
/g; print "$FORM{'reply'}"; print "You can change your text here if you wish:
"; print ") { chomp ($article); push (@article_detail, $article); } close (ARTICLEFILE); $this_article = 0; open (ARTICLESFILE,"<$articles_file") or die "Cannot open $articles_file"; while ($article= ) { chomp ($article); push (@articles, $article); ($name,$author,$email,$title,$date,$article,$reply_files) = split (/;;/,$article); if ($name eq $FORM{'name'}) {$this_article = @articles-1;} } close (ARTICLESFILE); ($name,$author,$email,$title,$date,$article,$reply_files) = split (/;;/,$article_detail[0]); @reply_list = split(/,/,$reply_files); $updated_article = "$name;;$author;;$email;;$title;;$date;;$article;;"; $updated_replies = 0; foreach $reply (@reply_list) { if ($reply ne $FORM{'reply'}) { if ($updated_replies eq 0) { $updated_article .= $reply; } else { $updated_article .= ",$reply"; } $updated_replies++; } } $article_detail[0] = $updated_article; $articles[$this_article] = $updated_article; $article_file = $FORM{'name'}.".txt"; open (ARTICLEFILE,">$talkbackdir$article_file") or die "Cannot open $article_file"; if ($flock == 1) {flock (ARTICLEFILE, 2);} foreach $article (@article_detail) { print ARTICLEFILE "$article\n"; } close (ARTICLEFILE); open (ARTICLESFILE,">$articles_file") or die "Cannot open $articles_file"; if ($flock == 1) {flock (ARTICLESFILE, 2);} foreach $article (@articles) { print ARTICLESFILE "$article\n"; } close (ARTICLESFILE); $reply_file = $FORM{'name'}.$FORM{'reply'}.".txt"; unlink ($reply_file); print " TalkBack Administration "; print "\n"; &end; } # end delete_reply ############################################################################### # start delete_article sub delete_article { print " Response Deleted
\n"; print "Return To Reading ArticlesTalkBack Administration "; open (ARTICLESFILE,"<$articles_file") or die "Cannot open $articles_file"; while ($article=) { chomp ($article); push (@articles, $article); } close (ARTICLESFILE); open (ARTICLESFILE,">$articles_file") or die "Cannot open $articles_file"; if ($flock == 1) {flock (ARTICLESFILE, 2);} foreach $article (@articles) { chomp ($article); ($name,$author,$email,$title,$date,$text,$reply_files) = split (/;;/,$article); if ($name ne $FORM{'name'}) { print ARTICLESFILE "$article\n"; } } close (ARTICLESFILE); $reply_file = $FORM{'name'}.$FORM{'reply'}.".txt"; unlink ($reply_file); @reply_list = split (/,/,$reply_files); foreach $reply_file (@reply_list) { $file = $FORM{'name'}.$FORM{'reply'}."$reply_file\.txt"; unlink ($file); } print " \n"; &end; } # end delete_article ############################################################################### # start add_reply sub add_reply { print " Article Deleted
\n"; print "Return To Reading ArticlesTalkBack Administration "; $article_file = $FORM{'name'}.".txt"; open (ARTICLEFILE,"<$talkbackdir$article_file") or die "Cannot open $article_file"; while ($article =) { chomp ($article); push (@article_detail, $article); } close (ARTICLEFILE); $this_article = 0; open (ARTICLESFILE,"<$articles_file") or die "Cannot open $articles_file"; while ($article= ) { chomp ($article); push (@articles, $article); ($name,$author,$email,$title,$date,$article,$reply_files) = split (/;;/,$article); if ($name eq $FORM{'name'}) {$this_article = @articles-1;} } close (ARTICLESFILE); ($name,$author,$email,$title,$date,$article,$reply_files) = split (/;;/,$article_detail[0]); @reply_list = split(/,/,$reply_files); if (@reply_list > 0) { $last_reply = $reply_list[@reply_list-1]; $last_reply++; if (length($last_reply) eq 1) {$last_reply = "0".$last_reply;} $article_detail[0] .= ",$last_reply"; $articles[$this_article] .= ",$last_reply"; } else { $last_reply = "01"; $article_detail[0] .= "$last_reply"; $articles[$this_article] .= "$last_reply"; } $article_file = $FORM{'name'}.".txt"; open (ARTICLEFILE,">$talkbackdir$article_file") or die "Cannot open $article_file"; if ($flock == 1) {flock (ARTICLEFILE, 2);} foreach $article (@article_detail) { print ARTICLEFILE "$article\n"; } close (ARTICLEFILE); open (ARTICLESFILE,">$articles_file") or die "Cannot open $articles_file"; if ($flock == 1) {flock (ARTICLESFILE, 2);} foreach $article (@articles) { print ARTICLESFILE "$article\n"; } close (ARTICLESFILE); $FORM{'reply'} =~ s/\r//g; $FORM{'reply'} =~ s/\n/
/g; $reply_file = $FORM{'name'}.$last_reply.".txt"; open (REPLYFILE,">$talkbackdir$reply_file"); if ($flock == 1) {flock (REPLYFILE, 2);} print REPLYFILE "$FORM{'author'};;$FORM{'email'};;$FORM{'date'}\n".$FORM{'reply'}; close (REPLYFILE); if ($send_admin == 1) { $body = "$FORM{'author'} ($FORM{'email'}) responded to \"$title\" at\n\n"; $body .= "$talkbackscripturl\n"; &send_mail ($FORM{'email'}, $admin_mail, "TalkBack, Response to \"$title\"", $body); } print "Your Response Has Been Posted
\n"; print "Return To Reading Articles\n"; &end; } # end add_reply ############################################################################### # start process_form sub process_form { $buffer = $ENV{'QUERY_STRING'}; if ($buffer eq "") {read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});} @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{$name} = $value; } ($seconds,$minutes,$hours,$monthday,$month,$year,$weekday,$yearday,$isdst) = localtime(time); @weekdays = split (/,/,"Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday"); @months = split (/,/,"Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec"); if (length("$hours") < 2) {$hours = "0$hours";} if (length("$minutes") < 2) {$minutes = "0$minutes";} $year += 1900; $fulldate = "$monthday @months[$month] $year"; } # end process_form ############################################################################### # start password_failure sub password_failure { print "TalkBack Administration "; print "\n"; &end; } # end password_failure ############################################################################### sub send_mail { use Socket; local($from, $to, $subject, $body) = @_; # local($subject, $from, $to, $cc, $bcc, $body) = @_; local($i, $mime_id, $error, $name, $status, $message) = ''; local(@to) = split(/, */, $to); local(@cc) = split(/, */, $cc); local(@bcc) = split(/, */, $bcc); if (!$WEB_SERVER) { $WEB_SERVER = $ENV{'SERVER_NAME'} } if (!$WEB_SERVER) { $Error_Message = "$WEB_SERVER is not set."; return(1); } if (!$smtp_server) { $smtp_server = "smtp.$WEB_SERVER"; $smtp_server =~ s/^smtp\.[^.]+\.([^.]+\.)/smtp.$1/; } local($CRLF) = "\015\012"; local($smtp_server_PORT) = 25; local($AF_INET) = ($] > 5 ? AF_INET : 2); local($SOCK_STREAM) = ($] > 5 ? SOCK_STREAM : 1); local(@bad_addresses) = (); $, = ', '; $" = ', '; local($local_address) = (gethostbyname($WEB_SERVER))[4]; local($local_socket_address) = pack('S n a4 x8', $AF_INET, 0, $local_address); local($server_address) = (gethostbyname($smtp_server))[4]; local($server_socket_address) = pack('S n a4 x8', $AF_INET, $smtp_server_PORT, $server_address); local($protocol) = (getprotobyname('tcp'))[2]; if (!socket(SMTP, $AF_INET, $SOCK_STREAM, $protocol)) { $Error_Message = "Could not make socket filehandle ($!)."; return(1); } bind(SMTP, $local_socket_address); if (!(connect(SMTP, $server_socket_address))) { $Error_Message = "Could not connect to server ($!)."; return(1); } local($old_selected) = select(SMTP); $| = 1; select($old_selected); $* = 1; select(undef, undef, undef, .75); sysread(SMTP, $_, 1024); print SMTP "HELO $WEB_SERVER$CRLF"; sysread(SMTP, $_, 1024); while (/(^|(\r?\n))[^0-9]*((\d\d\d).*)$/g) { $status = $4; $message = $3} if ($status != 250) { $Error_Message = $message; return(3) } print SMTP "MAIL FROM:<$from>$CRLF"; sysread(SMTP, $_, 1024); if (!/[^0-9]*250/) { $Error_Message = $_; return(4) } local($good_addresses) = 0; foreach $address (@to, @cc, @bcc) { if ($address) { $address =~ /(\(.*\))/; $name = $1 ? "$1 " : ''; $address =~ /([^<)\s]+@\S+\.[^>(\s]+)/; $address = "<$1>"; print SMTP "RCPT TO:$address$CRLF"; sysread(SMTP, $_, 1024); /[^0-9]*(\d\d\d)/; if ($1 ne '250') { push(@bad_addresses, "$name$address", $_) } else { ++$good_addresses } } } if (!$good_addresses) { $Error_Message = $_; return(5, @bad_addresses) } print SMTP "DATA$CRLF"; sysread(SMTP, $_, 1024); if (!/[^0-9]*354/) { $Error_Message = $_; return(6) } print SMTP "To: @to$CRLF"; print SMTP "From: $from$CRLF"; print SMTP "CC: @cc$CRLF" if $cc; print SMTP "Subject: $subject$CRLF"; print SMTP $CRLF; if ($body) { if (!($body =~ /^[\\\/:]/) && ($body =~ /\s/)) { print SMTP $body } elsif (-e $body && -T $body) { &parse_template($body, *SMTP) } } print SMTP $CRLF; print SMTP "$CRLF.$CRLF"; sysread(SMTP, $_, 1024); if (!/[^0-9]*250/) { $Error_Message = $_; return(7) } if (!shutdown(SMTP, 2)) { $Error_Message = "Could not shut down server ($!)."; return(8, @bad_addresses); } elsif (@bad_addresses) { return(2, @bad_addresses); } else { return(0) } } # end send_mail ############################################################################### # You may NOT change this Copyright Notice unless you have been give express # permission to do so by Way to the Web Limited ############################################################################### # start copyright sub copyright { print " This is the TalkBack Administration Section
\n"; print "Incorrect password
©2000, \n"; print "Way to the Web Limited \n"; } # end copyright ###############################################################################
Using \n"; print "TalkBack $version Admin