#!/usr/bin/perl # awful.cgi - produces an age verification screen for adult material. # $version = "1.0.1, 10-27-02"; # Changes from 1.0: Added check for newlines in file name; shouldn't be # necessary as a security measure, but better safe than sorry $author = "Tad Baxil Ramspott"; require("/home/web/baxil/cgisrc/tyrforms.pl"); # which calls tyrfuncs.pl require($rootdir . "cgisrc/tyrtemplates.pl"); $legalese = "awfulwarning"; # 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 # ---------------------------------------------------------------- sub initCookieWarning { $cookieWarning = <This file has been categorized by tomorrowlands.org as adult content. You are seeing this message because you (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: (The script will return you to this page.)

EOF } sub badFileMessage($) { my ($foo) = @_; $extraForm = < If you know the exact filename of the document you wish to reach, you may try entering it here. But no guarantees ...:

EOF if ($foo eq "nofile") { $explain = <go to Tomorrowlands, find a link to it, and click through there. Otherwise, please contact the webmaster (\<$webmasterurl\>) for assistance. EOF } elsif ($foo eq "illegalfile") { $explain = < In addition, this request has been logged. Continued misuse of this server will result in a report being mailed to your internet service provider. Please contact the webmaster (\<$webmasterurl\>) 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 = <go to Tomorrowlands, find a link to it, and click through there. Otherwise, please contact the webmaster (\<$webmasterurl\>) for assistance. EOF } htmlHeader(); print <

No can do

$explain $extraForm EOT exit; } sub rogueCookie() { htmlHeader(); print <

Whoops!

You're here because there's a rogue cookie on your system that has confused the script. That cookie is $adultCName=$theCookies{$adultCName}. In order to clear this cookie off of your system -- and view the file you were trying to reach -- please

EOT exit; } # called from tyrtemplates::substitute sub adultSubstitute($) { # returns list (of strings that are subbed in for reserved word) my $subword = lc(shift); if ($subword eq "file") { return($theForm{"file"}); } elsif ($subword eq "reason") { return($adultReason); } elsif ($subword eq "button") { return(qq##); } elsif ($subword eq "box") { return(qq##); } elsif ($subword eq "form") { return(qq#

\n#, qq##); } elsif ($subword eq "hours") { return("$graceHours"); } else { 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) { if ($cookieAuth and ($theForm{"cookiereset"} ne "Reset")) { print "text/html"; } else { print "text/plain"; } } 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 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."; } } # 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 <); if ($infoVersion == 100) { chomp($adultReason = ); # no other information in v1.0.0 file } else { $adultReason = "No further details available (unrecognized/possibly corrupt info file -- please notify $webmasterurl!)"; } close INFO; } else { # couldn't open info file $adultReason = "No further details available. (Info file missing?)"; } # and give the form! printTemplate("$rootdir$legalese"); } else { # GIVE 'EM THE FILE open(FOOFILE, "$adultdir$theForm{'file'}") or returnError(500, "File Read Error", "Could not access the file requested"); if ($theForm{"cookiereset"} eq "Reset") { clearCookie($adultCName); } elsif ($addCookie) { setCookie($adultCName, time); # , 60 * $graceHours); # no exp date! # if missing expiration, browser will discard at end of current session } 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/html #also rem cookieauth + html file: add header if ($cookieAuth and ($theForm{"cookiereset"} ne "Reset")) { &initCookieWarning; # check to see if it's HTML: for($i = 0; $i < 10; $i++) { push(@firstlines, ); } chomp @firstlines; $firstglob = join("\n", @firstlines); if ($firstglob =~ /\)/\1\n$cookieWarning/si ; } else { # it's text: generate pseudo-html frame $printHTMLTail = 1; print " \n $cookieWarning \n

 \n";
        }
        print $firstglob;
      }
      while () { chomp; print; print "\n"; }  
#      print ;
      # /\ get the rest of the file spit out
      print("\n

") if $printHTMLTail; close FOOFILE; } # /is binary file? } # /what to do with request exit;