summaryrefslogtreecommitdiffstats
path: root/src/net/http/cgi/testdata/test.cgi
diff options
context:
space:
mode:
Diffstat (limited to 'src/net/http/cgi/testdata/test.cgi')
-rwxr-xr-xsrc/net/http/cgi/testdata/test.cgi95
1 files changed, 95 insertions, 0 deletions
diff --git a/src/net/http/cgi/testdata/test.cgi b/src/net/http/cgi/testdata/test.cgi
new file mode 100755
index 0000000..667fce2
--- /dev/null
+++ b/src/net/http/cgi/testdata/test.cgi
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+# Copyright 2011 The Go Authors. All rights reserved.
+# Use of this source code is governed by a BSD-style
+# license that can be found in the LICENSE file.
+#
+# Test script run as a child process under cgi_test.go
+
+use strict;
+use Cwd;
+
+binmode STDOUT;
+
+my $q = MiniCGI->new;
+my $params = $q->Vars;
+
+if ($params->{"loc"}) {
+ print "Location: $params->{loc}\r\n\r\n";
+ exit(0);
+}
+
+print "Content-Type: text/html\r\n";
+print "X-CGI-Pid: $$\r\n";
+print "X-Test-Header: X-Test-Value\r\n";
+print "\r\n";
+
+if ($params->{"writestderr"}) {
+ print STDERR "Hello, stderr!\n";
+}
+
+if ($params->{"bigresponse"}) {
+ # 17 MB, for OS X: golang.org/issue/4958
+ for (1..(17 * 1024)) {
+ print "A" x 1024, "\r\n";
+ }
+ exit 0;
+}
+
+print "test=Hello CGI\r\n";
+
+foreach my $k (sort keys %$params) {
+ print "param-$k=$params->{$k}\r\n";
+}
+
+foreach my $k (sort keys %ENV) {
+ my $clean_env = $ENV{$k};
+ $clean_env =~ s/[\n\r]//g;
+ print "env-$k=$clean_env\r\n";
+}
+
+# NOTE: msys perl returns /c/go/src/... not C:\go\....
+my $dir = getcwd();
+if ($^O eq 'MSWin32' || $^O eq 'msys' || $^O eq 'cygwin') {
+ if ($dir =~ /^.:/) {
+ $dir =~ s!/!\\!g;
+ } else {
+ my $cmd = $ENV{'COMSPEC'} || 'c:\\windows\\system32\\cmd.exe';
+ $cmd =~ s!\\!/!g;
+ $dir = `$cmd /c cd`;
+ chomp $dir;
+ }
+}
+print "cwd=$dir\r\n";
+
+# A minimal version of CGI.pm, for people without the perl-modules
+# package installed. (CGI.pm used to be part of the Perl core, but
+# some distros now bundle perl-base and perl-modules separately...)
+package MiniCGI;
+
+sub new {
+ my $class = shift;
+ return bless {}, $class;
+}
+
+sub Vars {
+ my $self = shift;
+ my $pairs;
+ if ($ENV{CONTENT_LENGTH}) {
+ $pairs = do { local $/; <STDIN> };
+ } else {
+ $pairs = $ENV{QUERY_STRING};
+ }
+ my $vars = {};
+ foreach my $kv (split(/&/, $pairs)) {
+ my ($k, $v) = split(/=/, $kv, 2);
+ $vars->{_urldecode($k)} = _urldecode($v);
+ }
+ return $vars;
+}
+
+sub _urldecode {
+ my $v = shift;
+ $v =~ tr/+/ /;
+ $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
+ return $v;
+}