#!/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 <title> 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;