#########################################################################
#  voh-lib.pl  Version 4.1 January 22, 1997  w/departments
#  Copyright (c) 1996-1997 Matthew J. Walker
#  This is a library file with all the conserved routines of the three 
#  VOH scripts.  It is optimized for ease of use and maintenance.
#  It MUST be placed in a directory recognized as a library directory by
#  Perl (Which often includes .)
#########################################################################
# Subroutine GetFormData adapted from code published in
# Oreilly and Associates
# "Managing Internet Information Services",
# with a slight modification from Steven Brenner's cgi-lib.pl.
#########################################################################

require 'ctime.pl'; #Standard Perl library

#########################################################################
# SetupVOH
#
# Main routine of VOH scripts.
#
# Creates and initializes the following variables:
#
# $config_file
# $warning
# $root_path
# $root_url
# $cgi_url
# $link_path
# $time
# $date
# $admin_email
# $questions_path
# $HTTP_header
# $SMTP_server
# $HTML_footer
# $HTML_title
# $HTML_background
# $HTML_bgcolor
# $verification_string
# $diagnositics
# $system_type
# $posted_from
# *in
# $posted_from
#########################################################################
#  Edit the following variables.
#########################################################################

sub SetupVOH {
   #------------------------------------------------------------------------
   # Convert the data from a form into %in
   #------------------------------------------------------------------------
   &ConvertFormData;
   
   #------------------------------------------------------------------------
   # Remember where you came from ...
   #------------------------------------------------------------------------
   $posted_from = $ENV{'REMOTE_HOST'};

   #------------------------------------------------------------------------
   # Warning contains the string included on the CGI generated input form
   # to provide the individual with information about the submission.
   #------------------------------------------------------------------------
   $warning = "Important:  Once you submit this, it must be manually 
edited if corrections are needed." ;
   
   #------------------------------------------------------------------------
   # root_path is the absolute path to the site's root in the file system
   # (the directory where the lecture directories are stored)
   #------------------------------------------------------------------------
   $root_path ="/root_of_voh";

   #------------------------------------------------------------------------
   # Config_file is the absolute path and file name of the configuration file.
   # :'s for Mac /'s for Unix/NT
   #------------------------------------------------------------------------
   $config_file = "$root_path/conf/voh.conf" ;

   #------------------------------------------------------------------------
   # root_url is the URL path to the root of the voh files
   # (For use with relative links.  http://server.ip/root_url/)
   # NOTE:  If your voh is at your server root, do not include the leading
   # "/", ie set $root_url = "";
   #------------------------------------------------------------------------
   $root_url = "/VOH";

   #------------------------------------------------------------------------
   # cgi_url is the URL path to Perl cgi scripts
   # (For use with relative links.  http://server.ip/cgi_url/scriptname)
   # Some servers like to use /scripts.  This will break pre-written html
   # ie blanks/* will have to be modified!
   #------------------------------------------------------------------------
   $cgi_url = "/cgi-bin";

   #------------------------------------------------------------------------
   # Get the system time and make the date string from it.
   #------------------------------------------------------------------------
   $time = time;
   $date = &ctime($time);
   chomp($date);
   
   #------------------------------------------------------------------------
   # admin_email is the email address to which queries about VOH are
   # to be sent.
   # @ must be backspaced!  email\@u.edu
   #------------------------------------------------------------------------
   $admin_email = "email\@u.edu";
   
   #------------------------------------------------------------------------
   # URL used for links to specific class directories.
   #------------------------------------------------------------------------
   # Allows for encoding lecture:instructor otherwise no harm...
   ($temp_lecture = $in{lecture}) =~ tr#:#/#;
   #------------------------------------------------------------------------
   $link_path = "$root_url/$temp_lecture" ;

   #------------------------------------------------------------------------
   # Set up paths
   # questions_path is the full path to individual class questions directories.
   #------------------------------------------------------------------------
   $questions_path = "$root_path/$in{lecture}/questions";
   
   #------------------------------------------------------------------------
   # HTTP header setup:
   #------------------------------------------------------------------------
   $HTTP_header = &HTTP_Header;

   #------------------------------------------------------------------------
   # The standard HTML for output back to the browser
   #------------------------------------------------------------------------
   $HTML_footer = &HTML_Footer;
   $HTML_title  = "VOH"; # Goes in the <title></title> lines.
   $HTML_bgcolor = "bgcolor=\"#FFFFFF\"";
   $HTML_background = "background=\"$root_url/images/voh-back.gif\"";
   
   #------------------------------------------------------------------------
   # Server for SMTP connections
   #------------------------------------------------------------------------
   $SMTP_server = "smtp.server.u.edu";
   
   #------------------------------------------------------------------------
   # VOH Server Name
   #------------------------------------------------------------------------
   $VOH_server = "voh.u.edu";

   #------------------------------------------------------------------------
   # Sting to authenticate forms
   #------------------------------------------------------------------------
   $verification_string = "";
   
   #------------------------------------------------------------------------
   # Boolean determines whether Failures result in detailed information 
   # on or off
   # !!! You'll want this OFF after you have completed the install! !!!
   #------------------------------------------------------------------------
   $diagnostics = "on";

   #------------------------------------------------------------------------
   # Type of system
   # Mac, UNIX, or NT
   # Switching to Mac requires that all filesystem directory references
   # be inspected as Mac uses ":" as its directory separator instead of 
   # "/".  NTPerl seems to handle "/" as well as "\".
   #------------------------------------------------------------------------
   $system_type = "UNIX";
 
}

#########################################################################
# DissectReferer
# Hacks up HTTP_REFERER environment variable into fields
# Code assumes lecuture:instructor layout.  Not used.
#########################################################################
sub DissectReferer {
   local($referer_doc);
   $referer_doc = $ENV{'HTTP_REFERER'};
   $referer_doc =~ s#http://$ENV{'SERVER_NAME'}/##;
   ($directory,$lecture,$instructor) = split('/', $referer_doc);
}

#########################################################################
# HTTP_Header
# Routine provides the text for the standard HTTP response header.
#
# Server: $ENV{'SERVER_SOFTWARE'} Works on some systems...
# Don't forget blank line after Content-type line!!!
#########################################################################
sub HTTP_Header {
   local($header);
$header = <<"HEADER";
Content-type: text/html

HEADER
}

#########################################################################
# Routine provides a standard footer for all generated HTML
#########################################################################
sub HTML_Footer {
   local($footer);
   $footer = <<"FOOTER";
<hr>
<center>
<a href="$root_url/"><img src="$root_url/images/home-icon.gif"
width=60 height=60 alt="[$directory Home Page]" align="center"></a>
<a href="$link_path/"><img src="$root_url/images/back-icon.gif"
width=60 height=60 alt="[Back]" align="center"></a>
<a href="#TOP"><img src="$root_url/images/top-icon.gif"
width=60 height=60 alt="[Top]" align="center"></a>
<hr>
<a href="mailto:$admin_email">$admin_email</a>
</center>
</body>
</html>
FOOTER
}

#########################################################################
# ConvertFormData
# Converts form data regardless of source and method.
#########################################################################
sub ConvertFormData {
   local ($pair, $key, $val);

   
   #------------------------------------------------------------------------
   # If data is via a POST method, it is read directly from the standard input
   #------------------------------------------------------------------------
   if ($ENV{'REQUEST_METHOD'} eq "POST") {
      read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
   }
   
   #------------------------------------------------------------------------
   # Else, if the data come via a GET method, it is read from the QUERY_STRING
   # environment variable
   #------------------------------------------------------------------------
   elsif ($ENV{'REQUEST_METHOD'} eq "GET") {
      $in = $ENV{'QUERY_STRING'};
   }
   
   #------------------------------------------------------------------------
   # Otherwise, something's amiss
   #------------------------------------------------------------------------
   else {
      &Failure(02);
   }

   #Split into key-pairs on '&'
   @in = split(/&/,$in);

   foreach $pair (@in) {
      ($key, $val) = split(/=/, $pair);
      # Convert plus's to spaces
      $val =~ tr/+/ /;
      # Convert %XX from hex numbers to alphanumeric
      $val =~ s/%(..)/pack("C",hex($1))/ge;
      #Prevent tilde escapes in mail
      $val =~ s/~/ ~/g;
      $in{$key} .= '\0' if (defined($in{$key}));
      $in{$key} .= $val;
   }
}

#########################################################################
# GetConf
# Checks configuration file, and loads info into @conf.
#########################################################################
sub GetConf {
   open(CONF, "$config_file") || (&Failure(15)) ;
   while (<CONF>) {
      chop;
      next if /^#/ ;
# Currently using , for for delimiter
      @conf = split(",", $_) ;
# 0 = lecture (lectue:instructor); 1 = public; 2 = confidential; 3 = email
      ($conf[0] eq $in{lecture}) && last ;
      }
   close(CONF);
   ($conf[0] ne $in{lecture}) && (&Failure(03)) ;
}

# CheckEmpty
# Checks for empty fields and returns there names in a string.

sub CheckEmpty {
   local ($key, $value) ;
   $efields = "" ;
   foreach $key (keys(%in)) {
#Uncomment following if you wish to allow empty email field
#      ($key eq "email") && next ;
      unless ($in{$key}) {$efields .= "$key, " }
   }
   ($efields) && (&Failure(01)) ;
}

#########################################################################
# Failure
# $error_text provides context sensitive error messages.  All
# script failures are caught and error messages generated. No
# circumstance should allow a server error.
#########################################################################
sub Failure {
   local ($error, $html, $reason) = @_ ;
   FAILURE: {
   #### General Errors:
   $error_text_01 ="Field(s):  $efields were left blank.";
   $error_text_02 ="Form Data Conversion Failed." ;
   $error_text_03 ="No configuration entry for this lecture." ;
   $error_text_04 ="Answer Form Submitted empty. Please resubmit." ;
   $error_text_07 ="Fallen through script. Contact VOH administrator." ;
   #### Open Failures:
   $error_text_11 ="Cannot open questions directory" ;
   $error_text_12 ="Cannot open question file" ;
   $error_text_13 ="Cannot open file to post!" ;
   $error_text_14 ="Cannot open mail!" ;
   $error_text_15 ="Cannot open Configuration File." ;
   $error_text_16 ="Cannot open temporary file." ;
   #### Access Denial:
   $error_text_21 ="Your site cannot access VOH at this time." ;
   $error_text_22 ="Public submission disabled for this lecture.";
   $error_text_23 ="Confidential submission disabled for this lecture.";
   $error_text_24 ="Attempted Security Violation. Your address has been 
logged.";

   ($error == 01) && ($reason = $error_text_01, last FAILURE);
   ($error == 02) && ($reason = $error_text_02, last FAILURE);
   ($error == 03) && ($reason = $error_text_03, last FAILURE);
   ($error == 04) && ($reason = $error_text_04, last FAILURE);
   ($error == 07) && ($reason = $error_text_07, last FAILURE);
   ($error == 11) && ($reason = $error_text_11, last FAILURE);
   ($error == 12) && ($reason = $error_text_12, last FAILURE);
   ($error == 13) && ($reason = $error_text_13, last FAILURE);
   ($error == 14) && ($reason = $error_text_14, last FAILURE);
   ($error == 15) && ($reason = $error_text_15, last FAILURE);
   ($error == 16) && ($reason = $error_text_16, last FAILURE);
   ($error == 21) && ($reason = $error_text_21, last FAILURE);
   ($error == 22) && ($reason = $error_text_22, last FAILURE);
   ($error == 23) && ($reason = $error_text_23, last FAILURE);
   ($error == 24) && ($reason = $error_text_24, last FAILURE);
   $reason = $error ;
   }
#########################################################################
$html = <<"ERROR_HEAD";
$HTTP_header
<html><head>
<title>$HTML_title // Failure!</title></head>
<body $HTML_bgcolor $HTML_background >
<h1>Form Submission Failed!</h1>
<hr>
<p>
$reason
</p>
<hr>
<hr>
ERROR_HEAD

#########################################################################
# Diagnostic Stuff
#########################################################################
if ($diagnostics eq "on") {
   $html .= <<"ERROR_MID";
<center>
<h3>Diagnostic Output for the Programmer</h3>
<HR>

<TABLE BORDER CELLPADDING="0" CELLSPACING="0" WIDTH="0">
ERROR_MID

   foreach $key (keys(%ENV)) {
      $html .= "<tr><th>$key</th><td>$ENV{$key}</td></tr>\n";
   }

   $html .= "<tr><th colspan=2><hr></th></tr>";

   foreach $key (keys(%in)) {
      $html .= "<tr><th>$key</th><td>$in{$key}</td></tr>\n";
   }
   $html .= "</table></center>\n" ;
}
### Finish up
# insert other to print variables here if necessary...
###
   $html .=  $HTML_footer;
   if ($system_type eq "Mac") {
      MacPerl::Reply($html);
   } else {
      print $html;
   }
   exit;
}


#########################################################################
# Return 1 to keep require call happy.
#########################################################################
1;