1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
#! /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 "</pre>\n<p>timeout on stdin<p></body></html>\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 "<html><head><title>Boa CGI test</title></head><body>\n";
print "<H2>Boa CGI test</H2>\n\n";
print "Date: ", strftime("%a %b %e %H:%M:%S %Y\n", localtime);
print "<p>\n";
# Main form code
#
if (defined $ENV{"REQUEST_METHOD"}) {
print "Method: $ENV{\"REQUEST_METHOD\"}\n";
} else {
print "Method: <<undefined>>\n";
}
print "<p>\n";
print "<table border=1>\n";
print "<tr><td>Basic GET Form:<br>";
print " <form method=\"get\">\n\
<input type=\"text\" name=\"parameter_1\" size=5 maxlength=5>\
<select name=\"select_1\">\
<option>foo</option>\
<option>bar</option>\
</select>\
<input type=\"submit\" NAME=SUBMIT VALUE=\"Submit\">\
</form>";
print "</td>";
print "<td>Basic POST Form:<br>";
print "<form method=\"post\">\n\
<input type=\"text\" name=\"parameter_1\" size=5 maxlength=5>\
<select name=\"select_1\">\
<option>foo</option>\
<option>bar</option>\
</select>\
<input type=\"submit\" NAME=SUBMIT VALUE=\"Submit\">\
</form>";
print "</td>";
print "</tr>\n";
print "<tr><td colspan=2>Sample ISINDEX form:<br>\n";
if (defined $ENV{"SCRIPT_NAME"}) {
print "<a href=\"$ENV{\"SCRIPT_NAME\"}?param1+param2+param3\">$ENV{\"SCRIPT_NAME\"}?param1+param2+param3</a>\n";
} else {
print "undefined SCRIPT_NAME\n";
}
print "</td></tr>";
print "</table>\n";
if (defined $ENV{"QUERY_STRING"}) {
print "<p>Query String: $ENV{\"QUERY_STRING\"}\n";
} else {
print "<p>Query String: undefined QUERY_STRING\n";
}
# Print the arguments
#
print "<p>\nArguments:\n<ol>\n";
if ($#ARGV >= 0) {
while ($a=shift(@ARGV)) {
$a=~s/&/&/g;
$a=~s/</</g;
$a=~s/>/>/g;
print "<li>$a\n";
}
}
print "</ol>\n";
# Print environment list
#
print "<P>\nEnvironment:\n<UL>\n";
foreach my $i (keys %ENV) {
$a=$ENV{$i};
$a=~s/&/&/g;
$a=~s/</</g;
$a=~s/>/>/g;
$i=~s/&/&/g;
$i=~s/</</g;
$i=~s/>/>/g;
print "<li>$i = $a\n";
}
print "</UL>\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:<br><hr>\n";
while (defined($line = <stdin>)) {
if (++$line_cnt > 100) {
print "<p>... ignoring the rest of the input data<p>";
last;
}
$line =~ s/&/&/g;
$line =~ s/</</g;
$line =~ s/>/>/g;
print "<pre>" if $line_cnt == 1;
print "$line";
}
print "</pre>" if $line_cnt > 0;
print "<hr>\n";
} else {
print "No input stream: (not POST)<p>\n";
}
# Print a little additional server information
#
print "uid: $> gid: ", getegid(), "\n<p>\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 <pen at lysator dot liu dot se>
## 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:<br><pre>\n$b</pre>\n";
#}
# End of HTML
#
print "\n<EM>Boa http server</EM>\n";
print "</body></html>\n";
# All done! :-)
#
exit 0;
|
