File:  [LON-CAPA] / loncom / lonhttpd
Revision 1.17: download - view: text, annotated - select for diffs
Thu Mar 11 16:34:48 2010 UTC (14 years ago) by droeschl
Branches: MAIN
CVS tags: language_hyphenation_merge, language_hyphenation, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse
In process of removing remote control, remote navmap and different icon modes code.
- graphics previously used on remote control.

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

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