gitee.com/ks-custle/core-gm@v0.0.0-20230922171213-b83bdd97b62c/gmhttp/cgi/testdata/test.cgi (about)

     1  #!/usr/bin/perl
     2  # Copyright 2011 The Go Authors. All rights reserved.
     3  # Use of this source code is governed by a BSD-style
     4  # license that can be found in the LICENSE file.
     5  #
     6  # Test script run as a child process under cgi_test.go
     7  
     8  use strict;
     9  use Cwd;
    10  
    11  binmode STDOUT;
    12  
    13  my $q = MiniCGI->new;
    14  my $params = $q->Vars;
    15  
    16  if ($params->{"loc"}) {
    17      print "Location: $params->{loc}\r\n\r\n";
    18      exit(0);
    19  }
    20  
    21  print "Content-Type: text/html\r\n";
    22  print "X-CGI-Pid: $$\r\n";
    23  print "X-Test-Header: X-Test-Value\r\n";
    24  print "\r\n";
    25  
    26  if ($params->{"writestderr"}) {
    27      print STDERR "Hello, stderr!\n";
    28  }
    29  
    30  if ($params->{"bigresponse"}) {
    31      # 17 MB, for OS X: golang.org/issue/4958
    32      for (1..(17 * 1024)) {
    33          print "A" x 1024, "\r\n";
    34      }
    35      exit 0;
    36  }
    37  
    38  print "test=Hello CGI\r\n";
    39  
    40  foreach my $k (sort keys %$params) {
    41      print "param-$k=$params->{$k}\r\n";
    42  }
    43  
    44  foreach my $k (sort keys %ENV) {
    45      my $clean_env = $ENV{$k};
    46      $clean_env =~ s/[\n\r]//g;
    47      print "env-$k=$clean_env\r\n";
    48  }
    49  
    50  # NOTE: msys perl returns /c/go/src/... not C:\go\....
    51  my $dir = getcwd();
    52  if ($^O eq 'MSWin32' || $^O eq 'msys' || $^O eq 'cygwin') {
    53      if ($dir =~ /^.:/) {
    54          $dir =~ s!/!\\!g;
    55      } else {
    56          my $cmd = $ENV{'COMSPEC'} || 'c:\\windows\\system32\\cmd.exe';
    57          $cmd =~ s!\\!/!g;
    58          $dir = `$cmd /c cd`;
    59          chomp $dir;
    60      }
    61  }
    62  print "cwd=$dir\r\n";
    63  
    64  # A minimal version of CGI.pm, for people without the perl-modules
    65  # package installed.  (CGI.pm used to be part of the Perl core, but
    66  # some distros now bundle perl-base and perl-modules separately...)
    67  package MiniCGI;
    68  
    69  sub new {
    70      my $class = shift;
    71      return bless {}, $class;
    72  }
    73  
    74  sub Vars {
    75      my $self = shift;
    76      my $pairs;
    77      if ($ENV{CONTENT_LENGTH}) {
    78          $pairs = do { local $/; <STDIN> };
    79      } else {
    80          $pairs = $ENV{QUERY_STRING};
    81      }
    82      my $vars = {};
    83      foreach my $kv (split(/&/, $pairs)) {
    84          my ($k, $v) = split(/=/, $kv, 2);
    85          $vars->{_urldecode($k)} = _urldecode($v);
    86      }
    87      return $vars;
    88  }
    89  
    90  sub _urldecode {
    91      my $v = shift;
    92      $v =~ tr/+/ /;
    93      $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    94      return $v;
    95  }