--- loncom/lonhttpd 2002/10/29 20:21:32 1.1
+++ loncom/lonhttpd 2003/07/30 15:28:56 1.9
@@ -1,152 +1,600 @@
#!/usr/bin/perl
-# The LearningOnline Network with CAPA
-# lonhttpd server (port 8080)
-# based on
-# TinyHTTPD - a minimum-functional HTTP server written in -*- Perl -*-
-# -ot.0894
-# $Id: lonhttpd,v 1.1 2002/10/29 20:21:32 www Exp $
-
-# Currently supported: HTTP 1.0/1.1 GET and POST queries
-# File types of .html and .gif
-
-$ENV{'SERVER_SOFTWARE'}="TinyHTTPD $Revision: 1.1 $ -ot.0894 (LON-CAPA)";
-
-
-use POSIX;
-
-$pid=fork;
-exit if $pid;
-die "Could not fork: $!" unless defined($pid);
-POSIX::setsid() or die "Can't start new session: $!";
-open (PIDSAVE,">/home/httpd/perl/logs/lonhttpd.pid");
+# $Id: lonhttpd,v 1.9 2003/07/30 15:28:56 www Exp $
+
+$VERSION = "1.3.2 (Demonic/Linux/LON-CAPA Derivative $Revison$)";
+
+# HTTPi Hypertext Tiny Truncated Process Implementation
+# Copyright 1999-2001 Cameron Kaiser # All rights reserved
+# Please read LICENSE # Do not strip this copyright message.
+#
+# LON-CAPA: find httpi license and readme at CVS loncom/license
+#
+
+use lib '/home/httpd/lib/perl/';
+use LONCAPA::Configuration();
+%loncapavar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
+$port_to_use=$loncapavar{'lonhttpdPort'};
+if (!defined($port_to_use)) {
+ $port_to_use='8080';
+}
+
+# The main server is running on 80, so exit in this case
+if ($port_to_use eq '80') { die('Apache is already on Port 80'); }
+
+%system_content_types =
+ ("html" => "text/html",
+ "htm" => "text/html",
+ "wml" => "text/vnd.wap.wml",
+ "wbmp" => "image/vnd.wap.wbmp",
+ "wbm" => "image/vnd.wap.wbmp",
+ "xbm" => "image/x-xbitmap",
+ "pdf" => "application/pdf",
+ "fdf" => "application/vnd.fdf",
+ "bin" => "application/octet-stream",
+ "class" => "application/octet-stream",
+ "jar" => "application/octet-stream",
+ "js" => "application/x-javascript",
+ "lnk" => "application/x-hyperlink",
+ "wav" => "audio/x-wav",
+ "mp3" => "audio/x-mpeg",
+ "tif" => "image/tiff",
+ "tiff" => "image/tiff",
+ "mid" => "audio/x-midi",
+ "txt" => "text/plain",
+ "gif" => "image/gif",
+ "sit" => "application/x-stuffit",
+ "zip" => "application/x-zip-compressed",
+ "lzh" => "application/octet-stream",
+ "lha" => "application/octet-stream",
+ "gz" => "application/x-gzip",
+ "mov" => "movie/quicktime",
+ "mpeg" => "video/mpeg",
+ "mpg" => "video/mpeg",
+ "jpeg" => "image/jpeg",
+ "jpg" => "image/jpeg");
+
+$logfile = "/home/httpd/perl/logs/lonhttpd.log";
+
+# Write out PID
+
+$pidfile="/home/httpd/perl/logs/lonhttpd.pid";
+
+if (-e $pidfile) {
+ open(LFH,"$pidfile");
+ my $pide=<$LFH>;
+ chomp($pide);
+ close(LFH);
+ if (kill 0 => $pide) { die "already running"; }
+}
+
+$path = "/home/httpd/html";
+$sockaddr = 'S n a4 x8';
+
+
+%content_types =
+ ("html" => "text/html",
+ "htm" => "text/html");
+%restrictions =
+ ("/" => "#.##", # deny everything
+ "/res/adm" => ".###", # allow /res/adm
+ "/adm" => ".###", # allow /adm
+ "/status" => ".####lonadm:oeRooOvb3HtpI");
+ # See documentation for interpreting this string.
+
+$headers = <<"EOF";
+Server: HTTPi/$VERSION
+MIME-Version: 1.0
+EOF
+
+%virtual_files =
+ (
+"/adm/lonLCDfont/0.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/0.gif" ] ,
+"/adm/lonLCDfont/1.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/1.gif" ] ,
+"/adm/lonLCDfont/2.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/2.gif" ] ,
+"/adm/lonLCDfont/3.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/3.gif" ] ,
+"/adm/lonLCDfont/4.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/4.gif" ] ,
+"/adm/lonLCDfont/5.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/5.gif" ] ,
+"/adm/lonLCDfont/6.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/6.gif" ] ,
+"/adm/lonLCDfont/7.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/7.gif" ] ,
+"/adm/lonLCDfont/8.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/8.gif" ] ,
+"/adm/lonLCDfont/9.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/9.gif" ] ,
+"/adm/lonLCDfont/a.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/a.gif" ] ,
+"/adm/lonLCDfont/b.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/b.gif" ] ,
+"/adm/lonLCDfont/c.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/c.gif" ] ,
+"/adm/lonLCDfont/d.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/d.gif" ] ,
+"/adm/lonLCDfont/e.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/e.gif" ] ,
+"/adm/lonLCDfont/f.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/f.gif" ] ,
+"/adm/lonLCDfont/g.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/g.gif" ] ,
+"/adm/lonLCDfont/h.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/h.gif" ] ,
+"/adm/lonLCDfont/i.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/i.gif" ] ,
+"/adm/lonLCDfont/j.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/j.gif" ] ,
+"/adm/lonLCDfont/k.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/k.gif" ] ,
+"/adm/lonLCDfont/l.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/l.gif" ] ,
+"/adm/lonLCDfont/m.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/m.gif" ] ,
+"/adm/lonLCDfont/n.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/n.gif" ] ,
+"/adm/lonLCDfont/o.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/o.gif" ] ,
+"/adm/lonLCDfont/p.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/p.gif" ] ,
+"/adm/lonLCDfont/q.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/q.gif" ] ,
+"/adm/lonLCDfont/r.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/r.gif" ] ,
+"/adm/lonLCDfont/s.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/s.gif" ] ,
+"/adm/lonLCDfont/t.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/t.gif" ] ,
+"/adm/lonLCDfont/u.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/u.gif" ] ,
+"/adm/lonLCDfont/v.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/v.gif" ] ,
+"/adm/lonLCDfont/w.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/w.gif" ] ,
+"/adm/lonLCDfont/x.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/x.gif" ] ,
+"/adm/lonLCDfont/y.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/y.gif" ] ,
+"/adm/lonLCDfont/z.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/z.gif" ] ,
+"/adm/lonLCDfont/colon.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/colon.gif" ] ,
+"/adm/lonLCDfont/slash.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/slash.gif" ] ,
+"/adm/lonLCDfont/hyphen.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/hyphen.gif" ] ,
+"/adm/lonLCDfont/space.gif" => [ "image/gif", "FILE",
+ "/home/httpd/html/adm/lonLCDfont/space.gif" ] ,
+ );
+
+%content_types = (%system_content_types, %content_types);
+undef %system_content_types;
+
+while (($file, $arrayref) = each(%virtual_files)) {
+ my ($mime, $type, $block) = (@{ $arrayref });
+ next if ($type ne 'FILE');
+ if(open(S, "$block")) {
+ $j = $/; undef $/; $virtual_files{$file}->[2] = scalar();
+ $/ = $j; close(S);
+ } else {
+ warn "while getting virtual file $file: $!\n";
+ map_delete(%virtual_files, $file);
+ }
+}
+if ($pid = fork()) { exit; }
+
+#
+# Store parent PID
+#
+
+open (PIDSAVE,">$pidfile");
print PIDSAVE "$$\n";
close(PIDSAVE);
-sub REAPER {
- 1 until (-1==waitpid(-1,WNOHANG));
- $SIG{CHLD}=\&REAPER;
-}
-
-$SIG{CHLD}=\&REAPER;
-
-## Configuration section
-$port=8080; # Port on which we listen
-$htmldir="/home/httpd/html/"; # Base directory for HTML files
-
-# the following substitutes "require 'sys/socket.ph';" on ultrix
-# Check if the definitions are correct with /usr/include/sys/socket.h
-$AF_INET=2; $PF_INET=$AF_INET; $SOCK_STREAM=1;
-
-# Messages
-%errors=
- (
- "403", "Forbidden",
- "404", "Not Found",
- "500", "Internal Error",
- "501", "Not Implemented",
- );
-%verrors=
- (
- "403", "Your client is not allowed to request this item",
- "404", "The requested item was not found on this server",
- "500", "An error occurred while trying to retrieve item",
- "501", "This server does not support the given request type",
- );
+$0 = "lonhttpd: (dhttpi) binding port ...";
+$bindthis = pack($sockaddr, 2, $port_to_use,
+ pack('l', chr(0).chr(0).chr(0).chr(0)));
+socket(S, 2, 1, 6);
+setsockopt(S, 1, 2, 1);
+bind(S, $bindthis) || die("$0: while binding port $port_to_use:\n\"$!\"\n");
+listen(S, 128);
+$0 = "lonhttpd: (dhttpi) connected and waiting ANY:$port_to_use";
+
+$statiosuptime = time();
+
+###############################################################
+# WHITE HATS ONLY BELOW THIS POINT -- SEE DOCUMENTATION FIRST #
+###############################################################
+
+sub sock_to_host {
+ local($sock) = getpeername(STDIN);
+
+ return (undef, undef, undef) if (!$sock);
+ local($AFC, $port, $thataddr, $zero) = unpack($sockaddr, $sock);
+ local($ip) = join('.', unpack("C4", $thataddr));
+ return ($ip, $port, $ip);
+}
+
+sub htsponse {
+ ($currentcode, $currentstring) = (@_);
+ return if (0+$httpver < 1);
+ local($what) = <<"EOF";
+HTTP/$httpver $currentcode $currentstring
+${headers}Date: $rfcdate
+EOF
+ $what =~ s/\n/\r\n/g;
+ print stdout $what;
+ &hthead("Connection: close") if (0+$httpver > 1);
+}
-(($>)&&($<==$>)&&($(==$))) || die "Don't run this program with privileges!\n";
+sub hthead {
+ local($header, $term) = (@_);
+ return if (0+$httpver < 1);
+ print stdout "$header\r\n" , ($term) ? "\r\n" : "";
+}
-# set up a server socket, redirect stderr to logfile
-$IPPROTO_TCP=6;
-$sockaddr = 'S n a4 x8';
-$this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");
-socket(S, $PF_INET, $SOCK_STREAM, $IPPROTO_TCP) || die "socket: $!";
-bind(S, $this) || die "bind: $!";
-listen(S, 5) || die "listen: $!";
-open(LOG,">>/home/httpd/perl/logs/lonhttpd.log");
-select(LOG); $|=1;
-open(STDERR, ">&LOG") || die "dup2 log->stderr";
+sub htcontent {
+ local($what, $ctype, $mode) = (@_);
+ ($contentlength) = $mode || length($what);
+ &hthead("Content-Length: $contentlength");
+ &hthead("Content-Type: $ctype", 1);
+ return if ($method eq 'HEAD' || $mode);
+ print stdout $what;
+}
+
+sub log {
+ if (open(J, ">>$logfile")) {
+ local $q = $address . (($variables) ? "?$variables" : "");
+ $contentlength += 0;
+ $contentlength = 0 if ($method eq 'HEAD');
+ local ($hostname, $port, $ip) = &sock_to_host();
+ $hostname = $hostname || "-";
+ $httpuser = $httpuser || "-";
+ print J <<"EOF";
+$hostname - $httpuser [$date] "$method $q HTTP/$httpver" $currentcode $contentlength "$httpref" "$httpua"
+EOF
+ close(J); }
+ }
+
+
+sub bye { exit; }
+
+sub goodbye { unlink($pidfile); exit; }
+
+sub dead {
+ &htsponse(500, "Server Error");
+ &hterror("Server Error", <<"EOF");
+While handling a request for resource $address, the server crashed. Please
+attempt to notify the administrators.
+Useful(?) debugging information:
+
+@_
+
+EOF
+ &log; unlink($pidfile); exit;
+}
+
+$SIG{'__DIE__'} = \&dead;
+$SIG{'ALRM'} = \&bye;
+$SIG{'TERM'} = $SIG{'INT'} = \&goodbye;
+
+sub master {
+ $0 = "lonhttpd: (dhttpi) handling request";
+# $sock = getpeername(STDIN);
+$rfcdate = scalar gmtime;
+($dow, $mon, $dt, $tm, $yr) = ($rfcdate =~
+ m/(...) (...) (..) (..:..:..) (....)/);
+$dt += 0; $yr += 0;
+$rfcdate = "$dow, $dt $mon $yr $tm GMT";
+$date = scalar localtime;
+($dow, $mon, $dt, $tm, $yr) = ($date =~
+ m/(...) (...) (..) (..:..:..) (....)/);
+$dt += 0;
+$dt = substr("0$dt", length("0$dt") - 2, 2);
+$date = "$dt/$mon/$yr:$tm +0000";
+
+select(STDOUT); $|=1; $address = 0;
+alarm 1;
+while () {
+ if(/^([A-Z]+)\s+(\S+)\s+(\S*)/) {
+ $method = $1;
+ $address = $2;
+ $httpver = $3;
+ $httpref = '';
+ $httpua = '';
+ $httpver = ($httpver =~ m#HTTP/([0-9]\.[0-9]+)#) ?
+ ($1) : (0.9);
+ $address =~ s#^http://[^/]+/#/#;
+ next unless ($httpver < 1);
+ } else {
+ s/[\r\l\n\s]+$//;
+ (/^Host: (.+)/i) && ($httphost = $1) && ($httphost =~
+ s/:\d+$//);
+ (/^Referer: (.+)/i) && ($httpref = $1);
+ (/^User-agent: (.+)/i) && ($httpua = $1);
+ (/^Content-length: (\d+)/i) && ($ENV{'CONTENT_LENGTH'} =
+ $httpcl = $1);
+ (/^Content-type: (.+)/i) && ($ENV{'CONTENT_TYPE'} =
+ $httpct = $1);
+ (/^Expect: /) && ($expect = 1);
+ (/^Authorization: Basic (.+)/i) && ($httprawu = $1);
+ (/^Range: (.+)/i) && ($ENV{'CONTENT_RANGE'} = $1);
+ next unless (/^$/);
+ }
+ if ($expect) {
+ &htsponse(417, "Expectation Failed");
+ &hterror("Expectation Failed",
+ "The server does not support this method.");
+ &log; exit;
+ }
+ if (!$address || (0+$httpver > 1 && !$httphost)) {
+ &htsponse(400, "Bad Request");
+ &hterror("Bad Request",
+ "The server cannot understand your request.");
+ &log; exit;
+ }
+ if ($method !~ /^(GET|HEAD|POST)$/) {
+ &htsponse(501, "Illegal Method");
+ &hterror("Illegal Method",
+ "Only GET, HEAD and POST are supported.");
+ &log; exit;
+ }
+ ($address, $variables) = split(/\?/, $address);
+ $address =~ s/%([0-9a-fA-F]{2})/pack("H2", $1)/eg;
+ $address=~ s#^/?#/#;
+ 1 while $address =~ s#/\.(/|$)#\1#;
+ 1 while $address =~ s#/[^/]*/\.\.(/|$)#\1#;
+ 1 while $address =~ s#^/\.\.(/|$)#\1#;
+ $fail = 0;
+#
+# Heavily customized for LON-CAPA
+#
+ $address=~s/\/+/\//g;
+ unless ($address=~/^\/(status|adm\/|res\/adm\/)/) { $fail=1; }
+#
+# because existing restriction matrix would not do precedence across rules
+#
+# J: foreach(sort { length $a <=> length $b }
+# keys %restrictions) {
+# next if ($address !~ /^$_/);
+# ($allowip, $denyip, $allowua, $denyua, $auser) =
+# split(/#/, $restrictions{$_});
+# if ($allowip || $denyip) {
+# ($hostname, $port, $ip) = &sock_to_host();
+# ($allowip && $ip !~ /$allowip/) && ($fail = 1,
+# last J);
+# ($denyip && $ip =~ /$denyip/) && ($fail = 1,
+# last J);
+# }
+# ($allowua && $httpua !~ /$allowua/) &&
+# ($fail = 2, last J);
+# ($denyua && $httpua =~ /$denyua/) &&
+# ($fail = 2, last J);
+# }
+ if ($fail) {
+ &htsponse(403, "Forbidden");
+ if ($fail == 1) {
+ &hterror("Wrong URL", <<"EOF");
+You might want to remove the ":$port_to_use" from the web page address (URL).
+EOF
+ &log; exit;
+ } else {
+ &hterror("Forbidden (Browser Disallowed)", <<"EOF");
+The browser you are using ($httpua) is not capable of or
+is not allowed access to this resource.
+EOF
+ &log; exit;
+ }
+ }
+ if ($auser) {
+ $httprawu =~ tr#A-Za-z0-9+/##cd;
+ $httprawu =~ tr#A-Za-z0-9+/# -_#;
+ $httprawu = unpack("u", pack("c", 32+0.75*length($httprawu))
+ . $httprawu);
+ ($httpuser, $httppw) = split(/:/, $httprawu);
+ $fail = 1;
+ foreach $user (split(/,/, $auser)) {
+ ($user, $pw) = split(/:/, $user);
+ ($fail = 0, last) if ($user eq $httpuser &&
+ crypt($httppw, substr($pw, 0, 2)) eq $pw);
+ }
+ if ($fail) {
+ $httpuser = '';
+ &htsponse(401, "Authorization Required");
+ &hthead("WWW-Authenticate: Basic realm=\"$address\"");
+ &hterror("Authorization Required", <<"EOF");
+You must provide a username and password to use this resource. Either you
+entered this information incorrectly, or your browser does not know how to
+present the credentials required.
+EOF
+ &log; exit;
+ }
+ }
+
+ alarm 0;
+
+ if ($address eq '/status') {
+ &htsponse(200, "OK");
+ $contentlength = 0; # kludge
+ &log;
+ if(open(S, $logfile)) {
+ seek(S, -5000, 2);
+ undef $/;
+ $logsnap = ;
+ $logsnap =~ s/^[^\n]+\n//s if
+ (length($logsnap) > 4999);
+ close(S);
+ }
+ $p = (time() - $statiosuptime);
+ $rps = $p/$statiosreq;
+ $d = int($p / 86400); $p -= $d * 86400;
+ $h = int($p / 3600); $p -= $h * 3600;
+ $m = int($p / 60); $s = $p - ($m * 60);
+ ("0$s" =~ /(\d{2})$/) && ($s = $1);
+ ("0$m" =~ /(\d{2})$/) && ($m = $1);
+ $h +=0; $d += 0;
+ $suptime = scalar localtime $statiosuptime;
+ &htcontent(<<"EOF", "text/html");
+
+
+
+LonHTTPD (HTTPi) Status
+
+
+
+LonHTTPD (HTTPi) Server Status ($VERSION)
+lonhttpd on port $port_to_use
+Started at: $suptime
+Uptime: $d days, $h:$m:$s
+Last request time: $statiosltr
+Requests received: $statiosreq
+Average time between requests: ${rps}s
+
+Most recent requests:
+
+
+maintained by httpi/$VERSION
+
+
+EOF
+ exit;
+ }
+ if (defined $virtual_files{$address}) {
+ $virt_buffer = 1;
+ $mtime = $statiosuptime; # thus always needed
+ goto SERVEIT; # yes, it's bad but it's fast
+ }
+ $raddress = "$path$address"
+ ;
+ &hterror301("$address/")
+ if ($address !~ m#/$# && -d $raddress);
+ $raddress = "${raddress}index.html" if (-d $raddress);
+ if(!sysopen(S, $raddress, 0)) { &hterror404; } else {
+ if (-x $raddress) {
+ $currentcode = 100;
+ &log;
+ if (!$<) {
+ ($x,$x,$x,$x,$uid,$gid) = stat(S);
+ (!$uid || !$gid) &&
+ die "executable is root-owned";
+ $> = $uid || die "can't set effuid";
+ $) = $gid || die "can't set effgid";
+ }
+ ($hostname, $port, $ip) = &sock_to_host() if (!$port);
+ $ENV{'REQUEST_METHOD'} = $method;
+ $ENV{'SERVER_NAME'} = "localhost";
+ $ENV{'SERVER_PROTOCOL'} = "HTTP/$httpver";
+ $ENV{'SERVER_SOFTWARE'} = "HTTPi/$VERSION";
+ $ENV{'SERVER_PORT'} = "$port_to_use";
+ $ENV{'SERVER_URL'} = "http://localhost:$port_to_use/";
+ $ENV{'SCRIPT_FILENAME'} = $raddress;
+ $ENV{'SCRIPT_NAME'} = $address;
+ $ENV{'REMOTE_HOST'} = $hostname;
+ $ENV{'REMOTE_ADDR'} = $ip;
+ $ENV{'REMOTE_PORT'} = $port;
+ $ENV{'QUERY_STRING'} = $variables;
+ $ENV{'HTTP_USER_AGENT'} = $httpua;
+ $ENV{'HTTP_REFERER'} = $httpref;
+ if ($pid = fork()) { exit; } else {
+ if ($method eq 'POST') { # needs stdin
+ open(W, "|$raddress") || die
+ "can't POST to $raddress";
+ read(STDIN, $buf, $httpcl);
+ print W $buf;
+ exit;
+ }
+ exec "$raddress", "$variables";
+ die "exec() returned -1";
+ }
+ }
+ ($x,$x,$x,$x,$x,$x,$x,$length,$x,$mtime) = stat(S);
+ $ctype = 0;
+ foreach(keys %content_types) {
+ if ($raddress =~ /\.$_$/i) {
+ $ctype = $content_types{$_};
+ }
+ }
+SERVEIT: $ctype ||= 'text/plain';
+ &htsponse(200, "OK");
+ $mtime = scalar gmtime $mtime;
+ ($dow, $mon, $dt, $tm, $yr) =
+ ($mtime =~ m/(...) (...) (..) (..:..:..) (....)/);
+ $dt += 0; $yr += 0;
+ &hthead("Last-Modified: $dow, $dt $mon $yr $tm GMT");
+ if ($pid = fork()) { exit; }
+ if ($virt_buffer) {
+ &htcontent($virtual_files{$address}->[2],
+ $virtual_files{$address}->[0], 0);
+ } else {
+ &htcontent("", $ctype, $length);
+ unless ($method eq 'HEAD') {
+ while(!eof(S)) {
+ read(S, $q, 16384);
+ print stdout $q;
+ }
+ }
+ }
+ alarm 0;
+ }
+ &log;
+ exit;
+}
+
+exit;
+}
+
+
+sub hterror {
+ local($errstr, $expl) = (@_);
+ &htcontent(<<"EOF", "text/html");
+
+
+$errstr
+$expl
+
+httpi/$VERSION
+by Cameron Kaiser
+
+
+EOF
+ }
+
+sub hterror404 {
+ &htsponse(404, "File Not Found");
+ &hterror("File Not Found",
+ "The resource $address was not found on this system.");
+}
+
+sub hterror301 {
+ &htsponse(301, "Moved Permanently");
+ &hthead("Location: @_");
+ &hterror("Resource Moved Permanently",
+ "This resource has moved here.");
+ $keep = 0; &log; exit;
+}
-# accept incoming calls
for (;;) {
- ($addr=accept(NS,S)) || die "accept: $!";
- next if $pid=fork;
- die "fork: $!" unless defined $pid;
- close(S);
- ($a,$p,$inetaddr) = unpack($sockaddr, $addr);
- @inetaddr = unpack('C4', $inetaddr);
- ($host,$aliases) = gethostbyaddr($inetaddr, $AF_INET);
- $inetaddr = join(".", @inetaddr);
- @host=split(' ', "$host $aliases");
- $host || do { $host = $inetaddr; };
- @t=localtime;
- open(STDIN, "+<&NS") || die "dup2 ns->stdin";
- open(STDOUT, "+>&NS") || die "dup2 ns->stdout";
- select(STDOUT); $|=1;
- &serve_request;
- close(STDIN); close(STDOUT);
- exit;
-}
-
-# Read request from stdin and produce output
-sub serve_request {
-
- # Analyze HTTP input.
- $_=;
- ($method, $url, $proto) = split;
- if ($proto) {
- while () {
- s/\n|\r//g; # kill CR and NL chars
- /^Content-Length: (\S*)/i && ($content_length=$1);
- /^Content-Type: (\S*)/i && ($content_type=$1);
- length || last; # empty line - end of header
- }
- } else {
- $proto="HTTP/0.9";
- }
- ($method=~/^(GET|POST)$/) || do { &error(501,$method); return; };
-
- # prevent directory go-back
- $url=~/\.\./ && do { &error(403,$url,"contains go-back"); return; };
-
- # Check access control
- unless (($url=~/^\/res\/adm\//) || ($url=~/^\/adm\//)) {
- do { &error(403,$url,"not on allow list"); return; };
- }
- print LOG "$$: $url\n";
-
-# Get and return file
-
- $file="$htmldir$url";
- (-r "$file") || do { &error(404,$url); return; };
- # output the file
- print "HTTP/1.0 200 OK\nMIME-Version: 1.0\nContent-Type: ";
- CASE:
- {
- $url=~/\.html$/ && do { print "text/html\n\n"; last CASE; };
- $url=~/\.gif$/ && do { print "image/gif\n\n"; last CASE; };
- print "text/plain\n\n";
- }
- system("cat $file");
-}
-
-sub error {
- # generate error response
- local($errno) = @_[0];
- local($errmsg) = "$errno $errors{$errno}";
- print LOG "$$ $errmsg (@_[1,2])\n";
- print <
-$errmsg
-$errmsg
-$verrors{$errno}: @_[1]
-
-
-$ENV{'SERVER_SOFTWARE'} by Olaf Titz, modified by LON-CAPA
-
-