#!/usr/bin/perl
# $Id: lonhttpd,v 1.4 2002/10/30 15:32:33 www Exp $
$VERSION = "1.3.2 (Demonic/Linux/LON-CAPA Derivative)";
# 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
#
%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(<S>);
$/ = $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 = "dhttpi: binding port ...";
$bindthis = pack($sockaddr, 2, 8080, 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 8080:\n\"$!\"\n");
listen(S, 128);
$0 = "dhttpi: connected and waiting ANY:8080";
$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.
<p>Useful(?) debugging information:
<pre>
@_
</pre>
EOF
&log; unlink($pidfile); exit;
}
$SIG{'__DIE__'} = \&dead;
$SIG{'ALRM'} = $SIG{'TERM'} = $SIG{'INT'} = \&bye;
sub master {
$0 = "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 (<STDIN>) {
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 (<i>$ip</i>) is not allowed to access this resource.
EOF
&log; exit;
} else {
&hterror("Forbidden (Browser Disallowed)", <<"EOF");
The browser you are using (<i>$httpua</i>) 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 = <S>;
$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");
<html>
<head>
<title>
HTTPi Status
</title>
</head>
<body bgcolor = "#ffffff" text = "#000000" vlink = "#0000ff" link = "#0000ff">
<h1>HTTPi Server Status (<code>$VERSION</code>)</h1>
<h3>lonhttpd on port 8080</h3>
<b>Started at:</b> $suptime<br>
<b>Uptime:</b> $d days, $h:$m:$s<br>
<b>Last request time:</b> $statiosltr<p>
<b>Requests received:</b> $statiosreq<br>
<b>Average time between requests:</b> ${rps}s
<p>
<b>Most recent requests:</b>
<form action = "/status" method = "post">
<textarea name = "bletch" rows = "8" cols = "70">
$logsnap
</textarea>
</form>
<hr>
<address>maintained by <a href =
"http://httpi.floodgap.com/">httpi/$VERSION</a></address>
</body>
</html>
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'} = "8080";
$ENV{'SERVER_URL'} = "http://localhost:8080/";
$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");
<html>
<body>
<h1>$errstr</h1>
$expl
<hr>
<address><a href = "http://httpi.floodgap.com/">httpi/$VERSION</a>
by Cameron Kaiser</address>
</body>
</html>
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 <a href = \"@_\">here</a>.");
$keep = 0; &log; exit;
}
for (;;) {
$addr=accept(NS,S);
$statiosltr = scalar localtime;
$statiosreq++;
if ($pid = fork()) {
$0 = "dhttpi: waiting for child process";
waitpid($pid, 0);
$0 = "dhttpi: on ANY:8080, last request " .
scalar localtime;
} else {
$0 = "dhttpi: child switching to socket";
open(STDIN, "<&NS");
open(STDOUT, ">&NS");
&master;
exit;
}
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>