#!/usr/bin/perl # adult.cgi - produces an age verification screen for adult material. # $author = "Tad 'Baxil' Ramspott"; $version = "1.2.1, 2013-09-04"; # Changes from 1.2: Bugfix, text files need to have text/html header # (also fixed for new server). # Changes from 1.1: Added substitutions, finished debugging, fixed behavior # after cookie set/reset. Probably final for a while. (2007-02-18) # (Oh, and: New cookie-has-been-set message.) # Changes from 1.0.1: Removing e-mail from error messages; # general 2007 twiddling; streamline for new template work :), # adultSubstitute fixed based on new template algorithm (2007-02-14) # Changes from 1.0: Added check for newlines in file name; shouldn't be # necessary as a security measure, but better safe than sorry. (10-27-02) require("/var/www/vhosts/tomorrowlands.org/httpdocs/cgisrc/tyrforms.pl"); # which calls tyrfuncs.pl require($rootdir . "cgisrc/tyrtemplates.pl"); $legalese = "adultwarning"; # filename for the little legal blurb $adultdir = $rootdir . "_adult/"; # where the incriminating stuff is $logfile = "error_log"; $infoSuffix = ".info"; $adultCName = "adultauth"; $graceHours = 24; # how long before cookie expires $pageTitle = "Age Verification"; # default for header # ---------------------------------------------------------------- sub initCookieWarning { # OUTDATED, see below: $cookieWarning = <<EOF; <FORM ACTION="adult.cgi" METHOD=GET><FONT SIZE="-1">This file has been categorized by tomorrowlands.org as adult content. You are seeing this message because you have (or someone at this computer has) accepted our terms to view such material and requested to bypass further verification screens. To remove the cookie that this request has stored on your system, and revoke the extended verification, please click here: <INPUT TYPE=HIDDEN name="file" value="$theForm{'file'}"><INPUT TYPE=SUBMIT NAME="cookiereset" VALUE="Reset"> (The script will return you to this page.)</FONT></FORM> <p><hr><p> EOF # Actually, let's go with this version instead: $cookieWarning = <<EOF; <center><table border=2 cellpadding=6 hspace=9 vspace=9 BGCOLOR="#DD9999"> <tr><td><FORM ACTION="adult.cgi" METHOD=GET> <FONT COLOR="#000000"><b>ADULT CONTENT:</b> <SMALL>This page contains adult material. A user of this computer has accepted our terms to view such material. To cancel this agreement and remove the cookie stored on your system, click here: <INPUT TYPE=HIDDEN name="file" value="$theForm{'file'}"><INPUT TYPE=SUBMIT NAME="cookiereset" VALUE="Reset"></SMALL></FONT></FORM></td></tr></table></center> <p> EOF # DEBUG # clearCookie($adultCName); # print "\n<br> Current cookie settings - theCookies -> " . (scalar %theCookies) . ". <br>\n"; } sub badFileMessage($) { my $foo = shift; $extraForm = <<EOF; <p> If you know the <b>exact filename</b> of the document you wish to reach, you may try entering it here. But no guarantees ...: <form action="adult.cgi" method="GET"> <input type="text" name="file" size="22"> <br> <input type=submit> </form> EOF if ($foo eq "nofile") { $explain = <<EOF; We can't process that request because no filename has been specified. You're probably here because someone tried to link directly to Tomorrowlands.org adult content; or because you tried to bookmark it; or because Baxil was an idiot and forgot the file's name in the script arguments when he posted the link. If you know what you're looking for, please <A HREF="/home.html">go to Tomorrowlands</A>, find a link to it, and click through there. Otherwise, please <A HREF="/contact.html">contact the webmaster</A> for assistance. EOF } elsif ($foo eq "illegalfile") { $explain = <<EOF; We can't process that request because the filename is illegal in a particularly egregious way. Stop hacking around with our scripts, and put them to the use for which they were intended. <p> This request has been flagged, and your IP address logged. Continued misuse of this server will result in denial of access and a report to your internet service provider. Please <A HREF="/contact.html">contact the webmaster</A> if you believe there has been an error, or if you clicked on a link somewhere to reach this page. (Please include the URL that sent you here in your e-mail.) EOF $extraForm = ""; } elsif ($foo eq "badfile") { $explain = <<EOF; We can't process that request because a filename that doesn't exist has been specified. You're probably here because someone tried to link directly to Tomorrowlands.org adult content, and misspelled it; or because Baxil was an idiot and made a typo when he posted the link. If you know what you're looking for, please <A HREF="/index.html">go to Tomorrowlands</A>, find a link to it, and click through there. Otherwise, please <A HREF="/contact.html">contact the webmaster</A> for assistance. EOF } htmlHeader(); print <<EOT; <html><body> <center><h2>No can do</h2></center> $explain $extraForm </body></html> EOT exit; } sub rogueCookie() { htmlHeader(); print <<EOT; <html><body> <center><h2>Whoops!</h2></center> You're here because there's a rogue cookie on your system that has confused the script. That cookie is <b>$adultCName=$theCookies{$adultCName}</b>. In order to clear this cookie off of your system -- and view the file you were trying to reach -- please <p ALIGN=CENTER> <form action="adult.cgi" method="GET"> <input type="hidden" name="file" value="$theForm{"file"}"> <input type="hidden" name="cookiereset" value="Reset"> <input type=submit value="Click here!"> </form> </body></html> EOT exit; } # called from tyrtemplates::substitute sub adultSubstitute($$) { # returns string that is subbed in for reserved word # DOES NOT USE VALUES, only words! Second argument is ignored. my $subword = lc(shift); if ($subword eq "file") { return $theForm{"file"}; } elsif ($subword eq "reason") { return $adultReason; } elsif ($subword eq "button") { return qq#<input type=submit name="agreed" value="I Agree">#; } elsif ($subword eq "box") { return qq#<input type=checkbox name="addcookie" checked>#; } elsif ($subword eq "form") { return qq#<form action="adult.cgi" method=post>\n# . qq#<input type=hidden name="file" value="$theForm{"file"}">#; } elsif ($subword eq "hours") { return $graceHours; } elsif ($subword eq "pagetitle") { return $pageTitle; # DEBUG } elsif ($subword eq "cookie") { clearCookie($adultCName); print "\n<br> Current cookie settings - theCookies -> " . (scalar %theCookies) . ". <br>\n"; # and show cookies return ( join(" ", keys(%theCookies), values(%theCookies)) ); # /DEBUG } else { return ""; # return +( "" ); # + forces () into array parens, not arg parens -- # not necessary here, but a good thing to remember :) } } #end adultSubstitute # returns true if we need to print Content-length: header sub printAppropriateHeader() { my $getFileLength = 0; print "Content-type: "; if ($theForm{"file"} =~ /\.jpe?g$/i) { print "image/jpeg"; $getFileLength = 1; } elsif ($theForm{"file"} =~ /\.gif$/i) { print "image/gif"; $getFileLength = 1; } elsif ($theForm{"file"} =~ /\.png$/i) { print "image/png"; $getFileLength = 1; } elsif ($theForm{"file"} =~ /\.mp3$/i) { print "audio/mp3"; $getFileLength = 1; } elsif ($theForm{"file"} =~ /\.txt$/i) { # should always be text/html since we wrap it in a template # if ($cookieAuth and ($theForm{"cookiereset"} ne "Reset")) # { print "text/html"; } # else { print "text/plain"; } print "text/html"; } elsif ($theForm{"file"} =~ /\.html?$/i) { print "text/html"; } else { # default - don't recognize file ;p if ($cookieAuth and ($theForm{"cookiereset"} ne "Reset")) { print "text/html"; } else { print "text/plain"; } } print "\n"; print "\n" if (! $getFileLength); return $getFileLength; } # ============================== MAIN PROGRAM ========================== %theForm = parseForm(); # will be empty if no form data -- *shrug* %theCookies = parseCookies(); # prep template substitutions setSParser(\&adultSubstitute); # ----- initialize values ----- $fileValid = $authGood = $logRequest = $cookieAuth = $addCookie = 0; $errorMessage = ""; $denyAccess = 0; $giveFile = 0; # print form if neither # now let's fill em in: # check for valid file if (exists $theForm{"file"}) { if ( $theForm{"file"} =~ m#^/# or $theForm{"file"} =~ m#\.\.# or $theForm{"file"} =~ /~/ or $theForm{"file"} =~ /$infoSuffix$/ or $theForm{"file"} eq $logfile or $theForm{"file"} =~ /\n/ ) { $logRequest = 1; $denyAccess = 1; $errorMessage = " Illegal filename."; } else { if ( -e ($adultdir . $theForm{"file"}) and -f ($adultdir . $theForm{"file"}) ) { $fileValid = 1; } } # legal filenames } else { $errorMessage = " No filename."; } # exists filename # check for proper authentication: method:post & agreed clicked if ($ENV{'REQUEST_METHOD'} eq "POST") { if (exists($theForm{"agreed"})) { $authGood = 1 if ($theForm{"agreed"} eq "I Agree"); } } # check 4 outside http-ref - if so, log. if (exists $ENV{"HTTP_REFERER"}) { if (! $ENV{"HTTP_REFERER"} =~ m#^(http://)?www\.tomorrowlands\.org#i) { if ($ENV{"HTTP_REFERER"} =~ m#\w+#) { # i.e. not if blank $errorMessage .= " Outside referrer."; $logRequest = 1; } }} # check for cookies # TODO: Do we need to check for cookie = 0 (or "") in case cookie's been unset? if (exists $theCookies{$adultCName}) { $leeway = 60 * 60 * $graceHours; if ($theCookies{$adultCName} > time()) { # someone's being hacky :p $logRequest = 1; $denyAccess = 1; $cookieAuth = 1; # for info only - script will catch this case $errorMessage .= " Future cookie date."; } elsif ($theCookies{$adultCName} > (time() - $leeway)) { $cookieAuth = 1; $addCookie = 1; # renew it } else { $errorMessage .= " Extended authorization has expired."; } } # DEBUG # returnError("200", "debug", "<br> cookieAuth = $cookieAuth <br> errorMessage = $errorMessage <br> theCookies{acn} = " . $theCookies{$adultCName} . " <br> time = " . time()); # check if addcookie=on if(exists $theForm{"addcookie"}) { $addCookie = 1 if $theForm{"addcookie"} eq "on"; } # ---------- and: parse results of all that -------------------- # figure out whether to deny, allow, or print form # *** *** *** *** # FOR LATER: May add in "ban by IP" section here - add $denyAccess if ($fileValid and ! $logRequest) { $giveFile = 1 if $cookieAuth or $authGood; } # NOW: Do all of our printing (and logging) based on above # let's log rogue access attempts if ($logRequest) { $elTiempo = timeString(); $Tiempo = time(); $theAction = $denyAccess ? "Access denied to" : "Form printed for"; open(LOG, ">>$adultdir$logfile") or returnError(500, "Script Error", "Unexpected failure opening necessary file"); flock(LOG, 2) or returnError(500, "Script Error", "Unexpected failure obtaining access to file"); print LOG <<EOF; $theAction $ENV{"REMOTE_ADDR"} at $elTiempo; $errorMessage Referrer: $ENV{'HTTP_REFERER'}; file: $theForm{"file"} Adult cookie: $theCookies{$adultCName} (current time $Tiempo) * EOF flock(LOG, 8); #release close(LOG); } #end logRequest check # NOW - 4 options: 1. req denied 2. bad file 3. print form 4. give file # 1 # DENY THE REQUEST for some reason if ($denyAccess) { # put ban IP case in here, eventually badFileMessage("illegalfile") if (! $fileValid); rogueCookie() if ($cookieAuth); # 2 # NO SUCH FILE } elsif (! $fileValid) { $theForm{"file"} ? badFileMessage("badfile") : badFileMessage("nofile"); # 3 # GIVE 'EM THE FORM } elsif (! $giveFile) { # let's first just check if cookiereset has been requested: clearCookie($adultCName) if $theForm{"cookiereset"} eq "Reset"; if (open(INFO, "$adultdir$theForm{'file'}$infoSuffix")) { chomp($infoVersion = <INFO>); if ($infoVersion == 100) { chomp($adultReason = <INFO>); # no other information in v1.0.0 file } else { $adultReason = "No further details available (unrecognized/possibly corrupt info file -- please notify us!)"; } close INFO; } else { # couldn't open info file $adultReason = "No further details available. (Info file missing?)"; } # and give the form! printPage("$rootdir$legalese"); # 4 # GIVE 'EM THE FILE } else { # Did someone just bail on our lovely adult content? OK then: if ($theForm{"cookiereset"} eq "Reset") { clearCookie($adultCName); hardRedirect("http://www.tomorrowlands.org/index.html"); } open(FOOFILE, "$adultdir$theForm{'file'}") or returnError(500, "File Read Error", "Could not access the file requested"); if ($addCookie) { setCookie($adultCName, time); # , 60 * $graceHours); # no exp date! # if missing expiration, browser will discard at end of current session # and I'd like to show the cookie blurb as if thus authorized: $cookieAuth = 1; } if (printAppropriateHeader()) { # binary file $howBig = -s "$adultdir$theForm{'file'}"; print "Content-length: $howBig\n\n"; $pieceSize = 2048; for ($loop=0; $loop <= $howBig; $loop += $pieceSize) { read(FOOFILE, $data, $pieceSize); print $data; } close FOOFILE; } else { # text or html #also rem cookieauth + html file: add header if ($cookieAuth) { &initCookieWarning; } else { $cookieWarning = ""; } # check to see if it's HTML: for($i = 0; $i < 10; $i++) { push(@firstlines, <FOOFILE>); } chomp @firstlines; $firstglob = join("\n", @firstlines); if ($firstglob =~ /\<BODY/si) { # it is: substitute thingy in $firstglob =~ s/(\<BODY.*?\>)/$1\n$cookieWarning/si; # this does an expensive nothing if no cookies ... oh well } else { # it's text: generate pseudo-html frame $printHTMLTail = 1; $pageTitle = "Adult | " . $theForm{"file"}; printTemplate("${rootdir}templates/cgi_header_mini"); print "\n $cookieWarning \n <PRE> \n"; } print $firstglob; while (<FOOFILE>) { print; } # /\ get the rest of the file spit out, line by line if ($printHTMLTail) { print("\n</PRE>"); printTemplate($rootdir . "templates/cgi_footer"); } close FOOFILE; } # /is binary file? } # /what to do with request exit;