#!/usr/local/bin/perl5.6 -w
use strict;
use Text::Wrap;
use vars qw($VERSION $now $MAXPOST);

$MAXPOST = 50000;
($VERSION) = ('$Revision: 1.6 $' =~ /([\d\.]+)/); 
$now = scalar(localtime());
$Text::Wrap::break = '\s|-';
$Text::Wrap::columns = 132;

unless ($ENV{'REQUEST_METHOD'} eq 'POST' || $ENV{'REQUEST_METHOD'} eq 'GET') {
	die "THis program only handles GET and POST requests";
}

print qq(Content-type: text/html

<html>
<head>
<title>cgi-reflect.pl $VERSION $now</title>
<style type="text/css">
body {	font-family: "Gill Sans", Helvetica, sans-serif; }
h1,h2 {	font-size: 150%;
		font-weight: bold;
		color: #000000;		}
td {	font-size: 75%; }
.r {	color: #cc0000; }
.x {	background-color: #cccccc; }
.y {	background-color: #eeeeee; }
pre {	background-color: #ffffee; }
</style>
</head>
<body>
<h1>cgi-reflect.pl $VERSION $now</h1>

<p>This program shows Standard Input and the Environment given to your programs under your web server. You should
GET or POST things to it, even file uploads.</p>

<h2>Standard Input</h2><hr /><pre>);

eval {
	_showstdin();
};
alarm(0);
if ($@) {
	print qq(<h3>Error reading STDIN - $@</h3>);
}

print qq(</pre>
<hr />

<p><span class="r">Coloured text</span> is the hex form of any binary bytes. The hyphens are included to
break up the digits in an easy to read way, so ignore them. It is normal and correct to see <span class="r">0D</span> at the end of 
every line because it shows that network line breaks were sent.
<br>
Wrapping may lose spaces or hyphens at line-end in the wrapping process - this is normal. Put 'cgi-reflect-nowrap'
in the query string to turn off wrapping.</p>
<hr><h2>Environment</h2><table>
);

foreach (sort keys %ENV) {
	print "<tr><td class='x'>$_</td><td class='y'>" . _html_escape($ENV{$_}) . "</td></tr>\n";
}

print qq(</table><hr><p><strong>END OF OUTPUT</strong>
</body>
</html>
);

#####################################################

sub _showstdin {
	if ($ENV{'CONTENT_LENGTH'} > $MAXPOST) {
		die("Content length is too long, more than $MAXPOST bytes");
	}
	local $SIG{'ALRM'} = sub {
		die 'ALRM!';
	};
	alarm(5);
	while (<STDIN>) {
		if ($ENV{'QUERY_STRING'} =~ /cgi-reflect-nowrap/) {
			print _html_escape($_);
		} else {
			print Text::Wrap::wrap('', '', _html_escape($_));
		}
	}
	alarm(0);
}

sub _html_escape {
	my $str = shift;
	$str =~ s/</&lt;/g;
	$str =~ s/>/&gt;/g;
	$str =~ s/'/&#39;/g;
	$str =~ s/"/&quot;/g;
	return _binary_escape($str);
}

sub _binary_escape {
	my $toencode = shift;
	return undef unless defined($toencode);
	$toencode =~ s/([\000-\011\013\014-\037\200-\377])/_colour($1)/eg;
	$toencode =~ s|-</span><span class="r">||g;
	$toencode =~ s|-</span>|</span>|g;
	$toencode =~ s|<span class="r">-|<span class="r">|g;
	return $toencode;
}

sub _colour {
	my $x = shift;
	return ('<span class="r">-' . uc(sprintf("%02x",ord($x))) . '-</span>');
}

=pod

=head1 NAME

cgi-reflect.pl - exactly what your browser is sending to the web server - STDIN in an escaped format and environment variables

=head1 SYNOPSIS

Place this program in your /cgi-bin directory, or equivalent place, and submit POST requests to it. You will see exactly
what is sent to the program. This is especially useful for examining the multipart/formdata sent in by file upload forms
on various operating systems.

=head1 DESCRIPTION

Quite simply it shows all of STDIN, with unprintable characters escaped and coloured, and all the environment.

=head1 PREREQUISITES

Text::Wrap

=head1 COREQUISITES

None.

=begin comment

=pod OSNAMES

Unix (others untested)

=pod SCRIPT CATEGORIES

CGI

UNIX/System_administration

=pod README

A CGI to show you exactly what your browser is sending to the web server - STDIN in an escaped format
and all environment variables.

=end comment

=head1 VERSION

$Revision: 1.6 $

=cut
