File:  [LON-CAPA] / loncom / lonhttpd
Revision 1.3: download - view: text, annotated - select for diffs
Wed Oct 30 14:25:33 2002 UTC (21 years, 6 months ago) by www
Branches: MAIN
CVS tags: HEAD
Use httpi instead of thttpd

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

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