--- 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
- - -TheEnd + $addr=accept(NS,S); + $statiosltr = scalar localtime; + $statiosreq++; + if ($pid = fork()) { + $0 = "lonhttpd: (dhttpi) waiting for child process"; + waitpid($pid, 0); + $0 = "lonhttpd: (dhttpi) on ANY:$port_to_use, last request " . + scalar localtime; + } else { + $0 = "lonhttpd: (dhttpi) child switching to socket"; + open(STDIN, "<&NS"); + open(STDOUT, ">&NS"); + &master; + exit; + } }