#!/usr/bin/perl # The LearningOnline Network with CAPA # lonhttpd server (port 8080) # based on # TinyHTTPD - a minimum-functional HTTP server written in -*- Perl -*- # -ot.0894 # $Id: lonhttpd,v 1.1 2002/10/29 20:21:32 www Exp $ # Currently supported: HTTP 1.0/1.1 GET and POST queries # File types of .html and .gif $ENV{'SERVER_SOFTWARE'}="TinyHTTPD $Revision: 1.1 $ -ot.0894 (LON-CAPA)"; use POSIX; $pid=fork; exit if $pid; die "Could not fork: $!" unless defined($pid); POSIX::setsid() or die "Can't start new session: $!"; open (PIDSAVE,">/home/httpd/perl/logs/lonhttpd.pid"); print PIDSAVE "$$\n"; close(PIDSAVE); sub REAPER { 1 until (-1==waitpid(-1,WNOHANG)); $SIG{CHLD}=\&REAPER; } $SIG{CHLD}=\&REAPER; ## Configuration section $port=8080; # Port on which we listen $htmldir="/home/httpd/html/"; # Base directory for HTML files # the following substitutes "require 'sys/socket.ph';" on ultrix # Check if the definitions are correct with /usr/include/sys/socket.h $AF_INET=2; $PF_INET=$AF_INET; $SOCK_STREAM=1; # Messages %errors= ( "403", "Forbidden", "404", "Not Found", "500", "Internal Error", "501", "Not Implemented", ); %verrors= ( "403", "Your client is not allowed to request this item", "404", "The requested item was not found on this server", "500", "An error occurred while trying to retrieve item", "501", "This server does not support the given request type", ); (($>)&&($<==$>)&&($(==$))) || die "Don't run this program with privileges!\n"; # set up a server socket, redirect stderr to logfile $IPPROTO_TCP=6; $sockaddr = 'S n a4 x8'; $this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0"); socket(S, $PF_INET, $SOCK_STREAM, $IPPROTO_TCP) || die "socket: $!"; bind(S, $this) || die "bind: $!"; listen(S, 5) || die "listen: $!"; open(LOG,">>/home/httpd/perl/logs/lonhttpd.log"); select(LOG); $|=1; open(STDERR, ">&LOG") || die "dup2 log->stderr"; # accept incoming calls for (;;) { ($addr=accept(NS,S)) || die "accept: $!"; next if $pid=fork; die "fork: $!" unless defined $pid; close(S); ($a,$p,$inetaddr) = unpack($sockaddr, $addr); @inetaddr = unpack('C4', $inetaddr); ($host,$aliases) = gethostbyaddr($inetaddr, $AF_INET); $inetaddr = join(".", @inetaddr); @host=split(' ', "$host $aliases"); $host || do { $host = $inetaddr; }; @t=localtime; open(STDIN, "+<&NS") || die "dup2 ns->stdin"; open(STDOUT, "+>&NS") || die "dup2 ns->stdout"; select(STDOUT); $|=1; &serve_request; close(STDIN); close(STDOUT); exit; } # Read request from stdin and produce output sub serve_request { # Analyze HTTP input. $_=; ($method, $url, $proto) = split; if ($proto) { while () { s/\n|\r//g; # kill CR and NL chars /^Content-Length: (\S*)/i && ($content_length=$1); /^Content-Type: (\S*)/i && ($content_type=$1); length || last; # empty line - end of header } } else { $proto="HTTP/0.9"; } ($method=~/^(GET|POST)$/) || do { &error(501,$method); return; }; # prevent directory go-back $url=~/\.\./ && do { &error(403,$url,"contains go-back"); return; }; # Check access control unless (($url=~/^\/res\/adm\//) || ($url=~/^\/adm\//)) { do { &error(403,$url,"not on allow list"); return; }; } print LOG "$$: $url\n"; # Get and return file $file="$htmldir$url"; (-r "$file") || do { &error(404,$url); return; }; # output the file print "HTTP/1.0 200 OK\nMIME-Version: 1.0\nContent-Type: "; CASE: { $url=~/\.html$/ && do { print "text/html\n\n"; last CASE; }; $url=~/\.gif$/ && do { print "image/gif\n\n"; last CASE; }; print "text/plain\n\n"; } system("cat $file"); } sub error { # generate error response local($errno) = @_[0]; local($errmsg) = "$errno $errors{$errno}"; print LOG "$$ $errmsg (@_[1,2])\n"; print < $errmsg

$errmsg

$verrors{$errno}:

 @_[1]

$ENV{'SERVER_SOFTWARE'} by Olaf Titz, modified by LON-CAPA

TheEnd }