$headTitle

#!/usr/bin/perl # # MAILMATIC 10-Second Survey & Mailing List Manager # # Filename: mailmat.cgi # Copyright: 1997, 1998 by Joe DePasquale # Last revised: April 7, 1998 # E-Mail: crypt@getcruising.com # Website: http://www.GetCruising.com # ######################################################################## # # # This script and accompanying files may be distributed freely # # and modified, provided this header with my name, E-Mail address and # # this notice remain intact. Ownership rights remain with me. You may # # not sell this script without my approval. # # # # This script comes with no guarantee or warranty except for my good # # intentions. By using this code you agree to indemnify me from any # # liability that might arise from it's use. # # # # There is no technical support for this script, neither am I a # # professional programmer. Refer to 'HELPME.TXT' for further guidance. # # # ######################################################################## # # 2. CONFIGURE SCRIPT - # Change these sample paths to the actual paths on your server: # Your Unix system sendmail and date commands $mailCmd = '/usr/sbin/sendmail'; $dateCmd = '/bin/date'; # Your E-Mail address - note mandatory backslash before \@ $myMail = "you\@your-server.com"; # E-mail address to use as Group Mailing List recipient $toMail = "Our Mailing List "; # Unix path to the mailmat directory $mailmatDir = "/usr/home/you/htdocs/mailmat"; # URL for mailmat.cgi $scriptUrl = "http://your-server.com/cgi-bin/mailmat.cgi"; # Go to this URL when exiting manager $exitUrl = "http://your-server.com/manager.html"; # OPTIONAL - You can edit these variables if desired: $headTitle = "Mailmatic Ten-Second Survey"; $bodyTag = qq||; $bodyTitle = qq|THE TEN SECOND SURVEY|; # If you want a signature file attached to mail messages, # uncomment the next line and enter the correct Unix path .. # $MYSIG = '/usr/home/you/htdocs/mailmat/mysig.txt'; # .. otherwise uncomment the next line and replace with your info .. # $myName = 'Donald Quack'; # $homeUrl = 'http://your-server.com'; # Customize your survey by changing the following 'key','value' pairs. # You can have any number of questions or subjects. Following the format, # increase the 'Q'-number for each added question and/or change the text of # the questions. The Subject 'key' selected by a visitor will become part # of their record in your mailing list. %Question = ( 'Q1','Enjoyed browsing our site', 'Q2','Found what you were looking for', 'Q3','Graphics', 'Q4','Navigation & Layout', 'Q5','Overall impression of this website', ); %Subject = ( 'A','This Subject', 'B','That Subject', 'C','The Other One', ); # You can select one subject to be checked by default on the survey # form by entering a subject key and uncommenting the next line. # $checked = 'C'; # If you use HITMATIC, you can have a list of pages visited # attached to the respondent's E-Mail to the manager. If you # want this option, set $hitFlag to 'Y' and add the path info .. # $HITLOG = '/usr/home/you/htdocs/hit/hit1.log'; $hitFlag = 'N'; # If you don't want to backup the mail.dat files, set $bakFlag to 'N', # otherwise you can configure the values in the 'if' loop .. $bakFlag = 'Y'; if ($bakFlag eq 'Y') { $bakTime = 2; # days btwn backups $bakMax = 7; # days to keep backups # Unix path to backup directory $bakDir = "/usr/home/you/htdocs/bak"; # END OF INSTALLATION - DO NOT EDIT BELOW THIS LINE! ###################################################################### chop ($jDate = `$dateCmd +"%j"`); $MAILBAK = "$bakDir/mail$jDate.bak"; } chop ($dateStamp = `$dateCmd +"%Y%m%d"`); chop ($timeStamp = `$dateCmd +"%a %D %H%M%Z"`); $MAILDAT = "$mailmatDir/mail.dat"; $MAILFLK = "$mailmatDir/mail.flk"; $MAILTEMP = "$mailmatDir/mailtemp.html"; $MAILTTL = "$mailmatDir/mail.ttl"; $MAILHOLD = "$mailmatDir/mail.tmp"; $noName = "Left_No_Name"; $listFlag = "N"; ########################################################################### # Read and parse input from form or querystring if (-e "./referer.pl") { require "./referer.pl"; &referer; } print "Content-Type: text/html\n\n"; if ($ENV{'QUERY_STRING'}) { $buffer = $ENV{'QUERY_STRING'}; } elsif ($ENV{'CONTENT_LENGTH'}) { read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } @cgiPairs = split(/&/,$buffer); foreach $cgiPair (@cgiPairs) { ($name,$value) = split(/=/,$cgiPair); $value =~ s/\+/ /g; $value =~ s/%(..)/pack("c",hex($1))/ge; $Form{$name} .= "\0" if (defined($Form{$name})); $Form{$name} .= "$value"; } undef $name; undef $value; if ($Form{'checked'}) {$checked = $Form{'checked'};} ################################################################## # Case: Manager functions if (defined $Form{'manager'}) { require "./mailman.pl"; $MAILLOG = "$mailmatDir/mail.log"; $MAILPWD = "$mailmatDir/mailmat.pwd"; $MAILTXT = "$mailmatDir/mail.txt"; &mailman; exit; } # end manager ################################################################## # Case: User has submitted a REPLY elsif ($Form{'reply'}) { &header; if ($Form{'email'}) { $email = $Form{'email'}; $email =~ s/(\s|\|)//g; if ($email !~ /^\S+\@\S+(\.\S+)+/) { &endIt ("Invalid E-Mail address.. Example: $myMail"); } } if ($Form{'name'}) { $name = $Form{'name'}; $name =~ s/(\f|\n|\r|\t|\|)//g; } if ($Form{'company'}) { $company = $Form{'company'}; $company =~ s/(\f|\n|\r|\t|\|)//g; } if ($Form{'subjectkey'}) # add user to mailing list { $subjectKeys = ''; @subjectKeys = split (/\0/,$Form{'subjectkey'}); foreach $subjectKey (@subjectKeys) { if ($Subject{$subjectKey}) { $subjectKeys .= $subjectKey; } else { &endIt ("Invalid subject selection."); } } if ($email && $name =~ /\w{2,}/) { $addMail = join ("\|",$email,$name,$company,$subjectKeys,$dateStamp,"\n"); $listFlag = 'Y'; } else { &endIt ("You selected a mailing list. Your Name and E-Mail Address are needed."); } # get lock if manager not using files # else append new record to MAILHOLD file open (LOCK,">$MAILFLK") || &endIt; if (flock (LOCK,2|4)) { open (DAT,"+<$MAILDAT") || &endit; if (-s $MAILHOLD) { open (HOLD,"+<$MAILHOLD") || &endIt; flock (HOLD,2); seek (HOLD,0,0); @mailHold = ; seek (HOLD,0,0); truncate (HOLD,0); close (HOLD); } } else { open (DAT,"+<$MAILHOLD") || &endIt; } flock (DAT,2); seek (DAT,0,0); @oldFile = ; push (@oldFile,$addMail,@mailHold); @newFile = sort {uc($a) cmp uc($b)} @oldFile; seek (DAT,0,0); print (DAT @newFile); truncate (DAT,tell(DAT)); close (DAT); close (LOCK); if ($bakFlag eq 'Y' && ($jDate % $bakTime ==0) && !-e $MAILBAK) { &backUp (@newFile); } } ################################################################## # Send E-Mail to myMail if (!$email) {$email = $myMail;} if (!$name) {$name = $noName;} if ($Form{'comment'}) { $comment = $Form{'comment'}; if (length $comment >5120) {$comment = substr ($comment,0,5120);} } else { $comment = "NONE"; } open (MAIL,"|$mailCmd -t -oi") || &endIt ("Couldn't start SENDMAIL program $!"); print MAIL "From: $email\nTo: $myMail\n"; print MAIL "Subject: $headTitle\n\n"; print MAIL "This visitor responded on $timeStamp.\n\n"; print MAIL "Name: $name\nCompany: $company\nE-Mail: $email\n\n"; foreach $key (sort (keys %Question)) { print MAIL "$Question{$key}: $Form{$key}\n"; } print MAIL "\nComment: $comment\n\n"; if ($listFlag eq 'Y') { print MAIL "Visitor has registered for:\n"; foreach $subjectKey (@subjectKeys) { print MAIL " $Subject{$subjectKey} ($subjectKey)\n"; } print MAIL "\n"; } print MAIL "Domain Addr: $ENV{'REMOTE_HOST'}\n"; print MAIL " IP Address: $ENV{'REMOTE_ADDR'}\n"; print MAIL "Browser: $ENV{'HTTP_USER_AGENT'}\n"; print MAIL "Cookies: $ENV{'HTTP_COOKIE'}\n"; if ($hitFlag eq 'Y' && (open (HITLOG,"<$HITLOG"))) { flock (HITLOG,1); seek (HITLOG,0,0); @hitlog = ; close (HITLOG); @visits = grep (/($ENV{'REMOTE_ADDR'}|$ENV{'REMOTE_HOST'})/,@hitlog); print MAIL "\nHitLog for this visitor:\n"; foreach $visit (@visits) { print MAIL $visit; } } close (MAIL); ################################################################## # Send E-Mail to visitor open (MAIL,"|$mailCmd -t -oi") || &endIt ("Couldn't start SENDMAIL program $!"); print MAIL "From: $myMail\nTo: $email\n"; print MAIL "Subject: $headTitle\n\nDear $name\n"; if ($company) { print MAIL "$company\n"; } print MAIL "\nI appreciate your taking the time to give your opinion!\n"; print MAIL "If you requested a reply, I will try to respond as time allows.\n"; print MAIL "If you need to contact me, you can E-Mail me at:\n $myMail.\n\n"; if ($listFlag eq "Y") { print MAIL "Thank you for registering for our website news:\n"; foreach $subjectKey (@subjectKeys) { print MAIL " $Subject{$subjectKey}\n"; } print MAIL "If at any time you wish to discontinue receiving \n"; print MAIL "our news simply send a note by E-Mail.\n\n"; } print MAIL "Please come back and visit again soon!\n\n"; if (open (SIG,"<$MYSIG")) { @mySig = ; print MAIL "@mySig"; close (SIG); } else { print MAIL "$myName <$myMail>\n$homeUrl\n"; } close (MAIL); ################################################################## # Add survey scores to total open (TTL,"+<$MAILTTL") || &endIt; flock (TTL,2); seek (TTL,0,0); @ttlFile = ; foreach $ttlLine (@ttlFile) { ($key,$score,$reply,$eol) = split (/\|/,$ttlLine); if ($Form{$key} && $Form{$key} >0) { $score = $score + $Form{$key}; $reply = $reply +1; $ttlLine = join ("\|",$key,$score,$reply,"\n"); $scoreFlag = "Y"; } } if ($scoreFlag) { seek (TTL,0,0); print (TTL @ttlFile); truncate (TTL,tell(TTL)); } close (TTL); # Send message to the browser print qq|Thank You!\n

\n|; print qq|Your responses have been sent to $myMail.\n

\n|; if ($listFlag eq "Y") { print qq|You will receive updates on these subjects:
|; foreach $subjectKey (@subjectKeys) { print " $Subject{$subjectKey},"; } } print qq|\n

\nBack to $headTitle\n|; &footer; } # end Case REPLY ################################################################## # Case: View Survey Results elsif ($Form{'results'}) { &header; open (TTL,"<$MAILTTL") || &endIt; flock (TTL,1); seek (TTL,0,0); @ttlFile = ; close (TTL); print "

\n"; print "\n"; foreach $ttlLine (@ttlFile) { ($key,$score,$reply,$eol) = split (/\|/,$ttlLine); if ($reply >0) { $average = int ($score * 10000 / $reply) *.0001; } else { $average = 0; } $scoreTtl = $scoreTtl + $score; $replyTtl = $replyTtl + $reply; print "\n"; print "\n"; } $average = int ($scoreTtl * 10000 / $replyTtl) *.0001; print "\n"; print "\n"; print "
Question Average
Score Total
Replies
$Question{$key} $average $reply
$timeStamp $average $replyTtl

Question	Average Score	Total Replies
$Question{$key}	$average	$reply
$timeStamp	$average	$replyTtl

\n"; print qq|Back to $headTitle\n|; &footer; } ################################################################## # Default Case: Output the Survey Form else { open (TEMP,"<$MAILTEMP") || &endIt; @tempFile = ; close (TEMP); $x =0; while ($x <= $#tempFile) { if ($tempFile[$x] =~ //) { foreach $nbr (sort (keys %Question)) { print qq|$Question{$nbr}
\n|; for $value (1..10) { print qq|$value\||; } print qq|No opinion\n
\n|; } print qq|
2. Check subjects to receive our occasional E-Mail when we have news.
\n|; foreach $key (sort (keys %Subject)) { print qq|$Subject{$key}
\n|; } print qq|\n|; } else { print "$tempFile[$x]"; } $x++; } } # end default ################################################################## sub backUp # Backup data and delete old backups { @bakData = @_; open (BAK,">$MAILBAK") || &endIt; print (BAK @bakData); close (BAK); chmod (0666,$MAILBAK); opendir (BAKDIR,$bakDir); @bakFiles = grep (/mail\d{3}\.bak/, readdir(BAKDIR)); closedir (BAKDIR); foreach $bakFile (@bakFiles) { if (-M "$bakDir/$bakFile" > $bakMax) { unlink "$bakDir/$bakFile"; } } } # end backup sub header { print "$headTitle\n"; print "$bodyTag\n$bodyTitle\n

\n"; } sub footer { print qq|

MAILMATIC is one of Joe's CGI Scripts From The Crypt!\n|; print qq|

\n\n|; } sub endIt # Correctible user error { print qq|ERROR:
|; if ($_[0]) { print "$_[0]"; } else { print "Server made a Boo-Boo! $!"; } print qq|\n

Use your browser's [BACK] button and try again.\n|; print qq|

\n|; exit; } # end endIt