Annotation of loncom/lonhttpd, revision 1.12

1.1       www         1: #!/usr/bin/perl
1.12    ! raeburn     2: # $Id: lonhttpd,v 1.11 2007/04/10 20:08:01 raeburn Exp $
1.1       www         3: 
1.6       albertel    4: $VERSION = "1.3.2 (Demonic/Linux/LON-CAPA Derivative $Revison$)";
1.1       www         5: 
1.3       www         6: # HTTPi Hypertext Tiny Truncated Process Implementation
                      7: # Copyright 1999-2001 Cameron Kaiser # All rights reserved
                      8: # Please read LICENSE # Do not strip this copyright message.
                      9: #
                     10: # LON-CAPA: find httpi license and readme at CVS loncom/license
                     11: #
                     12: 
1.6       albertel   13: use lib '/home/httpd/lib/perl/';
                     14: use LONCAPA::Configuration();
1.12    ! raeburn    15: use Apache::lonnet;
1.6       albertel   16: %loncapavar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
                     17: $port_to_use=$loncapavar{'lonhttpdPort'};
                     18: if (!defined($port_to_use)) {
                     19:     $port_to_use='8080';
                     20: }
                     21: 
                     22: # The main server is running on 80, so exit in this case
                     23: if ($port_to_use eq '80') { die('Apache is already on Port 80'); }
                     24: 
1.3       www        25: %system_content_types =
                     26: 	("html" => "text/html",
                     27: 	 "htm" => "text/html",
                     28: 	 "wml" => "text/vnd.wap.wml",
                     29: 	 "wbmp" => "image/vnd.wap.wbmp",
                     30: 	 "wbm" => "image/vnd.wap.wbmp",
                     31: 	 "xbm" => "image/x-xbitmap",
                     32: 	 "pdf" => "application/pdf",
                     33: 	 "fdf" => "application/vnd.fdf",
                     34: 	 "bin" => "application/octet-stream",
                     35: 	 "class" => "application/octet-stream",
                     36: 	 "jar" => "application/octet-stream",
                     37: 	 "js" => "application/x-javascript",
                     38: 	 "lnk" => "application/x-hyperlink",
                     39: 	 "wav" => "audio/x-wav",
                     40: 	 "mp3" => "audio/x-mpeg",
                     41: 	 "tif" => "image/tiff",
                     42: 	 "tiff" => "image/tiff",
                     43: 	 "mid" => "audio/x-midi",
                     44: 	 "txt" => "text/plain",
                     45: 	 "gif" => "image/gif",
                     46: 	 "sit" => "application/x-stuffit",
                     47: 	 "zip" => "application/x-zip-compressed",
                     48: 	 "lzh" => "application/octet-stream",
                     49: 	 "lha" => "application/octet-stream",
                     50: 	 "gz"  => "application/x-gzip",
                     51: 	 "mov" => "movie/quicktime",
                     52: 	 "mpeg" => "video/mpeg",
                     53: 	 "mpg" => "video/mpeg",
                     54: 	 "jpeg" => "image/jpeg",
1.11      raeburn    55: 	 "jpg" => "image/jpeg",
                     56:          "png" => "image/png");
1.3       www        57: 
                     58: $logfile = "/home/httpd/perl/logs/lonhttpd.log";
                     59: 
                     60: # Write out PID
                     61: 
                     62: $pidfile="/home/httpd/perl/logs/lonhttpd.pid";
                     63: 
                     64: if (-e $pidfile) {
                     65:    open(LFH,"$pidfile");
1.10      albertel   66:    my $pide=<LFH>;
1.3       www        67:    chomp($pide);
                     68:    close(LFH);
                     69:    if (kill 0 => $pide) { die "already running"; }
                     70: }
                     71: 
                     72: $path = "/home/httpd/html";
                     73: $sockaddr = 'S n a4 x8';
1.1       www        74: 
                     75: 
1.3       www        76: %content_types =
                     77: 	("html" => "text/html",
                     78: 	 "htm" => "text/html");
                     79: %restrictions =
                     80: 	("/"        => "#.##",  # deny everything
                     81:          "/res/adm" => ".###",  # allow /res/adm
                     82:          "/adm"     => ".###",  # allow /adm
                     83: 	 "/status"  => ".####lonadm:oeRooOvb3HtpI");
                     84: 		# See documentation for interpreting this string.
                     85: 
                     86: $headers = <<"EOF";
                     87: Server: HTTPi/$VERSION
                     88: MIME-Version: 1.0
                     89: EOF
                     90: 
                     91: %virtual_files =
                     92: 	(
                     93: "/adm/lonLCDfont/0.gif" => [ "image/gif", "FILE",
                     94: 		"/home/httpd/html/adm/lonLCDfont/0.gif" ] ,
                     95: "/adm/lonLCDfont/1.gif" => [ "image/gif", "FILE",
                     96: 		"/home/httpd/html/adm/lonLCDfont/1.gif" ] ,
                     97: "/adm/lonLCDfont/2.gif" => [ "image/gif", "FILE",
                     98: 		"/home/httpd/html/adm/lonLCDfont/2.gif" ] ,
                     99: "/adm/lonLCDfont/3.gif" => [ "image/gif", "FILE",
                    100: 		"/home/httpd/html/adm/lonLCDfont/3.gif" ] ,
                    101: "/adm/lonLCDfont/4.gif" => [ "image/gif", "FILE",
                    102: 		"/home/httpd/html/adm/lonLCDfont/4.gif" ] ,
                    103: "/adm/lonLCDfont/5.gif" => [ "image/gif", "FILE",
                    104: 		"/home/httpd/html/adm/lonLCDfont/5.gif" ] ,
                    105: "/adm/lonLCDfont/6.gif" => [ "image/gif", "FILE",
                    106: 		"/home/httpd/html/adm/lonLCDfont/6.gif" ] ,
                    107: "/adm/lonLCDfont/7.gif" => [ "image/gif", "FILE",
                    108: 		"/home/httpd/html/adm/lonLCDfont/7.gif" ] ,
                    109: "/adm/lonLCDfont/8.gif" => [ "image/gif", "FILE",
                    110: 		"/home/httpd/html/adm/lonLCDfont/8.gif" ] ,
                    111: "/adm/lonLCDfont/9.gif" => [ "image/gif", "FILE",
                    112: 		"/home/httpd/html/adm/lonLCDfont/9.gif" ] ,
                    113: "/adm/lonLCDfont/a.gif" => [ "image/gif", "FILE",
                    114: 		"/home/httpd/html/adm/lonLCDfont/a.gif" ] ,
                    115: "/adm/lonLCDfont/b.gif" => [ "image/gif", "FILE",
                    116: 		"/home/httpd/html/adm/lonLCDfont/b.gif" ] ,
                    117: "/adm/lonLCDfont/c.gif" => [ "image/gif", "FILE",
                    118: 		"/home/httpd/html/adm/lonLCDfont/c.gif" ] ,
                    119: "/adm/lonLCDfont/d.gif" => [ "image/gif", "FILE",
                    120: 		"/home/httpd/html/adm/lonLCDfont/d.gif" ] ,
                    121: "/adm/lonLCDfont/e.gif" => [ "image/gif", "FILE",
                    122: 		"/home/httpd/html/adm/lonLCDfont/e.gif" ] ,
                    123: "/adm/lonLCDfont/f.gif" => [ "image/gif", "FILE",
                    124: 		"/home/httpd/html/adm/lonLCDfont/f.gif" ] ,
                    125: "/adm/lonLCDfont/g.gif" => [ "image/gif", "FILE",
                    126: 		"/home/httpd/html/adm/lonLCDfont/g.gif" ] ,
                    127: "/adm/lonLCDfont/h.gif" => [ "image/gif", "FILE",
                    128: 		"/home/httpd/html/adm/lonLCDfont/h.gif" ] ,
                    129: "/adm/lonLCDfont/i.gif" => [ "image/gif", "FILE",
                    130: 		"/home/httpd/html/adm/lonLCDfont/i.gif" ] ,
                    131: "/adm/lonLCDfont/j.gif" => [ "image/gif", "FILE",
                    132: 		"/home/httpd/html/adm/lonLCDfont/j.gif" ] ,
                    133: "/adm/lonLCDfont/k.gif" => [ "image/gif", "FILE",
                    134: 		"/home/httpd/html/adm/lonLCDfont/k.gif" ] ,
                    135: "/adm/lonLCDfont/l.gif" => [ "image/gif", "FILE",
                    136: 		"/home/httpd/html/adm/lonLCDfont/l.gif" ] ,
                    137: "/adm/lonLCDfont/m.gif" => [ "image/gif", "FILE",
                    138: 		"/home/httpd/html/adm/lonLCDfont/m.gif" ] ,
                    139: "/adm/lonLCDfont/n.gif" => [ "image/gif", "FILE",
                    140: 		"/home/httpd/html/adm/lonLCDfont/n.gif" ] ,
                    141: "/adm/lonLCDfont/o.gif" => [ "image/gif", "FILE",
                    142: 		"/home/httpd/html/adm/lonLCDfont/o.gif" ] ,
                    143: "/adm/lonLCDfont/p.gif" => [ "image/gif", "FILE",
                    144: 		"/home/httpd/html/adm/lonLCDfont/p.gif" ] ,
                    145: "/adm/lonLCDfont/q.gif" => [ "image/gif", "FILE",
                    146: 		"/home/httpd/html/adm/lonLCDfont/q.gif" ] ,
                    147: "/adm/lonLCDfont/r.gif" => [ "image/gif", "FILE",
                    148: 		"/home/httpd/html/adm/lonLCDfont/r.gif" ] ,
                    149: "/adm/lonLCDfont/s.gif" => [ "image/gif", "FILE",
                    150: 		"/home/httpd/html/adm/lonLCDfont/s.gif" ] ,
                    151: "/adm/lonLCDfont/t.gif" => [ "image/gif", "FILE",
                    152: 		"/home/httpd/html/adm/lonLCDfont/t.gif" ] ,
                    153: "/adm/lonLCDfont/u.gif" => [ "image/gif", "FILE",
                    154: 		"/home/httpd/html/adm/lonLCDfont/u.gif" ] ,
                    155: "/adm/lonLCDfont/v.gif" => [ "image/gif", "FILE",
                    156: 		"/home/httpd/html/adm/lonLCDfont/v.gif" ] ,
                    157: "/adm/lonLCDfont/w.gif" => [ "image/gif", "FILE",
                    158: 		"/home/httpd/html/adm/lonLCDfont/w.gif" ] ,
                    159: "/adm/lonLCDfont/x.gif" => [ "image/gif", "FILE",
                    160: 		"/home/httpd/html/adm/lonLCDfont/x.gif" ] ,
                    161: "/adm/lonLCDfont/y.gif" => [ "image/gif", "FILE",
                    162: 		"/home/httpd/html/adm/lonLCDfont/y.gif" ] ,
                    163: "/adm/lonLCDfont/z.gif" => [ "image/gif", "FILE",
                    164: 		"/home/httpd/html/adm/lonLCDfont/z.gif" ] ,
                    165: "/adm/lonLCDfont/colon.gif" => [ "image/gif", "FILE",
                    166: 		"/home/httpd/html/adm/lonLCDfont/colon.gif" ] ,
                    167: "/adm/lonLCDfont/slash.gif" => [ "image/gif", "FILE",
                    168: 		"/home/httpd/html/adm/lonLCDfont/slash.gif" ] ,
                    169: "/adm/lonLCDfont/hyphen.gif" => [ "image/gif", "FILE",
                    170: 		"/home/httpd/html/adm/lonLCDfont/hyphen.gif" ] ,
                    171: "/adm/lonLCDfont/space.gif" => [ "image/gif", "FILE",
                    172: 		"/home/httpd/html/adm/lonLCDfont/space.gif" ] ,
                    173: 	);
                    174: 
                    175: %content_types = (%system_content_types, %content_types);
                    176: undef %system_content_types;
                    177: 
                    178: while (($file, $arrayref) = each(%virtual_files)) {
                    179: 	my ($mime, $type, $block) = (@{ $arrayref });
                    180: 	next if ($type ne 'FILE');
                    181: 	if(open(S, "$block")) {
                    182: 		$j = $/; undef $/; $virtual_files{$file}->[2] = scalar(<S>);
                    183: 		$/ = $j; close(S);
                    184: 	} else {
                    185: 		warn "while getting virtual file $file: $!\n";
                    186: 		map_delete(%virtual_files, $file);
                    187: 	}
                    188: }
                    189: if ($pid = fork()) { exit; }
                    190: 
                    191: #
                    192: # Store parent PID
                    193: #
1.1       www       194: 
1.3       www       195: open (PIDSAVE,">$pidfile");
1.1       www       196: print PIDSAVE "$$\n";
                    197: close(PIDSAVE);
                    198: 
1.5       albertel  199: $0 = "lonhttpd: (dhttpi) binding port ...";
1.6       albertel  200: $bindthis = pack($sockaddr, 2, $port_to_use,
                    201: 		 pack('l', chr(0).chr(0).chr(0).chr(0)));
1.3       www       202: socket(S, 2, 1, 6);
                    203: setsockopt(S, 1, 2, 1);
1.6       albertel  204: bind(S, $bindthis) || die("$0: while binding port $port_to_use:\n\"$!\"\n");
1.3       www       205: listen(S, 128);
1.6       albertel  206: $0 = "lonhttpd: (dhttpi) connected and waiting ANY:$port_to_use";
1.3       www       207: 
                    208: $statiosuptime = time();
                    209: 
                    210: ###############################################################
                    211: # WHITE HATS ONLY BELOW THIS POINT -- SEE DOCUMENTATION FIRST #
                    212: ###############################################################
                    213: 
                    214: sub sock_to_host {
                    215: 	local($sock) = getpeername(STDIN);
                    216: 
                    217: 	return (undef, undef, undef) if (!$sock);
                    218: 	local($AFC, $port, $thataddr, $zero) = unpack($sockaddr, $sock);
                    219: 	local($ip) = join('.', unpack("C4", $thataddr));
                    220: 	return ($ip, $port, $ip);
                    221: }
                    222: 
                    223: sub htsponse {
                    224: 	($currentcode, $currentstring) = (@_);
                    225: 	return if (0+$httpver < 1);
                    226: 	local($what) = <<"EOF";
                    227: HTTP/$httpver $currentcode $currentstring
                    228: ${headers}Date: $rfcdate
                    229: EOF
                    230: 	$what =~ s/\n/\r\n/g;
                    231: 	print stdout $what;
                    232: 	&hthead("Connection: close") if (0+$httpver > 1);
                    233: }
                    234: 
                    235: sub hthead {
                    236: 	local($header, $term) = (@_);
                    237: 	return if (0+$httpver < 1);
                    238: 	print stdout "$header\r\n" , ($term) ? "\r\n" : "";
                    239: }
                    240: 
                    241: sub htcontent {
                    242: 	local($what, $ctype, $mode) = (@_);
                    243: 	($contentlength) = $mode || length($what);
                    244: 	&hthead("Content-Length: $contentlength");
                    245: 	&hthead("Content-Type: $ctype", 1);
                    246: 	return if ($method eq 'HEAD' || $mode);
                    247: 	print stdout $what;
                    248: }
                    249: 
                    250: sub log {
                    251:  	if (open(J, ">>$logfile")) {
                    252: 		local $q = $address . (($variables) ? "?$variables" : "");
                    253: 		$contentlength += 0;
                    254: 		$contentlength = 0 if ($method eq 'HEAD');
                    255: 		local ($hostname, $port, $ip) = &sock_to_host();
                    256: 		$hostname = $hostname || "-";
                    257: 		$httpuser = $httpuser || "-";
                    258: 		print J <<"EOF";
                    259: $hostname - $httpuser [$date] "$method $q HTTP/$httpver" $currentcode $contentlength "$httpref" "$httpua"
                    260: EOF
                    261: 		close(J); }
                    262: 	}
                    263: 
                    264: 
1.9       www       265: sub bye { exit; }
                    266: 
                    267: sub goodbye { unlink($pidfile); exit; }
1.3       www       268: 
                    269: sub dead {
                    270: 	&htsponse(500, "Server Error");
                    271: 	&hterror("Server Error", <<"EOF");
                    272: While handling a request for resource $address, the server crashed. Please
                    273: attempt to notify the administrators.
                    274: <p>Useful(?) debugging information:
                    275: <pre>
                    276: @_
                    277: </pre>
                    278: EOF
                    279: 	&log; unlink($pidfile); exit;
                    280: }
                    281: 
                    282: $SIG{'__DIE__'} = \&dead;
1.9       www       283: $SIG{'ALRM'} = \&bye;
                    284: $SIG{'TERM'} = $SIG{'INT'} = \&goodbye;
1.3       www       285: 
                    286: sub master {
1.5       albertel  287: 	$0 = "lonhttpd: (dhttpi) handling request";
1.3       www       288: # $sock = getpeername(STDIN);
                    289: $rfcdate = scalar gmtime;
                    290: ($dow, $mon, $dt, $tm, $yr) = ($rfcdate =~
                    291: 	m/(...) (...) (..) (..:..:..) (....)/);
                    292: $dt += 0; $yr += 0;
                    293: $rfcdate = "$dow, $dt $mon $yr $tm GMT";
                    294: $date = scalar localtime;
                    295: ($dow, $mon, $dt, $tm, $yr) = ($date =~
                    296: 	m/(...) (...) (..) (..:..:..) (....)/);
                    297: $dt += 0;
                    298: $dt = substr("0$dt", length("0$dt") - 2, 2);
                    299: $date = "$dt/$mon/$yr:$tm +0000"; 
                    300: 
                    301: select(STDOUT); $|=1; $address = 0; 
                    302: alarm 1;
                    303: while (<STDIN>) {
1.8       albertel  304: 	if(/^([A-Z]+)\s+(\S+)\s+(\S*)/) {
1.3       www       305: 		$method = $1;
                    306: 		$address = $2; 
                    307: 		$httpver = $3;
                    308: 		$httpref = '';
                    309: 		$httpua = '';
                    310: 		$httpver = ($httpver =~ m#HTTP/([0-9]\.[0-9]+)#) ?
                    311: 			($1) : (0.9);
                    312: 		$address =~ s#^http://[^/]+/#/#;
                    313: 		next unless ($httpver < 1);
                    314: 	} else {
                    315: 		s/[\r\l\n\s]+$//;
                    316: 		(/^Host: (.+)/i) && ($httphost = $1) && ($httphost =~
                    317: 			s/:\d+$//);
                    318: 		(/^Referer: (.+)/i) && ($httpref = $1);
                    319: 		(/^User-agent: (.+)/i) && ($httpua = $1);
                    320: 		(/^Content-length: (\d+)/i) && ($ENV{'CONTENT_LENGTH'} =
                    321: 			$httpcl = $1);
                    322: 		(/^Content-type: (.+)/i) && ($ENV{'CONTENT_TYPE'} =
                    323: 			$httpct = $1);
                    324: 		(/^Expect: /) && ($expect = 1);
                    325: 		(/^Authorization: Basic (.+)/i) && ($httprawu = $1);
                    326: 		(/^Range: (.+)/i) && ($ENV{'CONTENT_RANGE'} = $1);
                    327: 		next unless (/^$/);
                    328: 	}
                    329: 	if ($expect) {
                    330: 		&htsponse(417, "Expectation Failed");
                    331: 		&hterror("Expectation Failed",
                    332: 			"The server does not support this method.");
                    333: 		&log; exit;
                    334: 	}
                    335: 	if (!$address || (0+$httpver > 1 && !$httphost)) {
                    336: 		&htsponse(400, "Bad Request");
                    337: 		&hterror("Bad Request",
                    338: 			"The server cannot understand your request.");
                    339: 		&log; exit;
                    340: 	}
                    341: 	if ($method !~ /^(GET|HEAD|POST)$/) {
                    342: 		&htsponse(501, "Illegal Method");
                    343: 		&hterror("Illegal Method",
                    344: 			"Only GET, HEAD and POST are supported.");
                    345: 		&log; exit;
                    346: 	}
                    347: 	($address, $variables) = split(/\?/, $address);
                    348: 	$address =~ s/%([0-9a-fA-F]{2})/pack("H2", $1)/eg;
                    349: 	$address=~ s#^/?#/#;
                    350: 	1 while $address =~ s#/\.(/|$)#\1#;
                    351:         1 while $address =~ s#/[^/]*/\.\.(/|$)#\1#;
                    352: 	1 while $address =~ s#^/\.\.(/|$)#\1#;
1.11      raeburn   353: 	$fail = 1;
1.3       www       354: #
                    355: # Heavily customized for LON-CAPA
                    356: #
1.4       www       357: 	$address=~s/\/+/\//g;
1.11      raeburn   358:         if ($address=~/^\/(status|adm\/|res\/adm\/)/) {
                    359:             $fail = 0;
1.12    ! raeburn   360:         } elsif ($address =~ /^\/res\/([^\/]+)\/\1\-domainconfig\/(logo|domlogo|img)\/[^\/]+$/) {
        !           361:             if (&Apache::lonnet::domain($1) ne '') {
1.11      raeburn   362:                 $fail = 0;
1.12    ! raeburn   363:             }
1.11      raeburn   364:         }
                    365: 
1.3       www       366: #
                    367: # because existing restriction matrix would not do precedence across rules
                    368: #
                    369: #	J: foreach(sort { length $a <=> length $b }
                    370: #			keys %restrictions) {
                    371: #		next if ($address !~ /^$_/);
                    372: #		($allowip, $denyip, $allowua, $denyua, $auser) =
                    373: #			split(/#/, $restrictions{$_});
                    374: #		if ($allowip || $denyip) {
                    375: #			($hostname, $port, $ip) = &sock_to_host();
                    376: #			($allowip && $ip !~ /$allowip/) && ($fail = 1,
                    377: #				last J);
                    378: #			($denyip && $ip =~ /$denyip/) && ($fail = 1,
                    379: #				last J);
                    380: #		}
                    381: #		($allowua && $httpua !~ /$allowua/) &&
                    382: #			($fail = 2, last J);
                    383: #		($denyua && $httpua =~ /$denyua/) &&
                    384: #			($fail = 2, last J);
                    385: #	}
                    386: 	if ($fail) {
                    387: 		&htsponse(403, "Forbidden");
                    388: 		if ($fail == 1) {
1.7       www       389: 			&hterror("Wrong URL", <<"EOF");
                    390: You might want to remove the "<tt>:$port_to_use</tt>" from the web page address (URL).
1.3       www       391: EOF
                    392: 			&log; exit;
                    393: 		} else {
                    394: 			&hterror("Forbidden (Browser Disallowed)", <<"EOF");
                    395: The browser you are using (<i>$httpua</i>) is not capable of or
                    396: is not allowed access to this resource.
                    397: EOF
                    398: 			&log; exit;
                    399: 		}
                    400: 	}
                    401: 	if ($auser) {
                    402: 		$httprawu =~ tr#A-Za-z0-9+/##cd;
                    403: 		$httprawu =~ tr#A-Za-z0-9+/# -_#;
                    404: 		$httprawu = unpack("u", pack("c", 32+0.75*length($httprawu))
                    405: 			. $httprawu);
                    406: 		($httpuser, $httppw) = split(/:/, $httprawu);
                    407: 		$fail = 1;
                    408: 		foreach $user (split(/,/, $auser)) {
                    409: 			($user, $pw) = split(/:/, $user);
                    410: 			($fail = 0, last) if ($user eq $httpuser &&
                    411: 				crypt($httppw, substr($pw, 0, 2)) eq $pw);
                    412: 		}
                    413: 		if ($fail) {
                    414: 			$httpuser = '';
                    415: 			&htsponse(401, "Authorization Required");
                    416: 			&hthead("WWW-Authenticate: Basic realm=\"$address\"");
                    417: 			&hterror("Authorization Required", <<"EOF");
                    418: You must provide a username and password to use this resource. Either you
                    419: entered this information incorrectly, or your browser does not know how to
                    420: present the credentials required.
                    421: EOF
                    422: 			&log; exit;
                    423: 		}
                    424: 	}
1.1       www       425: 
1.3       www       426: 	alarm 0;
                    427: 
                    428: 	if ($address eq '/status') {
                    429: 		&htsponse(200, "OK");
                    430: 		$contentlength = 0; # kludge
                    431: 		&log;
                    432: 		if(open(S, $logfile)) {
                    433: 			seek(S, -5000, 2);
                    434: 			undef $/;
                    435: 			$logsnap = <S>;
                    436: 			$logsnap =~ s/^[^\n]+\n//s if
                    437: 				(length($logsnap) > 4999);
                    438: 			close(S);
                    439: 		}
                    440: 		$p = (time() - $statiosuptime);
                    441: 		$rps = $p/$statiosreq;
                    442: 		$d = int($p / 86400); $p -= $d * 86400;
                    443: 		$h = int($p / 3600); $p -= $h * 3600;
                    444: 		$m = int($p / 60); $s = $p - ($m * 60);
                    445: 		("0$s" =~ /(\d{2})$/) && ($s = $1);
                    446: 		("0$m" =~ /(\d{2})$/) && ($m = $1);
                    447: 		$h +=0; $d += 0;
                    448: 		$suptime = scalar localtime $statiosuptime;
                    449: 		&htcontent(<<"EOF", "text/html");
                    450: <html>
                    451: <head>
                    452: <title>
1.5       albertel  453: LonHTTPD (HTTPi) Status
1.3       www       454: </title>
                    455: </head>
                    456: <body bgcolor = "#ffffff" text = "#000000" vlink = "#0000ff" link = "#0000ff">
1.5       albertel  457: <h1>LonHTTPD (HTTPi) Server Status (<code>$VERSION</code>)</h1>
1.6       albertel  458: <h3>lonhttpd on port $port_to_use</h3>
1.3       www       459: <b>Started at:</b> $suptime<br>
                    460: <b>Uptime:</b> $d days, $h:$m:$s<br>
                    461: <b>Last request time:</b> $statiosltr<p>
                    462: <b>Requests received:</b> $statiosreq<br>
                    463: <b>Average time between requests:</b> ${rps}s
                    464: <p>
                    465: <b>Most recent requests:</b>
                    466: <form action = "/status" method = "post">
                    467: <textarea name = "bletch" rows = "8" cols = "70">
                    468: $logsnap
                    469: </textarea>
                    470: </form>
                    471: <hr>
                    472: <address>maintained by <a href =
                    473: "http://httpi.floodgap.com/">httpi/$VERSION</a></address>
                    474: </body>
                    475: </html>
                    476: EOF
                    477: 		exit;
                    478: 	}
                    479: 	if (defined $virtual_files{$address}) {
                    480: 		$virt_buffer = 1;
                    481: 		$mtime = $statiosuptime; # thus always needed
                    482: 		goto SERVEIT;		# yes, it's bad but it's fast
                    483: 	}
                    484: 	$raddress = "$path$address"
                    485: 	;
                    486: 	&hterror301("$address/")
                    487: 		if ($address !~ m#/$# && -d $raddress);
                    488: 	$raddress = "${raddress}index.html" if (-d $raddress);
                    489: 	if(!sysopen(S, $raddress, 0)) { &hterror404; } else {
                    490: 		if (-x $raddress) {
                    491: 			$currentcode = 100;
                    492: 			&log;
                    493: 			if (!$<) {
                    494: 				($x,$x,$x,$x,$uid,$gid) = stat(S);
                    495: 				(!$uid || !$gid) &&
                    496: 					die "executable is root-owned";
                    497: 				$> = $uid || die "can't set effuid";
                    498: 				$) = $gid || die "can't set effgid";
                    499: 			}
                    500: 			($hostname, $port, $ip) = &sock_to_host() if (!$port);
                    501: 			$ENV{'REQUEST_METHOD'} = $method;
                    502: 			$ENV{'SERVER_NAME'} = "localhost";
                    503: 			$ENV{'SERVER_PROTOCOL'} = "HTTP/$httpver";
                    504: 			$ENV{'SERVER_SOFTWARE'} = "HTTPi/$VERSION";
1.6       albertel  505: 			$ENV{'SERVER_PORT'} = "$port_to_use";
                    506: 			$ENV{'SERVER_URL'} = "http://localhost:$port_to_use/";
1.3       www       507: 			$ENV{'SCRIPT_FILENAME'} = $raddress;
                    508: 			$ENV{'SCRIPT_NAME'} = $address;
                    509: 			$ENV{'REMOTE_HOST'} = $hostname;
                    510: 			$ENV{'REMOTE_ADDR'} = $ip;
                    511: 			$ENV{'REMOTE_PORT'} = $port;
                    512: 			$ENV{'QUERY_STRING'} = $variables;
                    513: 			$ENV{'HTTP_USER_AGENT'} = $httpua;
                    514: 			$ENV{'HTTP_REFERER'} = $httpref;
                    515: 			if ($pid = fork()) { exit; } else {
                    516: 				if ($method eq 'POST') { # needs stdin
                    517: 					open(W, "|$raddress") || die
                    518: 						"can't POST to $raddress";
                    519: 					read(STDIN, $buf, $httpcl);
                    520: 					print W $buf;
                    521: 					exit;
                    522: 				}
                    523: 				exec "$raddress", "$variables";
                    524: 				die "exec() returned -1";
                    525: 			}
                    526: 		}
                    527: 		($x,$x,$x,$x,$x,$x,$x,$length,$x,$mtime) = stat(S);
                    528: 		$ctype = 0;
                    529: 		foreach(keys %content_types) {
                    530: 			if ($raddress =~ /\.$_$/i) {
                    531: 				$ctype = $content_types{$_};
                    532: 			}
                    533: 		}
                    534: SERVEIT:	$ctype ||= 'text/plain';
                    535: 		&htsponse(200, "OK");
                    536: 		$mtime = scalar gmtime $mtime;
                    537: 		($dow, $mon, $dt, $tm, $yr) =
                    538: 			($mtime =~ m/(...) (...) (..) (..:..:..) (....)/);
                    539: 		$dt += 0; $yr += 0;
                    540: 		&hthead("Last-Modified: $dow, $dt $mon $yr $tm GMT");
                    541: 		if ($pid = fork()) { exit; }
                    542: 		if ($virt_buffer) {
                    543: 			&htcontent($virtual_files{$address}->[2],
                    544: 				$virtual_files{$address}->[0], 0);
                    545: 		} else {
                    546: 			&htcontent("", $ctype, $length);
                    547: 			unless ($method eq 'HEAD') {
                    548: 				while(!eof(S)) {
                    549: 					read(S, $q, 16384);
                    550: 					print stdout $q;
                    551: 				}
                    552: 			}
                    553: 		}
                    554: 		alarm 0;
                    555: 	}
                    556: 	&log;
                    557: 	exit;
                    558: }
1.1       www       559: 
1.3       www       560: exit;
                    561: }
                    562: 
                    563: 
                    564: sub hterror {
                    565: 	local($errstr, $expl) = (@_);
                    566: 	&htcontent(<<"EOF", "text/html");
                    567: <html>
                    568: <body>
                    569: <h1>$errstr</h1>
                    570: $expl
                    571: <hr>
                    572: <address><a href = "http://httpi.floodgap.com/">httpi/$VERSION</a>
                    573: by Cameron Kaiser</address>
                    574: </body>
                    575: </html>
                    576: EOF
                    577: 	}
                    578: 
                    579: sub hterror404 {
                    580: 	&htsponse(404, "File Not Found");
                    581: 	&hterror("File Not Found",
                    582: 		"The resource $address was not found on this system.");
                    583: }
                    584: 
                    585: sub hterror301 {
                    586: 	&htsponse(301, "Moved Permanently");
                    587: 	&hthead("Location: @_");
                    588: 	&hterror("Resource Moved Permanently",
                    589: 		"This resource has moved <a href = \"@_\">here</a>.");
                    590: 	$keep = 0; &log; exit;
                    591: }
1.1       www       592: 
                    593: for (;;) {
1.3       www       594: 	$addr=accept(NS,S);
                    595: 	$statiosltr = scalar localtime;
                    596: 	$statiosreq++;
                    597: 	if ($pid = fork()) {
1.5       albertel  598: 		$0 = "lonhttpd: (dhttpi) waiting for child process";
1.3       www       599: 		waitpid($pid, 0);
1.6       albertel  600: 		$0 = "lonhttpd: (dhttpi) on ANY:$port_to_use, last request " .
1.3       www       601: 			scalar localtime;
                    602: 	} else {
1.5       albertel  603: 		$0 = "lonhttpd: (dhttpi) child switching to socket";
1.3       www       604: 		open(STDIN, "<&NS");
                    605: 		open(STDOUT, ">&NS");
                    606: 		&master;
                    607: 		exit;
                    608: 	}
1.1       www       609: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>