Return to lonhttpd CVS log

Up to [LON-CAPA] / loncom

Annotation of loncom/lonhttpd, revision 1.2

1.1       www         1: #!/usr/bin/perl
                      2: # The LearningOnline Network with CAPA
                      3: # lonhttpd server (port 8080)
                      4: # based on
                      5: # TinyHTTPD - a minimum-functional HTTP server written in -*- Perl -*-
                      6: # -ot.0894
1.2     ! www         7: # $Id: lonhttpd,v 1.1 2002/10/29 20:21:32 www Exp $
1.1       www         8: 
                      9: # Currently supported: HTTP 1.0/1.1 GET and POST queries
                     10: # File types of .html and .gif
                     11: 
1.2     ! www        12: $ENV{'SERVER_SOFTWARE'}="TinyHTTPD $Revision: 1.1 $ -ot.0894 (LON-CAPA)";
1.1       www        13: 
                     14: 
                     15: use POSIX;
                     16: 
                     17: $pid=fork;
                     18: exit if $pid;
                     19: die "Could not fork: $!" unless defined($pid);
                     20: POSIX::setsid() or die "Can't start new session: $!";
                     21: open (PIDSAVE,">/home/httpd/perl/logs/lonhttpd.pid");
                     22: print PIDSAVE "$$\n";
                     23: close(PIDSAVE);
                     24: 
                     25: sub REAPER {
                     26:     1 until (-1==waitpid(-1,WNOHANG));
                     27:     $SIG{CHLD}=\&REAPER;
                     28: }
                     29: 
                     30: $SIG{CHLD}=\&REAPER;
                     31: 
                     32: ## Configuration section
                     33: $port=8080;			# Port on which we listen
                     34: $htmldir="/home/httpd/html/";	# Base directory for HTML files
                     35: 
                     36: # the following substitutes "require 'sys/socket.ph';" on ultrix
                     37: # Check if the definitions are correct with /usr/include/sys/socket.h
                     38: $AF_INET=2; $PF_INET=$AF_INET; $SOCK_STREAM=1;
                     39: 
                     40: # Messages
                     41: %errors=
                     42:     (
                     43:      "403", "Forbidden",
                     44:      "404", "Not Found",
                     45:      "500", "Internal Error",
                     46:      "501", "Not Implemented",
                     47:      );
                     48: %verrors=
                     49:     (
                     50:      "403", "Your client is not allowed to request this item",
                     51:      "404", "The requested item was not found on this server",
                     52:      "500", "An error occurred while trying to retrieve item",
                     53:      "501", "This server does not support the given request type",
                     54:      );
                     55: 
                     56: (($>)&&($<==$>)&&($(==$))) || die "Don't run this program with privileges!\n";
                     57: 
                     58: # set up a server socket, redirect stderr to logfile
                     59: $IPPROTO_TCP=6;
                     60: $sockaddr = 'S n a4 x8';
                     61: $this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");
                     62: socket(S, $PF_INET, $SOCK_STREAM, $IPPROTO_TCP) || die "socket: $!";
                     63: bind(S, $this) || die "bind: $!";
                     64: listen(S, 5) || die "listen: $!";
                     65: open(LOG,">>/home/httpd/perl/logs/lonhttpd.log");
                     66: select(LOG); $|=1;
                     67: open(STDERR, ">&LOG") || die "dup2 log->stderr";
                     68: 
                     69: # accept incoming calls
                     70: for (;;) {
                     71:     ($addr=accept(NS,S)) || die "accept: $!";
                     72:     next if $pid=fork;
                     73:     die "fork: $!" unless defined $pid;
                     74:     close(S);
                     75:     ($a,$p,$inetaddr) = unpack($sockaddr, $addr);
                     76:     @inetaddr = unpack('C4', $inetaddr);
                     77:     ($host,$aliases) = gethostbyaddr($inetaddr, $AF_INET);
                     78:     $inetaddr = join(".", @inetaddr);
                     79:     @host=split(' ', "$host $aliases");
                     80:     $host || do { $host = $inetaddr; };
                     81:     @t=localtime;
                     82:     open(STDIN, "+<&NS") || die "dup2 ns->stdin";
                     83:     open(STDOUT, "+>&NS") || die "dup2 ns->stdout";
                     84:     select(STDOUT); $|=1;
                     85:     &serve_request;
                     86:     close(STDIN); close(STDOUT);
                     87:     exit;
                     88: }
                     89: 
                     90: # Read request from stdin and produce output
                     91: sub serve_request {
                     92: 
                     93:     # Analyze HTTP input.
                     94:     $_=<STDIN>;
                     95:     ($method, $url, $proto) = split;
                     96:     if ($proto) {
                     97: 	while (<STDIN>) { 
                     98: 	    s/\n|\r//g; # kill CR and NL chars
                     99: 	    /^Content-Length: (\S*)/i && ($content_length=$1);
                    100: 	    /^Content-Type: (\S*)/i && ($content_type=$1);
                    101: 	    length || last; # empty line - end of header
                    102: 	}
                    103:     } else {
                    104: 	$proto="HTTP/0.9";
                    105:     }
                    106:     ($method=~/^(GET|POST)$/) || do { &error(501,$method); return; };
                    107: 
                    108:     # prevent directory go-back
                    109:     $url=~/\.\./ && do { &error(403,$url,"contains go-back"); return; };
1.2     ! www       110: 
        !           111:    # Multiple slashes do happen 
        !           112:    $url=~s/\/+/\//g;
1.1       www       113: 
                    114:     # Check access control
                    115:     unless (($url=~/^\/res\/adm\//) || ($url=~/^\/adm\//)) {
                    116:         do { &error(403,$url,"not on allow list"); return; };
                    117:     }
                    118:     print LOG "$$: $url\n";
                    119: 
                    120: # Get and return file
                    121: 
                    122: 	$file="$htmldir$url";
                    123: 	(-r "$file") || do { &error(404,$url); return; };
                    124: 	# output the file
                    125: 	print "HTTP/1.0 200 OK\nMIME-Version: 1.0\nContent-Type: ";
                    126:         CASE:	
                    127: 	{
                    128: 	    $url=~/\.html$/ && do { print "text/html\n\n"; last CASE; };
                    129: 	    $url=~/\.gif$/ && do { print "image/gif\n\n"; last CASE; };
                    130: 	    print "text/plain\n\n";
                    131: 	}
                    132: 	system("cat $file");
                    133: }
                    134: 
                    135: sub error {
                    136:     # generate error response
                    137:     local($errno) = @_[0];
                    138:     local($errmsg) = "$errno $errors{$errno}";
                    139:     print LOG "$$ $errmsg (@_[1,2])\n";
                    140:     print <<TheEnd;
                    141: HTTP/1.0 $errmsg
                    142: MIME-version: 1.0
                    143: Content-type: text/html
                    144: 
                    145: <HTML>
                    146: <HEAD><TITLE>$errmsg</TITLE></HEAD>
                    147: <BODY><H1>$errmsg</H1>
                    148: $verrors{$errno}: <PRE> @_[1] </PRE>
                    149: <HR>
                    150: <ADDRESS><A HREF="http://www.lon-capa.org/">
                    151: $ENV{'SERVER_SOFTWARE'} by Olaf Titz, modified by LON-CAPA</A></ADDRESS>
                    152: </BODY>
                    153: </HTML>
                    154: TheEnd
                    155: }