#!/usr/bin/perl # $Id: lonhttpd,v 1.15 2007/07/11 18:48:20 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", "png" => "image/png"); $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=; 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 { 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 = 1; # # Heavily customized for LON-CAPA # $address=~s/\/+/\//g; if ($address=~/^\/(status|adm\/|res\/adm\/)/) { $fail = 0; } elsif ($address =~ /^\/res\/([\w\.\-]+)\/\1\-domainconfig\/(logo|domlogo|img)\/[^\/]+$/) { $fail = 0; } # # 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; } 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; close(NS); } else { $0 = "lonhttpd: (dhttpi) child switching to socket"; open(STDIN, "<&NS"); open(STDOUT, ">&NS"); &master; exit; } } 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.