#!/usr/bin/perl
#/scripts 775
#
####################################################################
# Copyright 1996 Charles D. Johnson, ScendTek Internet Corp.
# Permission granted to use and modify this application so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the application.
#
# Many thanks to Steven Brenner for his ReadParse procedure!
# ReadParse was my first introduction to the CGI interface and
# parsing FORM POST Data.
#
#
# CGITAP - CGI Script Analysis and Debugging Utility
#

$name = "cgitap"; # name of this script

# Prepare to output cgitap results

print "Content-type:text/html\n\n";


print "<H2><I>CGITAP</I> - CGI Script Analysis and Debugging Utility</H2>\n";
print "<H4>Author: Charles D. Johnson, ScendTek Internet Corp.</H4>\n";
print "Copyright 1996 Charles D. Johnson, ScendTek Internet Corp.<BR>\n";
print "Permission granted to use and modify this application so long as the<BR>\n";
print "copyright above is maintained, modifications are documented, and<BR>\n";
print "credit is given for any use of the application.<BR><BR>\n";

$0 =~ /([^\/]+)$/; # seperate path and this script's name
$this = $1; # this script name

if ($this eq $name) { # translate some of the environment because cgitap is in the path
    $path = $ENV{PATH_INFO};
    unless ($path) {
        print "<H3>CGITAP must have a target CGI script specified:</H3>\n";
        print "<H4>Example: http://yourserver.com/cgi-bin/cgitap/script</H4>\n";
	die;
    }
    $path =~ /\/([^\/]+)(.*)/;
    $prog = $1;
    $prog_exe = $prog;
    $ENV{PATH_INFO} = $2; # remove cgi-script program name from path

    $ENV{SCRIPT_NAME} =~ s/[^\/]+$/$prog/; # adjust the script name variable
    $ENV{SCRIPT_FILENAME} =~ s/[^\/]+$/$prog/; # adjust the script filename variable
    $ENV{PATH_TRANSLATED} =~ s/\/$prog//; # remove script name from path
} else { # cgitap is not in the path, we are using the symbolic link method of execution
    $prog = "$this";
    $prog_exe = "$this.tap";
}

print "<HR>";

print "<H3>General Diagnostics</H3>\n";

print "<pre>\n";
print "CGI Script = $prog (via $prog_exe)\n";

if ($ENV{SERVER_SOFTWARE} =~ /cern/i) {
	$prog_path = $ENV{SCRIPT_NAME}; # cern uses SCRIPT_NAME
} else {
	$prog_path = $ENV{SCRIPT_FILENAME};
}

$prog_path =~ s/[^\/]+$/$prog_exe/;

unless (-e $prog_path) {
    print "%% WARNING %% - Target script: $prog_exe does not exist\n";
} else {
    unless (-x $prog_path) {
	print "%% WARNING %% - Designated script: $prog_exe does not have execute permissions\n";
    }
    if (-u $prog_path || -g $prog_path || -k $prog_path){
	print "%% WARNING %% - Designated script: $prog_exe has setuid, setgid and/or sticky bit set\n";
    }
}

print "\n\n</pre>\n";

# Dump the environment variables

print "<HR>\n";
print "<H3>CGI Environment</H3>\n";
print "<pre>\n";
foreach $var (keys %ENV){
    print "$var = $ENV{$var}\n";
}
print "\n\n</pre>\n";


&ReadParse(*STD); # returns stdin vars in %STD

$ENV{INDATA} = $STD; # data chunk from STDIN saved in Environment

print "<HR><PRE>\n";
print "<H3>POST Form Data</H3>\n";
foreach $var (keys %STD){
    print "$var = $STD{$var}\n";
}
print "\n\n</pre>\n";

print "<HR>\n";
print "<H3>CGI Script Output for $prog (via $prog_exe)</H3>\n";
unless (-e $prog_path) {
	print "<H3>Exiting because target script is not present!</H3>\n";
	exit;
}

unless (open(FILE,"echo \$INDATA | $prog_path 2>&1 |")) {
    print "Could not start $prog to execute!\n";
    die;
}

@get = <FILE>;

print "<pre>\n";
foreach $line (@get) {
    $nline = $line;
    $nline =~ s/\>/\&gt/g;
    $nline =~ s/\</\&lt/g;
    print "$nline";

    if ($line =~ /content-type/i) { # remove the content type since we assume html
	$line = "";
    }
}
print "\n\n</pre>\n";


print "<HR><H3>CGITAP Complete, Resulting HTML document follows...</H3><HR><BR><BR><BR>\n";



foreach $line (@get) {
    print "$line";
}

print "\n\n";


####################################################################
# Copyright 1994 Steven E. Brenner  
# Unpublished work.
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.
#
# Thanks are due to many people for reporting bugs and suggestions
# especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
# Andrew Dalke, Mark-Jason Dominus and Dave Dittrich.

# see http://www.seas.upenn.edu/~mengwong/forms/   or
#     http://www.bio.cam.ac.uk/web/                for more information

# ReadParse was modified by ScendTek Internet Corp.; 7/3/95

# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# one key=value in each member of the list "@in"
# Also creates key/value pairs in %in, using '\0' to separate multiple
# selections

# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
# information is stored there, rather than in $in, @in, and %in.

sub ReadParse {
    local (*in) = @_ if @_;


  local ($i, $loc, $key, $val);

  # Read in text
  if ($ENV{'REQUEST_METHOD'} eq "GET") {
    $in = $ENV{'QUERY_STRING'};
  } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  }

  @in = split(/&/,$in);

  foreach $i (0 .. $#in) {
    # Convert plus's to spaces
    $in[$i] =~ s/\+/ /g;
    # Convert %XX from hex numbers to alphanumeric (moved: ScendTek; 7/3/95)
    $in[$i] =~ s/%(..)/pack("c",hex($1))/ge;

    # Split into key and value.  
    ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

    # Convert %XX from hex numbers to alphanumeric
    #$key =~ s/%(..)/pack("c",hex($1))/ge;
    #$val =~ s/%(..)/pack("c",hex($1))/ge;

    # Associate key and value
    $in{$key} .= " :: " if (defined($in{$key})); # :: is the multiple separator (ScendTek; 7/3/95)
    $in{$key} .= $val;

  }

  return 1; # just for fun
}


1; #return true