1 |
nmav |
1.2 |
#! /usr/bin/perl -wT |
2 |
nmav |
1.1 |
|
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 |
nmav |
1.2 |
# |
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 |
nmav |
1.1 |
|
47 |
nmav |
1.2 |
# Nothing to do if just a HEAD request |
48 |
|
|
# |
49 |
|
|
if (defined $ENV{"REQUEST_METHOD"} && $ENV{"REQUEST_METHOD"} =~ /^HEAD$/i) { |
50 |
|
|
exit 0; |
51 |
nmav |
1.1 |
} |
52 |
|
|
|
53 |
nmav |
1.2 |
# Initial HTML lines |
54 |
|
|
# |
55 |
nmav |
1.1 |
print "<html><head><title>Boa CGI test</title></head><body>\n"; |
56 |
|
|
print "<H2>Boa CGI test</H2>\n\n"; |
57 |
nmav |
1.2 |
print "Date: ", strftime("%a %b %e %H:%M:%S %Y\n", localtime); |
58 |
nmav |
1.1 |
print "<p>\n"; |
59 |
|
|
|
60 |
nmav |
1.2 |
# 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 |
nmav |
1.1 |
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 |
nmav |
1.2 |
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 |
nmav |
1.1 |
print "</td></tr>"; |
98 |
|
|
print "</table>\n"; |
99 |
|
|
|
100 |
nmav |
1.2 |
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 |
nmav |
1.1 |
|
106 |
nmav |
1.2 |
# Print the arguments |
107 |
|
|
# |
108 |
nmav |
1.1 |
print "<p>\nArguments:\n<ol>\n"; |
109 |
|
|
if ($#ARGV >= 0) { |
110 |
nmav |
1.2 |
while ($a=shift(@ARGV)) { |
111 |
nmav |
1.1 |
$a=~s/&/&/g; |
112 |
|
|
$a=~s/</</g; |
113 |
|
|
$a=~s/>/>/g; |
114 |
|
|
print "<li>$a\n"; |
115 |
nmav |
1.2 |
} |
116 |
nmav |
1.1 |
} |
117 |
|
|
print "</ol>\n"; |
118 |
|
|
|
119 |
nmav |
1.2 |
# Print environment list |
120 |
|
|
# |
121 |
nmav |
1.1 |
print "<P>\nEnvironment:\n<UL>\n"; |
122 |
nmav |
1.2 |
foreach my $i (keys %ENV) { |
123 |
|
|
$a=$ENV{$i}; |
124 |
|
|
$a=~s/&/&/g; |
125 |
|
|
$a=~s/</</g; |
126 |
|
|
$a=~s/>/>/g; |
127 |
|
|
$i=~s/&/&/g; |
128 |
|
|
$i=~s/</</g; |
129 |
|
|
$i=~s/>/>/g; |
130 |
|
|
print "<li>$i = $a\n"; |
131 |
nmav |
1.1 |
} |
132 |
|
|
print "</UL>\n"; |
133 |
|
|
|
134 |
nmav |
1.2 |
# 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/&/&/g; |
147 |
|
|
$line =~ s/</</g; |
148 |
|
|
$line =~ s/>/>/g; |
149 |
|
|
print "<pre>" if $line_cnt == 1; |
150 |
|
|
print "$line"; |
151 |
nmav |
1.1 |
} |
152 |
nmav |
1.2 |
print "</pre>" if $line_cnt > 0; |
153 |
|
|
print "<hr>\n"; |
154 |
nmav |
1.1 |
} else { |
155 |
nmav |
1.2 |
print "No input stream: (not POST)<p>\n"; |
156 |
nmav |
1.1 |
} |
157 |
|
|
|
158 |
nmav |
1.2 |
# 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 |
nmav |
1.1 |
|
176 |
nmav |
1.2 |
# End of HTML |
177 |
|
|
# |
178 |
nmav |
1.1 |
print "\n<EM>Boa http server</EM>\n"; |
179 |
|
|
print "</body></html>\n"; |
180 |
|
|
|
181 |
nmav |
1.2 |
# All done! :-) |
182 |
|
|
# |
183 |
nmav |
1.1 |
exit 0; |
184 |
|
|
|