/[hydra]/hydra/examples/cgi-test.cgi
ViewVC logotype

Contents of /hydra/examples/cgi-test.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Mon Oct 21 18:46:25 2002 UTC (21 years, 5 months ago) by nmav
Branch: MAIN
CVS Tags: hydra_0_1_6_without_hic, hydra_0_0_10, hydra_0_0_8, hydra_0_0_9, hydra_0_1_3, hydra_0_1_2, hydra_0_1_1, hydra_0_1_0, hydra_0_1_7, hydra_0_1_6, hydra_0_1_4, hydra_0_1_8, HEAD
Branch point for: hydra_0_1_0_patches
Changes since 1.1: +111 -47 lines
Added several stuff from Boa 0.94.14rc1

1 #! /usr/bin/perl -wT
2
3 # Remember that CGI programs have to close out the HTTP header
4 # (with a pair of newlines), after giving the Content-type:
5 # and any other relevant or available header information.
6
7 # Unlike CGI programs running under Apache, CGI programs under Boa
8 # should understand some simple HTTP options. The header (and the
9 # double-newline) should not be printed if the incoming request was
10 # in HTTP/0.9. Also, we should stop after the header if
11 # REQUEST_METHOD == "HEAD". Under Apache, nph- programs also have
12 # to worry about such stuff.
13
14 # Feb 3, 2000 -- updated to support POST, and avoid passing
15 # Malicious HTML Tags as described in CERT's CA-2000-02 advisory.
16 #
17 # 20 Aug 2002 -- Big internal changes, to support much more
18 # than just a printout of the environment. Now the CGI can
19 # do various, GET, isindex, and POST requests, and respond
20 # to them as well.
21
22 # 26 Sep 2002 -- Additional security paranoia by Landon Curt Noll
23 # http://www.isthe.com/chongo/index.html
24
25 # paranoia
26 #
27 delete $ENV{IFS};
28 delete $ENV{CDPATH};
29 delete $ENV{ENV};
30 delete $ENV{BASH_ENV};
31 #$ENV{PATH} = "/bin:/usr/bin";
32 $SIG{ALRM} = sub { die "</pre>\n<p>timeout on stdin<p></body></html>\n"; };
33 alarm(3);
34
35 # initial setup
36 #
37 use strict;
38 use POSIX qw(strftime getegid);
39
40 # Print Content-type, if allowed
41 #
42 if (defined $ENV{"SERVER_PROTOCOL"} &&
43 $ENV{"SERVER_PROTOCOL"} !~ m{HTTP/0.9}i) {
44 print "Content-type: text/html; charset=ISO-8859-1\r\n\r\n";
45 }
46
47 # Nothing to do if just a HEAD request
48 #
49 if (defined $ENV{"REQUEST_METHOD"} && $ENV{"REQUEST_METHOD"} =~ /^HEAD$/i) {
50 exit 0;
51 }
52
53 # Initial HTML lines
54 #
55 print "<html><head><title>Boa CGI test</title></head><body>\n";
56 print "<H2>Boa CGI test</H2>\n\n";
57 print "Date: ", strftime("%a %b %e %H:%M:%S %Y\n", localtime);
58 print "<p>\n";
59
60 # Main form code
61 #
62 if (defined $ENV{"REQUEST_METHOD"}) {
63 print "Method: $ENV{\"REQUEST_METHOD\"}\n";
64 } else {
65 print "Method: <<undefined>>\n";
66 }
67 print "<p>\n";
68
69 print "<table border=1>\n";
70 print "<tr><td>Basic GET Form:<br>";
71 print " <form method=\"get\">\n\
72 <input type=\"text\" name=\"parameter_1\" size=5 maxlength=5>\
73 <select name=\"select_1\">\
74 <option>foo</option>\
75 <option>bar</option>\
76 </select>\
77 <input type=\"submit\" NAME=SUBMIT VALUE=\"Submit\">\
78 </form>";
79 print "</td>";
80 print "<td>Basic POST Form:<br>";
81 print "<form method=\"post\">\n\
82 <input type=\"text\" name=\"parameter_1\" size=5 maxlength=5>\
83 <select name=\"select_1\">\
84 <option>foo</option>\
85 <option>bar</option>\
86 </select>\
87 <input type=\"submit\" NAME=SUBMIT VALUE=\"Submit\">\
88 </form>";
89 print "</td>";
90 print "</tr>\n";
91 print "<tr><td colspan=2>Sample ISINDEX form:<br>\n";
92 if (defined $ENV{"SCRIPT_NAME"}) {
93 print "<a href=\"$ENV{\"SCRIPT_NAME\"}?param1+param2+param3\">$ENV{\"SCRIPT_NAME\"}?param1+param2+param3</a>\n";
94 } else {
95 print "undefined SCRIPT_NAME\n";
96 }
97 print "</td></tr>";
98 print "</table>\n";
99
100 if (defined $ENV{"QUERY_STRING"}) {
101 print "<p>Query String: $ENV{\"QUERY_STRING\"}\n";
102 } else {
103 print "<p>Query String: undefined QUERY_STRING\n";
104 }
105
106 # Print the arguments
107 #
108 print "<p>\nArguments:\n<ol>\n";
109 if ($#ARGV >= 0) {
110 while ($a=shift(@ARGV)) {
111 $a=~s/&/&amp;/g;
112 $a=~s/</&lt;/g;
113 $a=~s/>/&gt;/g;
114 print "<li>$a\n";
115 }
116 }
117 print "</ol>\n";
118
119 # Print environment list
120 #
121 print "<P>\nEnvironment:\n<UL>\n";
122 foreach my $i (keys %ENV) {
123 $a=$ENV{$i};
124 $a=~s/&/&amp;/g;
125 $a=~s/</&lt;/g;
126 $a=~s/>/&gt;/g;
127 $i=~s/&/&amp;/g;
128 $i=~s/</&lt;/g;
129 $i=~s/>/&gt;/g;
130 print "<li>$i = $a\n";
131 }
132 print "</UL>\n";
133
134 # Print posted data, if any
135 #
136 my $line_cnt = 0;
137 my $line;
138 if (defined $ENV{REQUEST_METHOD} &&
139 $ENV{REQUEST_METHOD} =~ /POST/i) {
140 print "Input stream:<br><hr>\n";
141 while (defined($line = <stdin>)) {
142 if (++$line_cnt > 100) {
143 print "<p>... ignoring the rest of the input data<p>";
144 last;
145 }
146 $line =~ s/&/&amp;/g;
147 $line =~ s/</&lt;/g;
148 $line =~ s/>/&gt;/g;
149 print "<pre>" if $line_cnt == 1;
150 print "$line";
151 }
152 print "</pre>" if $line_cnt > 0;
153 print "<hr>\n";
154 } else {
155 print "No input stream: (not POST)<p>\n";
156 }
157
158 # Print a little additional server information
159 #
160 print "uid: $> gid: ", getegid(), "\n<p>\n";
161
162 # Disabled use of this call due to DoS attack potential
163 #
164 #if (defined $ENV{"QUERY_STRING"} && defined $ENV{"REMOTE_PORT"} &&
165 # $ENV{"QUERY_STRING"} =~ /ident/i && $ENV{"REMOTE_PORT"} =~ /^\s*$/) {
166 #
167 ## Uses idlookup-1.2 from Peter Eriksson <pen at lysator dot liu dot se>
168 ## ftp://coast.cs.purdue.edu/pub/tools/unix/ident/tools/idlookup-1.2.tar.gz
169 ## Could use modification to timeout and trap stderr messages
170 # my $a="idlookup ".
171 # $ENV{"REMOTE_ADDR"}." ".$ENV{"REMOTE_PORT"}." ".$ENV{"SERVER_PORT"};
172 # my $b=qx/$a/;
173 # print "ident output:<br><pre>\n$b</pre>\n";
174 #}
175
176 # End of HTML
177 #
178 print "\n<EM>Boa http server</EM>\n";
179 print "</body></html>\n";
180
181 # All done! :-)
182 #
183 exit 0;
184

webmaster@linux.gr
ViewVC Help
Powered by ViewVC 1.1.26