#!/usr/local/bin/perl -Tw # CGI Debugger v1.0 from # The Complete Webmaster # written by Doug Steinwand # # Usage: http://yourhost.com/cgi-bin/debug.pl/script-to-be-debugged # use IPC::Open3; use Cwd; sub printWarn; sub printEnv; sub endColorHtml; sub colorHtmlize; sub htmlize; my($seenLt)=0; $|=1; print < Perl CGI Debugger CGI Debugger v1.0 from The Complete Webmaster - written by Doug Steinwand
EOT # removing taint checks from PATH and SCRIPT_FILENAME # (this is dangerous.) $ENV{'SCRIPT_FILENAME'}=~/(.+)/; $ENV{'SCRIPT_FILENAME'}=$1; $ENV{'PATH'}=~/(.+)/; $ENV{'PATH'}=$1; # figure out the name of our script $ENV{'SCRIPT_FILENAME'}=~m!^.*/(.+)!; $ourName=$1; # find real script to run from the PATH_INFO variable if (defined $ENV{'PATH_INFO'} && $ENV{'PATH_INFO'}=~m!^/(.+?)(/.*|$)!) { $script=$1; $pathInfo=$2; # set the new path info if (length $pathInfo) { # remove PATH_INFO from PATH_TRANSLATED $ENV{'PATH_TRANSLATED'}=~s/$ENV{'PATH_INFO'}$//; # set the new PATH_INFO and PATH_TRANSLATED $ENV{'PATH_INFO'}=$pathInfo; $ENV{'PATH_TRANSLATED'}.=$pathInfo; } else { # erase from the environment delete($ENV{'PATH_INFO'}); delete($ENV{'PATH_TRANSLATED'}); } # change SCRIPT_NAME and SCRIPT_FILENAME to reflect # the name of the new script we'll be running $ENV{'SCRIPT_NAME'}=~s/$ourName$/$script/; $ENV{'SCRIPT_FILENAME'}=~s/$ourName$/$script/; printEnv(); if (-f $ENV{'SCRIPT_FILENAME'} && -x $ENV{'SCRIPT_FILENAME'}) { # start the script in a separate process $pid = open3('<&STDIN', \*CHLDOUT, \*CHLDOUT, $ENV{'SCRIPT_FILENAME'}); # current directory $dir=htmlize(cwd); print <Script "$script" Current directory: $dir
Output from $ENV{'SCRIPT_FILENAME'} (PID $pid): 
EOT
        $header=1;
	$gottype="";
	while () {
	    chomp;
	    if (length($_)==0) {
		$header=0; 
		printWarn "Content-type not specified" unless length $gottype;
	    } elsif ($header && /^Content-type:\s*(.+)/i) {
		if (length $gottype) {
		    printWarn "Content-type specified more than once";
		} else {
		    $gottype=$1;
		}
	    }
	    if ($header) {
		printWarn "Possible malformed header from script:" unless (/:/);
		print "",htmlize($_),"";
	    } elsif ($gottype=~m!text/html!i) {
		print colorHtmlize($_);
	    } else {
		print htmlize($_);
	    }
	    print "\n";
	}
	print endColorHtml();
	print "
Script finished ",scalar(localtime); } else { print "

Cannot execute $ENV{'SCRIPT_FILENAME'}

\n"; } } else { # no script name given print "

Usage: $ENV{'SCRIPT_NAME'}/script-to-run

"; } print "\n"; exit 0; # displays the contents of the environment sub printEnv { print <Environment Variables EOT foreach (sort keys %ENV) { print "", "\n"; } print "
",htmlize($_),"\"",htmlize($ENV{$_}),"\"
\n"; } # displays red text sub printWarn { my($m)=shift; print "Warning: $m\n"; } # changes "&" -> "&" and "<" -> "<" sub htmlize { my($a)=@_; $a=~s/&/&/g; $a=~s/<"; $seenLt=1; } elsif ($c eq ">" && $seenLt) { $ret.=">"; $seenLt=0; } elsif ($c eq "&") { $ret.="&"; } else { $ret.=$c; } } return $ret; } sub endColorHtml { if ($seenLt) { $seenLt=0; return ""; } else { return ""; } }