#! /usr/bin/perl -wT # Remember that CGI programs have to close out the HTTP header # (with a pair of newlines), after giving the Content-type: # and any other relevant or available header information. # Unlike CGI programs running under Apache, CGI programs under Boa # should understand some simple HTTP options. The header (and the # double-newline) should not be printed if the incoming request was # in HTTP/0.9. Also, we should stop after the header if # REQUEST_METHOD == "HEAD". Under Apache, nph- programs also have # to worry about such stuff. # Feb 3, 2000 -- updated to support POST, and avoid passing # Malicious HTML Tags as described in CERT's CA-2000-02 advisory. # # 20 Aug 2002 -- Big internal changes, to support much more # than just a printout of the environment. Now the CGI can # do various, GET, isindex, and POST requests, and respond # to them as well. # 26 Sep 2002 -- Additional security paranoia by Landon Curt Noll # http://www.isthe.com/chongo/index.html # paranoia # delete $ENV{IFS}; delete $ENV{CDPATH}; delete $ENV{ENV}; delete $ENV{BASH_ENV}; #$ENV{PATH} = "/bin:/usr/bin"; $SIG{ALRM} = sub { die "\n

timeout on stdin

\n"; }; alarm(3); # initial setup # use strict; use POSIX qw(strftime getegid); # Print Content-type, if allowed # if (defined $ENV{"SERVER_PROTOCOL"} && $ENV{"SERVER_PROTOCOL"} !~ m{HTTP/0.9}i) { print "Content-type: text/html; charset=ISO-8859-1\r\n\r\n"; } # Nothing to do if just a HEAD request # if (defined $ENV{"REQUEST_METHOD"} && $ENV{"REQUEST_METHOD"} =~ /^HEAD$/i) { exit 0; } # Initial HTML lines # print "Boa CGI test\n"; print "

Boa CGI test

\n\n"; print "Date: ", strftime("%a %b %e %H:%M:%S %Y\n", localtime); print "

\n"; # Main form code # if (defined $ENV{"REQUEST_METHOD"}) { print "Method: $ENV{\"REQUEST_METHOD\"}\n"; } else { print "Method: <>\n"; } print "

\n"; print "\n"; print ""; print ""; print "\n"; print ""; print "
Basic GET Form:
"; print "
\n\ \ \ \
"; print "		Basic POST Form:
"; print "
\n\ \ \ \
"; print "
Sample ISINDEX form:
\n"; if (defined $ENV{"SCRIPT_NAME"}) { print "$ENV{\"SCRIPT_NAME\"}?param1+param2+param3\n"; } else { print "undefined SCRIPT_NAME\n"; } print "
\n"; if (defined $ENV{"QUERY_STRING"}) { print "

Query String: $ENV{\"QUERY_STRING\"}\n"; } else { print "

Query String: undefined QUERY_STRING\n"; } # Print the arguments # print "

\nArguments:\n

    \n"; if ($#ARGV >= 0) { while ($a=shift(@ARGV)) { $a=~s/&/&/g; $a=~s//>/g; print "
  1. $a\n"; } } print "
\n"; # Print environment list # print "

\nEnvironment:\n

\n"; # Print posted data, if any # my $line_cnt = 0; my $line; if (defined $ENV{REQUEST_METHOD} && $ENV{REQUEST_METHOD} =~ /POST/i) { print "Input stream:
\n"; while (defined($line = )) { if (++$line_cnt > 100) { print "

... ignoring the rest of the input data

"; last; } $line =~ s/&/&/g; $line =~ s//>/g; print "

" if $line_cnt == 1;
        print "$line";
    }
    print "
" if $line_cnt > 0; print "
\n"; } else { print "No input stream: (not POST)

\n"; } # Print a little additional server information # print "uid: $> gid: ", getegid(), "\n

\n"; # Disabled use of this call due to DoS attack potential # #if (defined $ENV{"QUERY_STRING"} && defined $ENV{"REMOTE_PORT"} && # $ENV{"QUERY_STRING"} =~ /ident/i && $ENV{"REMOTE_PORT"} =~ /^\s*$/) { # ## Uses idlookup-1.2 from Peter Eriksson ## ftp://coast.cs.purdue.edu/pub/tools/unix/ident/tools/idlookup-1.2.tar.gz ## Could use modification to timeout and trap stderr messages # my $a="idlookup ". # $ENV{"REMOTE_ADDR"}." ".$ENV{"REMOTE_PORT"}." ".$ENV{"SERVER_PORT"}; # my $b=qx/$a/; # print "ident output:

\n$b
\n"; #} # End of HTML # print "\nBoa http server\n"; print "\n"; # All done! :-) # exit 0;