/[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.1.1.1 - (show annotations) (vendor branch)
Sat Sep 21 13:54:15 2002 UTC (21 years, 6 months ago) by nmav
Branch: boas
CVS Tags: BOAS_WITH_RANGES_AND_CGI, start, hydra_0_0_2, hydra_0_0_3, hydra_0_0_6, hydra_0_0_7, hydra_0_0_4, hydra_0_0_5
Changes since 1.1: +0 -0 lines
Imported sources

1 #! /usr/bin/perl
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 if ($ENV{"SERVER_PROTOCOL"} ne "HTTP/0.9") {
18 print "Content-type: text/html; charset=ISO-8859-1\r\n\r\n";
19 }
20
21 exit 0 if ($ENV{"REQUEST_METHOD"} eq "HEAD");
22
23 print "<html><head><title>Boa CGI test</title></head><body>\n";
24 print "<H2>Boa CGI test</H2>\n\n";
25
26 $now=`date`;
27 chomp($now);
28
29 print "Date: $now\n";
30 print "<p>\n";
31
32 print "Method: $ENV{\"REQUEST_METHOD\"}\n";
33 print "<p>\n";
34
35 print "<table border=1>\n";
36 print "<tr><td>Basic GET Form:<br>";
37 print " <form method=\"get\">\n\
38 <input type=\"text\" name=\"parameter_1\" size=5 maxlength=5>\
39 <select name=\"select_1\">\
40 <option>foo</option>\
41 <option>bar</option>\
42 </select>\
43 <input type=\"submit\" NAME=SUBMIT VALUE=\"Submit\">\
44 </form>";
45 print "</td>";
46 print "<td>Basic POST Form:<br>";
47 print "<form method=\"post\">\n\
48 <input type=\"text\" name=\"parameter_1\" size=5 maxlength=5>\
49 <select name=\"select_1\">\
50 <option>foo</option>\
51 <option>bar</option>\
52 </select>\
53 <input type=\"submit\" NAME=SUBMIT VALUE=\"Submit\">\
54 </form>";
55 print "</td>";
56 print "</tr>\n";
57 print "<tr><td colspan=2>Sample ISINDEX form:<br>\n";
58 print "<a href=\"$ENV{\"SCRIPT_NAME\"}?param1+param2+param3\">$ENV{\"SCRIPT_NAME\"}?param1+param2+param3</a>\n";
59 print "</td></tr>";
60 print "</table>\n";
61
62 print "<p>Query String: $ENV{\"QUERY_STRING\"}\n";
63
64 # arguments list
65 print "<p>\nArguments:\n<ol>\n";
66 if ($#ARGV >= 0) {
67 while ($a=shift(@ARGV)) {
68 $a=~s/&/&amp;/g;
69 $a=~s/</&lt;/g;
70 $a=~s/>/&gt;/g;
71 print "<li>$a\n";
72 }
73 }
74 print "</ol>\n";
75
76 # environment list
77 print "<P>\nEnvironment:\n<UL>\n";
78 foreach $i (keys %ENV) {
79 $a=$ENV{$i};
80 $a=~s/&/&amp;/g;
81 $a=~s/</&lt;/g;
82 $a=~s/>/&gt;/g;
83 $i=~s/&/&amp;/g;
84 $i=~s/</&lt;/g;
85 $i=~s/>/&gt;/g;
86 print "<li>$i = $a\n";
87 }
88 print "</UL>\n";
89
90 if ($ENV{REQUEST_METHOD} eq "POST") {
91 print "Input stream:<br><hr><pre>\n";
92 while (<stdin>) {
93 s/&/&amp;/g;
94 s/</&lt;/g;
95 s/>/&gt;/g;
96 print "$_";
97 }
98 print "</pre><hr>\n";
99 } else {
100 print "No input stream: (not POST)<p>";
101 }
102
103 print "id: ", `id`, "\n<p>\n";
104
105 if ($ENV{"QUERY_STRING"}=~/ident/ && $ENV{"REMOTE_PORT"} ne "") {
106
107 # Uses idlookup-1.2 from Peter Eriksson <pen@lysator.liu.se>
108 # ftp://coast.cs.purdue.edu/pub/tools/unix/ident/tools/idlookup-1.2.tar.gz
109 # Could use modification to timeout and trap stderr messages
110 $a="idlookup ".
111 $ENV{"REMOTE_ADDR"}." ".$ENV{"REMOTE_PORT"}." ".$ENV{"SERVER_PORT"};
112 $b=qx/$a/;
113 print "ident output:<br><pre>\n$b</pre>\n";
114 }
115
116 print "\n<EM>Boa http server</EM>\n";
117 print "</body></html>\n";
118
119 exit 0;
120

webmaster@linux.gr
ViewVC Help
Powered by ViewVC 1.1.26