#!/opt/perl/bin/perl -w
$vernum = "1.2 - 04 MAR 99" ; # Code version and modify date
#
# Using the server-provided server name and the current directory,
# in conjunction with the config file "index.conf" in the current
# directory. (You may wish to rename this script something like
# "index.pl" for easier crossreferencing.)
#
# The known domains configuration file must be named "index.conf" and
# must reside in the script's directory.
# Format for known domains is <domaniname> <pagepath>
# where <pagepath> must end in ".html" or be a directory name
# <pagepath> is assumed to be relative to the directory
# in which this script resides unless <pagepath> begins with
# a "/" in which case it is assumed to be relative to DOCUMENT_ROOT
#
# If the specified page cannot be found, it looks for "index.html"
# in the script's directory and tries to use that. If still not found,
# an error page is displayed.
#
# D. W. Eaton, Artronic Development, Phoenix, AZ. September 1998
# dwe@arde.com
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#
# This code is not supported and is not warranteed to perform any particular
# function. Contact dwe@arde.com for aditional information.
# If you find bugs or make enhancements, it would be appreciated if you
# sent them on to the author at dwe@arde.com.
#
#
# Define some default configuration info:
$true        = 1;            # Truth values
$false       = 0;
$confname    = "index.conf"; # Configuration file name
$defaultpage = "index.html"; # Default page to try if all else fails
$bgcolorerr  = "#FFCCFF";    # Background color to flag errors
#
# Initialize:
$needhdr = $true;  # Still need MIME header
$displaypage = ""; # Clear displayed page
$diagnostics = ""; # Clear diagnostics -- hopefully we won't need them
$local = "";
$remote = "";
$docroot = "";
$scriptfilename = "";
$serveradmin = "";
#
# Get some info from the environment
$local  = $ENV {'SERVER_NAME'} ;
$remote = $ENV {'REMOTE_HOST'} ;
$docroot = $ENV {'DOCUMENT_ROOT'} ;
$scriptfilename = $ENV{'SCRIPT_FILENAME'} ;
$serveradmin = $ENV{'SERVER_ADMIN'} ;
$webmaster = "<A HREF=\"mailto:$serveradmin\">$serveradmin</A>";
#
$cwd = $scriptfilename;
$cwd =~ s/\/[^\/]*$//; # Isolate current script path
$toolid = $scriptfilename;
$toolid =~ s/^.*\///;  # Isolate script name
#
# Define HTML standard stuff:
$HTMLstartup = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n";
$HTMLstartup .= "<HTML><HEAD>\n" ;
$HTMLstartup .= "<META NAME=\"Generator\" CONTENT=\"$toolid $vernum\">\n";
$HTMLstartup .= "<!-- Created by Artronic Development, www.arde.com -->\n";
$HTMLmid     = "</HEAD><BODY BGCOLOR=\"$bgcolorerr\" LINK=\"#0000EF\" ";
$HTMLmid     .= "VLINK=\"#55188A\" ALINK=\"#FF0000\" TEXT=\"#000000\">\n";
$HTMLwrapup  = "</BODY></HTML>\n" ;
#
# Need to know more? We could always use:
#   SCRIPT_NAME
#   REQUEST_URI
#   HTTP_HOST
#
# Put out standard mime header
print "Content-type: text/html\n\n" ;
$needhdr = $false; # and say we have done so
#   
$config_file = $cwd . "/" . $confname; # config file path for this try
# ---------------- read config file -----------------
# Read the configuration file info
# Some data is required in the config file, other data is optional
# Some config file entries override variable values you see here
#
$errmsg = ""; # Clear error records
if (open (CFG, "<$config_file"))
{
   $lineno = 0;
   while (defined ($line = <CFG>))
   {
    $lineno++;
    next if ($line =~ /^#/ || length ($line) < 6) ;
    $line =~ s/\n$// ;  # Trim newline
    $rest = ""; # initialize
    $pageval = "";
    $host = "";
    ($host, $pageval, $rest) = split (' ', $line, 3) ;
    #
    if (defined ($rest) && ($rest !~ /^#/ && $rest ne ""))
    {    
     # Only comments are allowed after the last valid field:
     $errmsg .= " (Bad config line $lineno, extra fields: '$line')" ;
    }
    else
    {
     # Good line, hive it off
     $knownpages{$host} = "$pageval";
    }
   }
   close (CFG);
}
else   
{
   $errmsg .= " (can't open config file '$config_file')" ;
}
if ($errmsg)
{
 &err_msg ("$errmsg\n") ;
 exit (0) ;
}   
# ---------------- config file read -----------------
#
$defaultpath = $cwd . "/" . $defaultpage; # Default page (if we need it)
#
# See if we have a page
if (! defined $knownpages{$local})
{
 # Oops, this domain didn't have a page defined - try to default it
 $diagnostics .= "<!-- $local has no page defined -->\n";
 if ( -f $defaultpath )
 {
  # Well, OK, try to use the default
  $pickpath = $defaultpath;
 }
 else
 {
  # No luck today
  $pickpath = "none";
 }
}
else
{
 # Try to use the defined path
 $definedpath = $knownpages{$local};
 if ($definedpath =~ /^\//)
 {
  # Ah, they want to use a doc root absolute path ("/" already there)
  $pickpath = $docroot . $definedpath; # Path for picked page
 }
 else
 {
  $pickpath = $cwd . "/" . $definedpath; # Path for picked page
 }
}

if ($pickpath ne "none")
{
 if (! -f $pickpath)
 {
  # Well, check for a directory
  if ($pickpath !~ /\.html$/)
  {
   # Hmm, maybe 'tis a directory they are after - try it
   $pickpath =~ s/\/*$//; # Pull off any trailing slashes
   $pickpath .= "/" . $defaultpage; # Add on default page
  }
 }
 if (-f $pickpath)
 {
  $diagnostics .= "<!-- We will use $pickpath for $local -->\n";
 }
 else
 {
  # Shucks, we think we know of a page but can't find it
  if (-f $defaultpath)
  {
   # OK, use the default
   $pickpath = $defaultpath;
   $diagnostics .= "<!-- Guess we'll need to use $defaultpath -->\n";
  }
  else
  {
   # Oh, my it's getting worse   
   $diagnostics .= "<!-- $local page missing, no $defaultpath either -->\n";
   $pickpath = "none";
  }
 }
}

if ($pickpath eq "none")
{
 # Darn, no page available
 $displaypage = "$HTMLstartup\n";
 $displaypage .= "<TITLE>No page found</TITLE>\n" ;
 $displaypage .= "$HTMLmid\n";
 if ($diagnostics)
 {
  # Drop in any diagnostics ... maybe they'll help
  $displaypage .= "$diagnostics\n";
 }
 $displaypage .= "No page to display ";
 if ($local)
 {
  $displaypage .= "for $local ";
 }
 $displaypage .= "could be found.<BR>\n";
 if ($serveradmin)
 {
  # Whew, at least maybe someone can be told
  $displaypage .= "<P>Please notify $webmaster of the problem.</P>\n"; 
 }
 $displaypage .= "$HTMLwrapup\n";
}
else
{
 # ---------------- read picked file -----------------
 # Locate and read up the picked file
 $errmsg = ""; # Clear error records
 $lineno = 0;
 if (open (PICKPG, "<$pickpath"))
 {
   $lineno = 0;
   while (defined($line = <PICKPG>))
   {
    $lineno++;
    chomp ($line);
    # Look for server side includes:
    if ($line =~ /^\s*<\!--\s*#include\s+/)
    {
     # OK, found an include, need to try to process it
     $displaypage .= "<!-- INCLUDE FOUND:--><BR>\n";
     $displaypage .= "$line\n";
    }
    else
    {
     # Just tack on this line
     $displaypage .= "$line\n";
    } 
   }
   close (PICKPG);
 }
 else   
 {
   $errmsg .= " (can't open config file '$config_file')" ;
 }
 if ($errmsg)
 {
  &err_msg ("$errmsg\n") ;
  exit (0) ;
 }   
 # ---------------- picked file read -----------------
}
if ($displaypage)
{
 # Good, have something, display it
 print "$displaypage\n";
}

exit (0) ;

# - - - - - - - - - 
#
# Tell user that an error has occurred
sub err_msg
{
   local ($msg) = @_ ;
   
   if ($needhdr) 
   {
    # We need to put out a mime header
    print "Content-type: text/html\n\n" ;
   }
   print "$HTMLstartup\n";
   print "<TITLE>Configuration error</TITLE>\n" ;
   print "$HTMLmid\n";
   if ($diagnostics)
   {
    # Drop in any diagnostics ... maybe they'll help
    print "$diagnostics\n";
   }
   print "<H1>Error found in configuration</H1>\n" ;
   print "<P>Sorry, but one or more errors were detected ";
   print "while trying to display this page to you.\n";
   print "<P>$msg</P><P>\n" ;
   if ($serveradmin)
   {
    print "Contact the $webmaster if you need assistance.\n";
   }
   print "<HR>\n$HTMLwrapup" ;
}
#
