Branch: Tag:

2001-02-01

2001-02-01 13:12:37 by Leif Stensson <leif@lysator.liu.se>

Added two non-Apache API functions in the Perl request object to allow
easier access to forms variables and HTTP headers.

Rev: server/perl/bin/perlhelper:1.2

2:      # Perl helper script for Roxen Webserver. By Leif Stensson.   # - # $Id: perlhelper,v 1.1 2000/08/01 14:26:43 leif Exp $ + # $Id: perlhelper,v 1.2 2001/02/01 13:12:37 leif Exp $      package Roxen::Internal;   
52:    die $@ if $@;   }    - #if (-x /home/leif/bin/pike7r90 ) - { -  # Extra diagnostics. -  # print STDERR "Started subperl.\n"; - }; + # Extra debugging. + # if (-x "/home/leif/bin/pike7r90" ) + # { + # # Extra diagnostics. + # print STDERR "Started subperl.\n"; + # };      package Roxen::TieStdio;   
133:    return $self;   }    + sub get_http_variables () { return %Roxen::Request::req_vars;} + sub get_http_headers () { return %Roxen::Request::req_headers;} +    sub get_remote_host { return $Roxen::Request::req_info{'remoteaddr'};}   sub get_remote_logname { return undef;}   sub protocol { return $Roxen::Request::req_info{'prot'};}
159:   { # FIX LATER...    return "/";   } - sub send_http_header - { # FIX LATER -  ; - } +    sub get_basic_auth_pw   { if ($Roxen::Request::req_info{auth_type} eq "Basic")    { return 0, $Roxen::Request::req_info{auth_passwd};}
217:   { my ($self, $fmt) = (shift, shift);    $self->print(sprintf $fmt, @_);   } + sub send_http_header + { my ($self, $headers) = (shift, ""); +  for(keys %Roxen::Request::req_reply) +  { $headers .= sprintf("%s: %s\r\n", $_, $Roxen::Request::req_reply{$_});} +  Roxen::_helper::Sendreply("HEADERS=$headers"); + }   sub send_fd   { my ($self, $fh, $buf) = (shift, shift);    while (read($fh, $buf, 8192) > 0) { $self->print($buf);}
400:    { $Roxen::Request::req_outbuf = "";    $Roxen::Request::req_returncode = 200;    $data = Getdata(3); -  alarm 150; # 2.5 minutes. +  alarm 180; # 3 minutes.    $Roxen::Request::req_state = 5423522; # Magic number.    if ($cmd eq "C")    { my ($cmdin, $cmdout, $cmd);
424:    { $cmdin->sysread($cmd, 1) == 1 or die "perlhelper $$/MLQ: exiting.\n";    diag "{Q$cmd}";    if ($cmd eq "P") -  { Sendreply(""); -  } +  { Sendreply(""); } +  elsif ($cmd eq "V") +  { Sendreply('Roxen Perl Helper: $Id: perlhelper,v 1.2 2001/02/01 13:12:37 leif Exp $'); }    else -  { die "perlhelper $$/MLQQ: exiting.\n"; +  { die "perlhelper $$/MLQQ: exiting.\n"; }    }    } -  } +    # die "$$ perlhelper: exiting normally.\n";    CORE::exit(0);   }