#!/usr/bin/perl

=pod

=head1 Hash It v1.5.5

Hash It will take the query string from $ENV{'QUERY_STRING'},
convert it to name-value pairs, and then put it into the hash
%query. It also takes the posted date (Method="Post") and puts it
into the hash %post. And best of all, there is little coding on your
part. Just one line!

=head1 How To Use It

You use it in your script as follows:

C<require 'hash-it.pm';> It used to have a C<&getQuery;> part, but
that is now handled internaly.

B<IMPORTANT:> Make sure that if you install a __WARN__ or a __DIE__
subroutine, to do it AFTER you call hash-it to init with the 
C<require>.  Hash-It installs one of it's own to email any problems
to you.

B<VERY IMPORTANT:> Make sure to edit the mail sending line below to
send to your adress using the proper comand on your system. This is where
Hash-It sends notification if a script dies or recieves a warning.

=head1 Variables & Functions Provided By Hash-It

=over 4

=item

C<$TILE_TO_LIVE> Use this to set the expire on documents sent by
B<Hash-It>. When this time has elapsed the data will be removed
from the web browser's cache(s), and if wanted again, a new request
will be sent. This value is in seconds, and the default is 1800 (30
minutes).

=item

C<HTMLout(html_code)> Use this to output HTML. You should not specify any
headers (Content-Type, Content-Length, etc.) because they are done for you.
An expiration date is also set for you, based upon $TIME_TO_LIVE, which is
specified in seconds. The default value for $TIME_TO_LIVE is 1800 (30 minutes).

=item

C<SuperHTMLout(html_code,title)> This does the same thing as HTMLOut except
you only specify the part of the document that would go between the HTML
body tags and a title. This is usefull for quick output.

=item

C<CheckArgs(argname1,argname2,argname2...)> This checks to see if the specified
parameters were passed to your script and are not empty, either by a HTTP query
or a HTTP post.

=item

C<MailTo(address,data)> Sends mail to I<address>. The body of the message will be
I<data>. It will add some headers (X-headers) about the location of the script.
Note that the return address will not be valid, so you must specify one in the
body if you want a reply. Furture versions may address this shortcomming.

=back

=head2 Why To Use It

=over 4

=item 1

You will not be killed by empty items. Sometimes a user will forget
to enter something in a field, and if you were to just use
split(/&/) it would screw up your script.

=item 2

You will not be killed by undefined items. If you use checkboxes, you
do not get "checkboxname=off." You get nothing when it is off. A
slight problem for split...

=item 3

I<Where did my spaces go?> Is what you might be asking yourself if
you use split. Why? Because the browsers translate spaces into a
plus sign. B<Hash-It> will undo this voodoo.

=item 4

I<Where did my returns, periods, equals, etc go? Where did those
awfull %xx's come from?> Is what you might be asking yourself if
you use split. Why? Because the browsers translate those things into
the hexadecimal version... they take the ASCII code for the
character, then hex it. B<Hash-It> will undo this evil.

=item 5

If you I<REALY> want to do something with the origonal query string,
it is left intact for you.

=item 6

It now handles the multipart/form-data content type for HTML file
uploads! I<Find some one else who does this!>The data is in %post,
the real names of files (if availible) is in %fName, and the
Content-Type of objects, if known, is in %content

=item 6

It's free; you have nothing to loose.

=back

B<NOTE:> C<require standard_disclamer.pl> :)

=head3 Version History Since 1.5.1

1.5.5 - Added some X-Header fields to the email messages Hash-It
sends to you in order to make tracking problems down easier.

1.5.4 - Fixed a few warnings that Hash-It would generate in certain
circumstances.

1.5.3 - $TIME_TO_LIVE. Before this version, everything was set to expire 
instantly (actually, in the past). You can get the old behavior by specifying
a $TIME_TO_LIVE of a negitive number.

1.5.2 - Improved documentation; fixed some spelling errors & typos.

1.5.1 - C<CheckArgs> added

1.5 and before - The world will never know. They existed, but I did not keep
a version history for them.

=cut

######## ENTER A COMMAND THAT A MAIL MESSAGE MAY BE PIPED TO #######
$HashItSendMail='/usr/sbin/sendmail derobert@erols.com';
####################################################################

$SIG{'__DIE__'} = 'HashItDead';
$SIG{'__WARN__'} = 'HashItWarned';

#use CGI::Carp qw(fatalsToBrowser);

$HashItV = '1.5.4 (X-HEADERS)';
getQuery();
1;

sub getQuery {
	my ($myVar,@array,$name,$val,$elem);
	if (defined($ENV{'CONTENT_TYPE'}) and $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data;*/) {
  &multipart;
  return;
 };
 $myVar=$ENV{'QUERY_STRING'};
	chomp $myVar;
	$myVar =~ tr/+/ /; # no more +
	@array=split(/&/,$myVar);
	
	foreach $elem (@array) {
		($name,$val)=split(/=/,$elem);
		$name =~ s/%(..)/chr(hex($1))/eg if defined($name);	#no more hex!
		$val =~ s/%(..)/chr(hex($1))/eg if defined($val);	#no more hex!
		$query{$name}=$val;
	}

	$myVar=<STDIN>; # read data from post
	if (defined($myVar)) {
		chomp $myVar;
		$myVar =~ tr/+/ /; # no more +
		@array=split(/&/,$myVar);
	
		foreach $elem (@array) {
			($name,$val)=split(/=/,$elem);
			$name =~ s/%(..)/chr(hex($1))/eg;	#no more hex!
			$val =~ s/%(..)/chr(hex($1))/eg;	#no more hex!
			$post{$name}=$val;
		}
	}
}

sub multipart {
 goto &multipartMS if $ENV{'HTTP_USER_AGENT'} =~ /MSIE/;
 goto &multipartNS;
}

sub multipartMS {
 my ($junk, $bound1, $bound, $fake, $temp, $name1, $dat);
 ($junk,$bound1) = split(/\; /,$ENV{'CONTENT_TYPE'});
 ($junk,$bound) = split(/=/,$bound1,2);
 $HASH_IT_BOUND = $bound1;
 eval ("\@items = split(/$bound/,join('',<STDIN>))");
 shift @items;
 foreach $junk (@items) {
  ($header,$body) = split(/\n\r\n/,$junk,2);
  $header = substr($header,2);
  chomp $body;
  $header =~ /name="(.+?)"/i or next;
  $name1 = $1;
  $fName{$name1} = $1 if $header =~ /filename="(.+?)"/i;
  $content{$name1} = $1 if $header =~ /Content-Type: (.+)/i;
  $post{$name1} = $body;
 }
}

sub multipartNS {
 my ($junk, $bound1, $bound, $fake, $temp, $name1, $dat);
 ($junk,$bound1) = split(/\; /,$ENV{'CONTENT_TYPE'});
 ($junk,$bound) = split(/=/,$bound1,2);
 $HASH_IT_BOUND = $bound1;
 eval ("\@items = split(/--$bound/,join('',<STDIN>))");
 shift @items;
 foreach $junk (@items) {
  ($header,$body) = split(/(?:\n|\r)(?:\n|\r)(?:\n|\r)(?:\n|\r)/,$junk,2);
  $header = substr($header,2);
  chomp $body;
  $header =~ /name="(.+?)"/i or next;
  $name1 = $1;
  $fName{$name1} = $1 if $header =~ /filename="(.+?)"/i;
  $content{$name1} = $1 if $header =~ /Content-Type: (.+)/i;
  $post{$name1} = $body;
 }
}

sub HTMLout {
 my ($what, $ml);
 $what=shift;
 $ml = length($what);
 print "Content-type: text/html\n";
 print "Content-Length: $ml\n";
 if (!defined($TIME_TO_LIVE)) {
  $TIME_TO_LIVE = 1800;
 }
 my @wkday = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
 my @month = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep",
              "Oct", "Nov", "Dec");
 (my $sec, my $min, my $hour, my $mday, my $mon, my $year, my $wday, my $yday,
  my $isdst) = gmtime(time+$TIME_TO_LIVE);
 printf "Expires: %s, %.2d %s %.4d %.2d:%.2d:%.2d GMT\n\n",
        $wkday[$wday],$mday,$month[$mon],1900+$year,$hour,$min,$sec;
 print $what;
}

sub SuperHTMLout {
 my ($HTML, $Title);
 $HTML = shift; $Title = shift;
 $HTML = "<HTML><HEAD><TITLE>$Title</TITLE></HEAD>\n<BODY>\n$HTML
</BODY></HTML>";
 HTMLout($HTML);
}

##### HASH IT WILL NOW HANDLE MAIL ABOUT DEATHS AND WARNINGS #####

sub HashItDead {
	$how = shift;
 open PIPE,"| $HashItSendMail";
 print PIPE "Subject: A Death has occured.
From: Hash-It
X-ScriptName: $ENV{'SCRIPT_NAME'}
X-ScriptFileName: $ENV{'SCRIPT_FILENAME'}
X-Host: $ENV{'HTTP_HOST'}
X-MY-URL: http://$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}
X-HTTP-REFERER: $ENV{'HTTP_REFERER'}

Hash-it has the unfortunate duty of reporting to you that the
following killed a script that makes use of Hash-it:";
 print PIPE "\n$how\n\n";
print PIPE 'Hash-it hopes that your script will get fixed, so the
next time it is run it will not die. No one likes dead scripts, afterall.

Oh, and did I forget to mention that I did not do it!!!

Have a good day.

-------------------------------------------------------------------
Hash-it ',$HashItV,' By Anthony DeRobertis
   derobert@erols.com
      http://www.erols.com/derobert/
-------------------------------------------------------------------
PS: The script did not finish execution; it was executed.';
 close PIPE;
 SuperHTMLout('<H1 Align="Center">Sorry!</H1>

This page could not load due to a bug or misconfiguration. Please
inform the owner or webmaster of this page of this most unfortunate
problem, along with exact details of what you did, what browser you
run, what time it occured, and what OS you have. This will certainly
help get it fixed<p>

<PRE>
  --Hash-it.pm
     Version '."$HashItV".'
     http://www.erols.com/derobert/
     mailto:derobert@erols.com
       (technical:'."$how".')
</PRE>',"Certificate of Virtual Death");
 exit;
}

sub HashItWarned {
	$how = shift;
 open PIPE,"| $HashItSendMail";
 print PIPE "Subject: A Warning has occured.
From: Hash-It
X-ScriptName: $ENV{'SCRIPT_NAME'}
X-ScriptFileName: $ENV{'SCRIPT_FILENAME'}
X-Host: $ENV{'HTTP_HOST'}
X-MY-URL: http://$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}
X-HTTP-REFERER: $ENV{'HTTP_REFERER'}

Hash-it has the unfortunate duty of reporting to you that the
following warned a script that makes use of Hash-it:";
 print PIPE "\n$how\n\n";
print PIPE 'Hash-it hopes that your script will stop doing these thing, so the
next time it is run it will not get warned. To many warnings will get you
arrested (or in this case, crashed).

This may mean nothing at all, it may mean you were using the -w flag,
or it may mean that your script uses the warn command.

Oh, and did I forget to mention that I did not do it!!!

Have a good day.

-------------------------------------------------------------------
Hash-it ',$HashItV,' By Anthony DeRobertis
   derobert@erols.com
      http://www.erols.com/derobert/
-------------------------------------------------------------------
PS: The script did finish execution';
 close PIPE;
}

############### HASH IT NOW MAKES IT EASY TO SEND EMAIL #############
sub MailTo {
 $addr = shift;
 $data = shift;
 open MAIL,"| sendmail $addr";
 print MAIL "Subject: Message Sent with HASH-IT
From: Hash-it Automailer
X-ScriptName: $ENV{'SCRIPT_NAME'}
X-ScriptFileName: $ENV{'SCRIPT_FILENAME'}
X-Host: $ENV{'HTTP_HOST'}
X-MY-URL: http://$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}
X-HTTP-REFERER: $ENV{'HTTP_REFERER'}

$data





-----------------------------------------------------------------
Please do not reply to this message using the address in the from
field. It is not a valid address. Unless the message states an
address to reply to, do not reply.";
 close MAIL;
}

sub CheckArgs {
 while ($elem = shift) {
  if ($post{$elem} eq '' and $query{$elem} eq '') {
   return 0;
  }
 }
 return 1;
}