#!/usr/bin/perl -Tw
#
#  LDAP Apache Configs
#  $Source: /repos/development/acs-http/acs-http/cgi-bin/vars.cgi,v $
#  $Revision: 1.1.2.24 $
#  $Date: 2004/11/23 11:41:12 $
#  $Author: syzdek $
#  $Locker:  $
#
#  vars.cgi - simple CGI example that displays Apache ENV Variables
#

# +-=-=-=-=-=-+
# |           |
# |  Headers  |
# |           |
# +-=-=-=-=-=-+

use CGI::Carp qw(fatalsToBrowser);	# Make errors safe for Web servers
use strict;				# Enforce good programming habits

$|++;				# Disables Line buffering

our $CONFIGURATION	= '/dev/null';

our $PROGRAM_NAME	= 'vars.cgi';
our $VERSION		= '0.01';
our $DESCRIPTION	= 'simple CGI example that displays Apache ENV Variables';
our $AUTHOR		= 'David Syzdek <syzdek@mosquitonet.com>';
our $COPYRIGHT		= 'Copyright (c) 2004 David M. Syzdek <syzdek@mosquitonet.com>';


# +-=-=-=-=-=-=-=+
# |              |
# |  Prototypes  |
# |              |
# +-=-=-=-=-=-=-=+

sub cookie_data($);		# displays http_cookie data
sub headers($$);		# displays headers
sub html_bottom();		# displays last part of HTML
sub html_top();			# displays first part of HTML
sub query_data($);		# displays query_string data
sub sourcedump($$);		# displays source code
sub vars(%);			# displays Apache environment variables

sub main(@);			# main statement (old C habit)


# +-=-=-=-=-=-=-+
# |             |
# |  Functions  |
# |             |
# +-=-=-=-=-=-=-+

# displays formatted data
sub cookie_data($)
{
   # grabs passed args
   my $data		= shift || return(0);

   # declares local vars
   my $decoded;
   my $pair;
   my $name;
   my $value;
   my @pairs;

   # cleans up data
   $decoded = $data;
   $decoded =~ tr/+/ /;
   $decoded =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

   # displays html
   print ("         <font size=+3><b>HTTP_COOKIE Data</b></font>\n");
   print ("         <p>\n");
   print ("            <table border=1>\n");
   print ("               <tr>\n");
   print ("                  <td>formatted_data</td>\n");
   print ("                  <td>\n");
   print ("                     <table border=1>\n");
   print ("                        <tr><td>Field</td><td>Value</td></tr>\n");

   # loops through vars
   $data =~ s/; /;/g;
   @pairs = split(/;/, $data);
   foreach $pair (@pairs) {
      ($name, $value) = split(/=/, $pair);
      if ($name =~ /^([\w]+)$/) {
         $name = $1;
        } else {
         die "illeagal characters in data name: $name\n";
      };
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      print ("                        <tr><td>$name</td><td>$value</td></tr>\n");
   };

   # finishes html
   print ("                     </table>\n");
   print ("                  </td>\n");
   print ("               </tr>\n");
   print ("            </table>\n");
   print ("         </p>\n");

   # ends function
   return(0);
};


# displayes headers
sub headers($$)
{
   # grabs passed args
   my $request_method	= shift;
   my $content_length	= shift;

   # declares local vars
   my $buffer;
   my $name;
   my $value;
   my $pair;
   my @pairs;
   my %data;

   # reads posted data
   if (defined($request_method) && defined($content_length)) {			# verifies that the env variables were defined
      if ($request_method eq 'POST') {						# verifies that there is POST data to read
         read(STDIN, $buffer, $content_length);					# retrieves posted data
         @pairs = split(/&/, $buffer);						# splits apart the buffer in name and value pairs
         chomp (@pairs);								# removes unnecessary newlines and carriage returns
         foreach $pair (@pairs) {							# loops through each pair
            ($name, $value) = split(/=/, $pair);					# seperates the field name and value
            if ($name =~ /^([\w]+)$/) {						# verifies the name has allowed characters
               $name = $1;							# detaints data
              } else {
               die "illeagal characters in data name: $name\n";			# kills script if invalid characters where in field name
            };
            $value =~ tr/+/ /;							# decodes white space
            $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;		# decodes hex data
            $data{$name} = $value;						# stores data in a hash
         };
      };
   };

    # sets cookies
#         if (! defined($data{'timestamp'})) {
#            print ("Set-Cookie: timestamp=", time, "; path=/\n");
#            print ("Set-Cookie: program_name=$PROGRAM_NAME; path=/\n");
#            print ("Set-Cookie: version=$VERSION; path=/\n");
#            print ("Set-Cookie: description=$DESCRIPTION; path=/\n");
#            print ("Set-Cookie: author=$AUTHOR; path=/\n");
#            print ("Set-Cookie: copyright=$COPYRIGHT; path=/\n");
#           } else {
#            print('Set-Cookie: timestamp=null; path=/; expires=Thursday, 27-Feb-03 00:00:00 GMT;', "\n");
#            print('Set-Cookie: program_name=null; path=/; expires=Thursday, 27-Feb-03 00:00:00 GMT;', "\n");
#            print('Set-Cookie: version=null; path=/; expires=Thursday, 27-Feb-03 00:00:00 GMT;', "\n");
#            print('Set-Cookie: description=null; path=/; expires=Thursday, 27-Feb-03 00:00:00 GMT;', "\n");
#            print('Set-Cookie: author=null; path=/; expires=Thursday, 27-Feb-03 00:00:00 GMT;', "\n");
#            print('Set-Cookie: copyright=null; path=/; expires=Thursday, 27-Feb-03 00:00:00 GMT;', "\n");
#         };

   # Specifies format
   print ("Content-type: text/html\n\n\n");

   # ends function
   return(0);
};


# displays last part of HTML
sub html_bottom()
{
   # displays html
   print ("         <p>\n");
   print ("            <font size=+1><a href=?sourcedump>View Source Code</a></font>\n");
   print ("         </p><p>\n");
   print ("            <table>\n");
   print ("               <tr>\n");
   print ("                  <td>\n");
   print ("                     <form method=link>\n");
   print ("                        <input type=hidden name=configuration value=\"$CONFIGURATION\">\n");
   print ("                        <input type=hidden name=program_name value=\"$PROGRAM_NAME\">\n");
   print ("                        <input type=hidden name=version value=\"$VERSION\">\n");
   print ("                        <input type=hidden name=revision value=", '"$Revision: 1.1.2.24 $"', ">\n");
   print ("                        <input type=hidden name=description value=\"$DESCRIPTION\">\n");
   print ("                        <input type=hidden name=author value=\"$AUTHOR\">\n");
   print ("                        <input type=hidden name=copyright value=\"$COPYRIGHT\">\n");
   print ("                        <input type=submit value='Set QUERY_STRING'>\n");
   print ("                     </form>\n");
   print ("                  </td><td>\n");
   print ("                     <form method=post>\n");
   print ("                        <input type=hidden name=timestamp value=", time, ">\n");
   print ("                        <input type=submit value='Clear Cookie'>\n");
   print ("                     </form>\n");
   print ("                  </td>\n");
   print ("               </tr>\n");
   print ("            </table>\n");
   print ("         </p>\n");
   print ("      </center>\n");
   print ("   </body>\n");
   print ("</html>\n");

   # ends function
   return(0);
};


# displays first part of HTML
sub html_top()
{
   # displays html
   print ("<html>\n");
   print ("   <head>\n");
   print ("      <title>Apache Vars</title>\n");
   print ("   </head>\n");
   print ("   <body>\n");
   print ("      <center>\n");

   # ends function
   return(0);
};


# displays formatted data
sub query_data($) {

   # grabs passed args
   my $data               = shift || return(0);

   # declares local vars
   my $decoded;
   my $pair;
   my $name;
   my $value;
   my @pairs;

   # cleans up data
   $decoded = $data;
   $decoded =~ tr/+/ /;
   $decoded =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

   # displays html
   print ("         <font size=+3><b>QUERY_STRING Data</b></font>\n");
   print ("         <p>\n");
   print ("            <table border=1>\n");
   print ("               <tr>\n");
   print ("                  <td>formatted_data</td>\n");
   print ("                  <td>\n");
   print ("                     <table border=1>\n");
   print ("                        <tr><td>Field</td><td>Value</td></tr>\n");

   # loops through vars
   @pairs = split(/&/, $data);
   foreach $pair (@pairs)
   {
      ($name, $value) = split(/=/, $pair);
      if ($name =~ /^([\w]+)$/)
      {
         $name = $1;
      } else {
         die "illeagal characters in data name: $name\n";
      };
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      print ("                        <tr><td>$name</td><td>$value</td></tr>\n");
   };

   # finishes html
   print ("                     </table>\n");
   print ("                  </td>\n");
   print ("               </tr>\n");
   print ("            </table>\n");
   print ("         </p>\n");

   # ends function
   return(0);
};


# displays source code
sub sourcedump ($$)
{
   # grabs passed args
   my $query_string	= shift || return(0);
   my $script_filename	= shift || return(0);

   # determines whether to show source code
   if ($query_string eq 'sourcedump')
   {
      if (defined($ENV{'SCRIPT_FILENAME'}))
      {
         print("Content-type: text/plain\n\n");
         open(FILE, $ENV{'SCRIPT_FILENAME'}) || die("unable to open CGI for reading\n");
         while (<FILE>)
         {
            print ($_);
         };
         close(FILE);
         exit(0);
      };
   };

   # ends function
   return(0);
};


# displays Apache environment variables
sub vars(%)
{
   # grabs passed args
   my %env	= @_;

   # declares local vars
   my $key;
   my $buffer;

   # starts HTML
   print ("         <font size=+3><b> Apache Vars </b></font>\n");
   print ("         <p>\n");
   print ("            <table border=1>\n");
   print ("               <tr><td>Var Name</td><td>Var Data</td></tr>\n");

   # loops through environment variables
   foreach $key (sort(keys(%env))) {
      print ("               <tr><td>$key</td><td>$env{$key}</td></tr>\n");
   };

   # ends HTML
   print ("            </table>\n");
   print ("         </p>\n");

   # ends function
   return(0);
};


# +-=-=-=-=-=-=-=-=-+
# |                 |
# |  Main  Section  |
# |                 |
# +-=-=-=-=-=-=-=-=-+
sub main(@)
{
   # grabs passed args
   my @argv	= @_;

   # displays source code
   if(sourcedump($ENV{'QUERY_STRING'}, $ENV{'SCRIPT_FILENAME'})) {
      return(0);
   };

   # displays headers
   headers($ENV{'REQUEST_METHOD'}, $ENV{'CONTENT_LENGTH'});

   # displays start of CGI
   html_top();

   # displays vars
   vars(%ENV);

   # displays args
   print("<pre>Name: ", $0, "</pre>");

   # displays linked data
   query_data($ENV{'QUERY_STRING'});

   # displays cookie data
   cookie_data($ENV{'HTTP_COOKIE'});

   # displays end of CGI
   html_bottom();

   # ends function
   return(0);
};
exit(main(@ARGV));