#!/usr/bin/perl # #Usage: # #TO ACCESS THE FORM: # #1: Sign Our Guestbook # #2:
# # #
# # #TO ACCESS THE BOOK: # #1: View Our Guestbook # #2:
# # #
# ###################################################################### ### PURPOSE: DEFINE USER VARIABLES ### ###################################################################### #---enter physical directory paths-----------------------------------# $fullLogPath ='/usr/home/sal/velvetblue/guestbook/guestbook.dat'; $fullLockPath ='/usr/home/sal/velvetblue/guestbook/guestbook.lock'; $BackupDataPath ='/usr/home/sal/velvetblue/guestbook/backup.dat'; $ScriptName ='http://www.velvetblue.com/guestbook/guestbook.cgi'; #---personal variables alter at will---------------------------------# $SiteName ='Velvet Blue'; $MaxEntriesBeforeBackupStops ='200'; $BackupInterval ='20'; $SMTPHost ='velvetblue.com'; $SMTPPort ='25'; $MailEntryTo ='sitesubmit@velvetblue.com'; $MailSubject ="New $SiteName Guestbook Entry"; #---options: 0 for off 1 for on--------------------------------------# $FilterProfanity =0; $EmailNewEntries =0; $EmailHTML =0; $NoOutsideAccess =0; $OneEntryPerHour =0; $AllowHTML =0; ###################################################################### ### PURPOSE: SET THE SCRIPT VARIABLES ### ###################################################################### #---script variables do not alter------------------------------------# $In = "$ENV{'QUERY_STRING'}"; $ThisHost = "$ENV{'REMOTE_HOST'}"; $Version = "2.0"; @ReferingPage =split (/\//,$ENV{HTTP_REFERER}); $ServerName = "$ENV{'SERVER_NAME'}"; $BackupName = "guestbak"; #---no Access if called outside server-------------------------------# if ($ServerName ne @ReferingPage[2] && $NoOutsideAccess){&NoAccess;} ###################################################################### ### PURPOSE: NO OUTSIDE SERVER ACCESS ### ###################################################################### #--------------------------------------------------------------------# sub NoAccess { print "Content-type: text/html\n\n"; print qq~

Access Denied:

You have no permission to access this script from your server.

~; exit; } ###################################################################### ### PURPOSE: CALL THE SUBROUTINES ### ###################################################################### #---call the subroutines---------------------------------------------# &Header; &TimeToday; # &SetSwear; &Query; &BackupCheck; print "test\n"; exit; &Query; &BackupCheck; &SelectLog; &ReadLogFile; &CheckUser; &WhichPage; &Footer; ###################################################################### ### PURPOSE: DETERMINE WHICH PAGE TO RETURN ### ###################################################################### #---find out read or write or form-----------------------------------# sub WhichPage { if ($Action eq 'Read') {&Book;} elsif ($Action eq 'Form') {&Form;} elsif ($writeThisUser ne '1' && $OneEntryPerHour) {&error('You have already signed the Guestbook today')} elsif ($Action eq 'Write') {&Blank; &Backup; &WriteLogFile; &Response; if ($EmailNewEntries){&SendMail;}} else {&error('Invalid Guestbook Command')} } ###################################################################### ### PURPOSE: DEFINE TIME ### ###################################################################### #--------------------------------------------------------------------# sub TimeToday { ($seconds,$minutes,$hours,$date,$month,$year,$weekday) = localtime(time); #---pad the hours minutes and seconds--------------------------------# if ($seconds < 10) { $seconds = "0$seconds"; } if ($minutes < 10) { $minutes = "0$minutes"; } if ($hours < 10) { $hours = "0$hours"; } $month++; #---set the date for today-------------------------------------------# $Date = "$month\-$date\-$year"; $time = "$hours\:$minutes\:$seconds"; } ###################################################################### ### PURPOSE: HANDLE ERROR MESSAGES ### ###################################################################### #--------------------------------------------------------------------# sub error { $error = shift(@_); print qq~

Guestbook Error: $error.

~; exit; } ###################################################################### ### PURPOSE: INVALID FIELD RESPONSE ### ###################################################################### #--------------------------------------------------------------------# sub TryAgain { $error = shift(@_); print qq~

Guestbook Error: $error.


Try Again
~; exit; } ###################################################################### ### PURPOSE: PRINT PAGE HEADER ### ###################################################################### #--------------------------------------------------------------------# sub Header { print "Content-type: text/html\n\n"; print "VelvetBlue.Com Guestbook\n"; print "

$SiteName Guestbook

\n"; print "
\n"; return; } ###################################################################### ### PURPOSE: PRINT PAGE FOOTER ### ###################################################################### #--------------------------------------------------------------------# sub Footer { print "


Read - Write\n"; print ""; } ###################################################################### ### PURPOSE: ALLOW ONE ENTRY PER HOUR ### ###################################################################### #--------------------------------------------------------------------# sub CheckUser { if ($ThisHost eq $d && substr ($c,0,2) eq $hours){$writeThisUser=0;} else {$writeThisUser=1;} } ###################################################################### ### PURPOSE: DEMOZIFY QUERY STRING ### ###################################################################### #--------------------------------------------------------------------# sub Query { #---split the string by topic----------------------------------------# @InString=split (/&/,$In); foreach $x (0..$#InString){ #---creates the spaces-----------------------------------------------# $InString[$x] =~ s/\+/ /g; #---create a value array---------------------------------------------# ($trash,@UserInfo[$x])=split(/=/,$InString[$x]); #---demozify---------------------------------------------------------# @UserInfo[$x] =~ s/%(..)/pack("c",hex($1))/ge; } #---set the finished variables---------------------------------------# $Action =@UserInfo[0]; $Log =@UserInfo[1]; $Name =StripSwear("\u@UserInfo[2]"); $Email =StripSwear("@UserInfo[3]"); $Homepage =StripSwear("@UserInfo[4]"); $Found =@UserInfo[5]; $Comment =StripSwear("\u@UserInfo[6]"); } ###################################################################### ### PURPOSE: CHECK FOR BLANK FIELDS ### ###################################################################### #--------------------------------------------------------------------# sub Blank{ #---no name field----------------------------------------------------# if (!$Name || length $Name eq '1') {&TryAgain('Name Field Required');} #---invalid characters in email field--------------------------------# if ($Email =~ tr/;,<>*|`&$!#()[]{}:'"//) {&TryAgain('Invalid Characters In Email Field');} #---incomplete homepage adress---------------------------------------# if (substr ($Homepage,0,3) eq 'www') {$Homepage='http://'.$Homepage;} #---no comment field-------------------------------------------------# if (!$Comment || length $Comment eq '1') {&TryAgain('Comment Field Required');} #---no email field---------------------------------------------------# if (!$Email){$Email="No Email Given."; $WriteEmail=$Email} else {$WriteEmail="$Email"} #---no homepage field------------------------------------------------# if (!$Homepage){$Homepage="No Homepage Given."; $WriteHome=$Homepage} elsif (substr($Homepage,0,7) ne 'http://'){$WriteHome="$Homepage"} else {$WriteHome="$Homepage"} } ###################################################################### ### PURPOSE: DEFINE SWEAR WORDS ### ###################################################################### #--------------------------------------------------------------------# sub SetSwear{ $x='a'; for ($i=1;$i<=26;$i++) { @A[$i] = $x++ ; 9 } @Swear[1] = @A[4].@A[1].@A[13].@A[14]; @Swear[2] = @A[19].@A[8].@A[9].@A[20]; @Swear[3] = @A[1].@A[19].@A[19]; @Swear[4] =@A[6].@A[21].@A[3].@A[11]; @Swear[5] =@A[2].@A[9].@A[20].@A[3].@A[8]; @Swear[6] =@A[16].@A[18].@A[9].@A[3].@A[11]; @Swear[7] =@A[4].@A[9].@A[3].@A[11]; @Swear[8] =@A[3].@A[21].@A[14].@A[20]; @Swear[9] =@A[16].@A[21].@A[19].@A[19].@A[25]; @Swear[10]=@A[23].@A[8].@A[15].@A[18].@A[5]; @Swear[11]=@A[19].@A[12].@A[21].@A[20]; @Swear[12]=@A[20].@A[23].@A[1].@A[20]; @Swear[13]=@A[1].@A[19].@A[19].@A[8].@A[15].@A[12].@A[5]; @Swear[14]=@A[19].@A[8].@A[9].@A[20].@A[8].@A[5].@A[1].@A[4]; @Swear[15]=@A[6].@A[21].@A[3].@A[11].@A[8].@A[5].@A[1].@A[4]; @Swear[16]=@A[6].@A[21].@A[3].@A[11].@A[5].@A[18]; @Swear[17]=@A[19].@A[12].@A[9].@A[20]; @Swear[18]=@A[7].@A[15].@A[4].@A[4].@A[1].@A[13].@A[14]; @Swear[19]=@A[6].@A[21].@A[3].@A[11].@A[9].@A[14].@A[7]; @Swear[20]=@A[20].@A[9].@A[20]; @Swear[21]=@A[20].@A[9].@A[20].@A[19]; @Swear[22]=@A[3].@A[15].@A[3].@A[11].@A[19].@A[21].@A[3].@A[11].@A[9].@A[14].@A[7]; @Swear[23]=@A[3].@A[15].@A[3].@A[11].@A[19].@A[21].@A[3].@A[11].@A[5].@A[18]; @Swear[24]=@A[12].@A[9].@A[3].@A[11].@A[9].@A[14].@A[7]; @Swear[25]=@A[3].@A[15].@A[3].@A[11]; @Swear[26]=@A[6].@A[18].@A[9].@A[3].@A[11].@A[8].@A[5].@A[1].@A[4]; @Swear[27]=@A[2].@A[1].@A[19].@A[20].@A[1].@A[18].@A[4]; @Swear[28]=@A[2].@A[1].@A[19].@A[20].@A[1].@A[18].@A[4].@A[1].@A[19].@A[19]; @Swear[29]=@A[19].@A[21].@A[3].@A[11].@A[9].@A[14].@A[7]; } ###################################################################### ### PURPOSE: STRIP OUT SWEARING ### ###################################################################### #--------------------------------------------------------------------# sub StripSwear{ $Words=shift (@_); if ($FilterProfanity) {for ($y=1;$y<=$#Swear;$y++){$Words =~ s/@Swear[$y]//gi;}} if (!$AllowHTML) {$Words =~ s/<([^>]|\n)*>//g;} $Words =~ s/\|//g; return $Words; } ###################################################################### ### PURPOSE: OPEN A LOCK FILE ### ###################################################################### #--------------------------------------------------------------------# sub startLock { while(-f $fullLockPath){select(undef,undef,undef,0.1);} open(LOCKFILE, ">$fullLockPath") || &error("Could Not Open $fullLockPath");} ###################################################################### ### PURPOSE: CLOSE & DELETE A LOCK FILE ### ###################################################################### #--------------------------------------------------------------------# sub endLock {close(LOCKFILE) || &error("Could Not Close $fullLockPath"); unlink($fullLockPath) || &error("Could Not Delete $fullLockPath");} ###################################################################### ### PURPOSE: OPEN THE LOG AND READ ### ###################################################################### #--------------------------------------------------------------------# sub ReadLogFile { &startLock; open(COUNT,"$BackupName") || &create; #---exit sub if creating new file------------------------------------# if ($creating==1){exit;} #---read the data strings--------------------------------------------# while(){ #---split the data strings-------------------------------------------# ($a,$b,$c,$d,$e,$f,$g,$h,$i) = split(/,/,$_,9); #---write the strings into arrays------------------------------------# @UserNumber[$z] =$a; @EntryDate[$z] =$b; @EntryTime[$z] =$c; @IPAddress[$z] =$d; @UserName[$z] =$e; @UserEmail[$z] =$f; @UserHomepage[$z] =$g; @UserFound[$z] =$h; @UserComment[$z] =$i; $z++; } #---increase the counter---------------------------------------------# $count = $a; if ($count==0){$count=1;} else {$count++;} close(COUNT) || &error("Could Not Close $fullLogPath"); &endLock; } ###################################################################### ### PURPOSE: WRITE & REPLACE THE LOG ### ###################################################################### #--------------------------------------------------------------------# sub WriteLogFile { #---what to write----------------------------------------------------# $LogStringHidden="$count\,$Date\,$time\,$ENV{'REMOTE_HOST'}"; $LogStringSent=",$Name\,$Email\,$Homepage\,$Found\,$Comment\n"; #---write the new information----------------------------------------# &startLock; open(LOG, ">>$fullLogPath") || &error("Could Not Open $fullLogPath"); print LOG $LogStringHidden.$LogStringSent; close(LOG) || &error("Could Not Close $fullLogPath"); &endLock; } ###################################################################### ### PURPOSE: CREATE LOG FILE ON FIRST RUN ### ###################################################################### #--------------------------------------------------------------------# sub create { #---tell the read function that file is created instead--------------# $creating=1; $count=1; #---create the new file----------------------------------------------# &endLock; &startLock; open(LOG, ">>$fullLogPath") || &error("Open $fullLogPath to write."); print LOG $LogStringHidden; close(LOG) || &error("Close $fullLogPath for write."); &endLock; #---write the creation message---------------------------------------# print qq~ Guestbook $Version has just created a log file at

$fullLogPath

Your Guestbook should function properly now. Please click here to add your first entry or click here to read the guestbook. ~; } ###################################################################### ### PURPOSE: CREATE LOG BACKUPS ### ###################################################################### #--------------------------------------------------------------------# sub Backup { #---create the new backup filename-----------------------------------# $countx=$count-1; $BackupName=~s/\./$countx./; #---determine if a backup should be created--------------------------# for ($Bak=$BackupInterval; $Bak<=$MaxEntriesBeforeBackupStops; ($Bak=$Bak+$BackupInterval)){ if ($count eq $Bak+1){ #---rename the current log-------------------------------------------# rename ($fullLogPath, $BackupName); #---create the new log-----------------------------------------------# &startLock; open(LOG, ">$BackupDataPath") || &error("Open $BackupDataPath"); print LOG $Bak; close(LOG) || &error("Close $BackupDataPath"); &endLock; }}} ###################################################################### ### PURPOSE: SELECT A LOG TO READ ### ###################################################################### #--------------------------------------------------------------------# sub SelectLog { #---is requested log file valid?-------------------------------------# for ($Bak=$BackupInterval; $Bak<=$MaxEntriesBeforeBackupStops; ($Bak=$Bak+$BackupInterval)) {if ($Log eq $Bak){$BackupName=~s/\./$Bak./;}}} ###################################################################### ### PURPOSE: CHECK FOR BACKUPS ### ###################################################################### #--------------------------------------------------------------------# sub BackupCheck { #---open the backup file and check for last backup-------------------# &startLock; open(LOG, "$BackupDataPath") || &BackupNone; @BackupNumberRead = ; $BackupNumberRead = scalar(@BackupNumberRead); close(LOG); &endLock; } ###################################################################### ### PURPOSE: RETURN NO BACKUP ### ###################################################################### #--------------------------------------------------------------------# sub BackupNone { $BackupNumberRead='0'; } ###################################################################### ### PURPOSE: LINK TO BACKUPS ### ###################################################################### #--------------------------------------------------------------------# sub LinkToBackups { #---open form--------------------------------------------------------# print "
"; print ""; print ""; print "
"; } ###################################################################### ### PURPOSE: RESPOND TO NEW ENTRY ### ###################################################################### #--------------------------------------------------------------------# sub Response { #---response returned------------------------------------------------# print qq~ $Name, thank you for signing our Guestbook. Your entry has been sent with the following information:

Name:$Name
Email: $WriteEmail
Homepage: $WriteHome
Found Us By: $Found
Comment: $Comment

Guestbook Entry $count Signed on $Date at $time.
Read the Guestbook
~; &Message; } ###################################################################### ### PURPOSE: COMPOSE THE EMAIL MESSAGE ### ###################################################################### #--------------------------------------------------------------------# sub Message { if ($EmailHTML){ #---if email html switch is on--------------------------------------# $Coding='text/html; charset=us-ascii'; #---compose email body----------------------------------------------# $Message.=""; $Message.=""; $Message.=""; $Message.=""; $Message.=""; $Message.=""; $Message.=""; $Message.=""; $Message.=""; $Message.=""; $Message.=""; $Message.=""; $Message.="
Name:"; $Message.="$Name
Email:"; $Message.="$Email
Homepage:"; $Message.="$Homepage
Found Us By:"; $Message.="$Found
Comment:"; $Message.="$Comment
Book Entry:"; $Message.="$count
IP Address:"; $Message.="$ThisHost
Browser:"; $Message.="$ENV{'HTTP_USER_AGENT'}
Signed On:"; $Message.="$Date at $time

"; $Message.="Email Courtesy of Guestbook $Version by David Wolf"; } else { #---if email html switch is off-------------------------------------# $Coding='text/plain; charset=us-ascii'; #---compose email body----------------------------------------------# $Message.="Name: $Name\n"; $Message.="Email: $Email\n"; $Message.="Homepage: $Homepage\n"; $Message.="Found Us By: $Found\n"; $Message.="Comment: $Comment\n\n"; $Message.="------------------------------------------------\n\n"; $Message.="Book Entry: $count\n"; $Message.="IP Address: $ThisHost\n"; $Message.="Browser: $ENV{'HTTP_USER_AGENT'}\n"; $Message.="Signed On: $Date at $time\n\n"; $Message.="------------------------------------------------\n\n"; $Message.="Email Courtesy of Guestbook $Version by David Wolf\n"; } } ###################################################################### ### PURPOSE: WRITE THE BOOK PAGE ### ###################################################################### #--------------------------------------------------------------------# sub Book { &LinkToBackups; #---look through all the entries-------------------------------------# for ($inc=0;$inc<=$#UserNumber;$inc++){ #---blank email tag--------------------------------------------------# if (@UserEmail[$inc] eq "No Email Given."){$WriteEmail=@UserEmail[$inc]} else {$WriteEmail="@UserEmail[$inc]"} #---blank homepage tag-----------------------------------------------# if (@UserHomepage[$inc] eq "No Homepage Given.") {$WriteHome=@UserHomepage[$inc]} elsif (substr(@UserHomepage[$inc],0,7) ne 'http://') {$WriteHome=@UserHomepage[$inc]} else {$WriteHome=""; $WriteHome.="@UserHomepage[$inc]"} #---write the guestbook display page---------------------------------# print qq~ \n\n \n\n
Name: @UserName[$inc]
Email: $WriteEmail
Homepage: $WriteHome
Found Us By: @UserFound[$inc]
Comment: @UserComment[$inc]

Guestbook Entry @UserNumber[$inc] Signed on @EntryDate[$inc] at @EntryTime[$inc].
\n\n\n ~; }} ###################################################################### ### PURPOSE: WRITE THE FORM ### ###################################################################### #--------------------------------------------------------------------# sub Form { print qq~
Name:
Email:
Homepage:
Found Us By: Search Engine
Following A Link
A Newsgroup Posting
Word of Mouth
Other Means
Comment:

~; } ###################################################################### ### PURPOSE: EMAIL THE RESPONSE ### ###################################################################### #--------------------------------------------------------------------# sub SendMail { $SMTPPort ||= 25; my $AF_INET = 2; my $SOCK_STREAM = 1; my $sockaddr = 'S n a4 x8'; ($name,$aliases,$proto) = getprotobyname('tcp'); ($name,$aliases,$SMTPPort) = getservbyname ($SMTPPort,'tcp') unless $SMTPPort =~ /^\d+$/;; ($name,$aliases,$type,$len,$thataddr) = gethostbyname ($SMTPHost); my $this = pack($sockaddr, $AF_INET, 0, $thisaddr); my $that = pack($sockaddr, $AF_INET, $SMTPPort, $thataddr); socket(S, $AF_INET, $SOCK_STREAM, $proto) or print "Could not open socket: $!"; connect(S,$that) or print "Could not connect to $thataddr: $!"; select(S); $| = 1; select(STDOUT); $a=; print S "HELO $MailEntryTo\n"; $a=; print S "MAIL FROM:$Email\n"; $a=; print S "RCPT TO:<$MailEntryTo>\n"; $a=; print S "DATA \n"; $a=; print S "From: \"$Name\" <$Email>\n"; print S "X-Mailer: Guestbook X-Mailer\n"; print S "MIME-Version: 1.0\n"; print S "To: $MailEntryTo\n"; print S "Subject: $MailSubject\n"; print S "Content-Type: $Coding\n"; print S "Content-Transfer-Encoding: 7bit\n"; print S "\n"; print S "$Message\n"; print S ".\n"; $a=; print S "QUIT"; }