Roxen.git / server / perl / bin / perlhelper

version» Context lines:

Roxen.git/server/perl/bin/perlhelper:1:   #! /usr/local/bin/perl      # 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;      use strict;   use vars '%Cache';      sub packagename   { my($string) = @_;       $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
Roxen.git/server/perl/bin/perlhelper:45:    my($filename,$mtime,$package,$sub);    eval $eval;    }    die $@ if $@;    }       eval {$package->handler;};    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;      sub TIEHANDLE   { my $obj = {};    bless \$obj, shift;   }      sub PRINT   { my $len;
Roxen.git/server/perl/bin/perlhelper:126:   package Roxen::Request;      sub new   { my $proto = shift;    my $class = ref($proto) || $proto;    my $self = {};    bless $self, $class;    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'};}   sub method { return $Roxen::Request::req_info{'method'};}   sub main { return undef;}   sub prev { return undef;}   sub next { return undef;}   sub last { return $Roxen::Request::req_req;}   sub is_main { return 1;}   sub is_initial_request { return 0;}
Roxen.git/server/perl/bin/perlhelper:152:   }   sub connection { return $Roxen::Request::req_req;}   sub auth_name   { # Realm    return "Default";   }   sub document_root   { # 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};}    else    { return 0;}   }   sub note_basic_auth_failure   { # IMPROVE LATER.    $Roxen::Request::req_returncode = 401;   }
Roxen.git/server/perl/bin/perlhelper:210:    { $len = 16384 if $len > 16384;    Roxen::_helper::Senditem('+',substr($Roxen::Request::req_outbuf, 0, $len));    $Roxen::Request::req_outbuf =    substr($Roxen::Request::req_outbuf, $len);    }   }   sub printf   { 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);}   }   sub log_reason   { my ($self, $msg, $file) = (shift, shift, shift);    print STDERR "Perl script: $msg\n";   }   sub log_error   { my ($self, $msg) = (shift, shift);
Roxen.git/server/perl/bin/perlhelper:393:    elsif ($cmd eq "R")    { %ENV = ();    %Roxen::Request::req_info = ();    %Roxen::Request::req_vars = ();    %Roxen::Request::req_headers = ();    }    elsif ($cmd eq "S" or $cmd eq "C")    { $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);    eval $data;    }    else    { diag "{S:$data}\n";    Roxen::Internal::runscript($data);    }    $Roxen::Request::req_state = 0;
Roxen.git/server/perl/bin/perlhelper:417:    Senddata($Roxen::Request::req_outbuf);       last if $starttime+300 < time; # Timeout after 5 minutes.       $Roxen::Request::req_req = Roxen::Request->new();    }    elsif ($cmd eq "Q")    { $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);   }