#!/usr/bin/perl # $Id: lonhttpd,v 1.6 2003/02/24 23:32:32 albertel 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); $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); } sub hthead { local($header, $term) = (@_); return if (0+$httpver < 1); print stdout "$header\r\n" , ($term) ? "\r\n" : ""; } 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 { 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'} = $SIG{'TERM'} = $SIG{'INT'} = \&bye; 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\r\l\n]*)/) { $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("Forbidden (Client Disallowed)", <<"EOF"); Your network address ($ip) is not allowed to access this resource. 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; } for (;;) { $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; } }