local.*@ARGV results from the CPAN

local.*@ARGV
CGI-ExtDirect
view release on metacpan or search on metacpan
  my $msg = "$code " . $codes{$code};
  logmsg "-> $msg $detail";
  print Client <<EOF;
    HTTP/1.0 $msg
    Content-type: text/html

    <html><body>
    <h1>$msg</h1>
    <p>$detail</p>
    <hr>
    <p><I>p5httpd/$version server at $localname port $port</I></p>
    </body></html>
EOF
}

# cat "relative/path", "text/html", $method; writes the appropriate
# response headers to STDOUT. If $method == GET (which is the default)
# then the file is dumped on STDOUT as well.

sub cat($$;$) {
  my ( $file, $mimetype, $method ) = @_;
  $method = "GET" unless $method;
  my $fullpath = "$server_root$file";

  my ( undef, undef, undef, undef, undef, undef, undef, $length, undef, $mtime )
    = stat($fullpath);
  $mtime = gmtime $mtime;
  my ( $day, $mon, $dm, $tm, $yr ) =
    ( $mtime =~ m/(...) (...) (..) (..:..:..) (....)/ );

  print Client "Content-length: $length\n";
  print Client "Last-Modified: $day, $dm $mon $yr $tm GMT\n";
  print Client "Content-type: $mimetype\n\n";
  my $sent = 0;
  if ( $method eq "GET" ) {
    local $INPUT_RECORD_SEPARATOR = undef;   # gobble whole files, but only here
    open IN, "<$fullpath" || return 0;
    my $content = <IN>;
    close IN;
    $sent = length($content);
    print Client $content;
  }
  logmsg "-> 200 OK $file: $sent bytes sent as $mimetype";
  return 1;
}

# cgi_run("relative/path.cgi", "encoded%20arglist", $method) changes to directory
# where script lives, and then either evals or executes it.

sub cgi_run {
  my ( $script, $arglist, $method ) = @_;
  my ($dir) = ( $script =~ /^(.*\/)/ );
  my $script_path = "$server_root$script";
  my $script_text;
  my $old_chdir = cwd();
  chdir "$server_root$dir"
    or return logerr 500, "Cannot chdir to $server_root$dir: $!";
  $script_path =~ s/[A-Z]://;

# command line decoding, cf description at http://hoohoo.ncsa.uiuc.edu/cgi/cl.html:
  local @ARGV;
  unless ( $arglist =~ /=/ ) {
    $arglist =~
      s/%([\dA-Fa-f]{2})/chr(hex($1))/eg;    # decode arglist, e.g. %20 -> space
    @ARGV = split /\s+/, $arglist;
  }
  my $file_tastes_like_perl = 1;
  if ( $eval_or_execute != $cgis_are_executed ) {

    open CGI, $script_path
        or return do {
            chdir $old_chdir;
            logerr 500, "Cannot read $script_path: $!";
        };
    my ( $script_text, $nread );
    if ( $eval_or_execute == $only_perl_is_evaled ) {
      logmsg "sniffing and tasting $script...";
      $nread = read CGI, $script_text, 100, 0;    # taste first 100 bytes
      defined $nread
        or return do {
            chdir $old_chdir;
            logerr 500, "Read error reading $script_path: $!";
        };
      if ( $script_text !~ /#!.*perl/i )
      {    # No #!/.../perl? Then it's not a perl script.
        logmsg "yeachh! $script doesn't taste like perl!";
        close CGI;
        $file_tastes_like_perl = 0;
      }
    }
    if ($file_tastes_like_perl) {
      {
        local $INPUT_RECORD_SEPARATOR = undef;    # gobble rest of $script
        $script_text .= <CGI>;
      }
      close CGI;
      logmsg "-> eval'ing $script_path";
      my $package_name = $script;  # most CGI's dont bother to set package name.
      $package_name =~    # mangle filename into package name in order to
        s/\W/_/g;         # avoid variable name clashes when in non-forking mode
      eval <<EOF;
        local *STDIN = *Client;
        local *STDOUT = *Client;
        package $package_name;
        no strict;
        $script_text
EOF
      $@ and logerr 500, "in $script:<br>  <pre>$@</pre>";
    }
  }
  if ( $eval_or_execute == $cgis_are_executed or not $file_tastes_like_perl ) {

    #
    # First they're chdir()'ing to where the script lives and then
    # they try to open it using relative path starting from $0? WTF?!
    #
    my ($chdir_script_path) = $script_path =~ m{^.*[/\\](.*?)$};

    -x $chdir_script_path or logerr 500, "Cannot execute $script_path: $!";
    local $ENV{CHLD} = 'DEFAULT';
view all matches for this distribution
view release on metacpan - search on metacpan
( run in 1.485 second using v1.00-cache-2.02-grep-82fe00e-cpan-72ae3ad1e6da )