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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide 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 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/&/&amp;/g;
112     $a=~s/</&lt;/g;
113     $a=~s/>/&gt;/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/&/&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 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/&/&amp;/g;
147     $line =~ s/</&lt;/g;
148     $line =~ s/>/&gt;/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    

webmaster@linux.gr
ViewVC Help
Powered by ViewVC 1.1.26