#! perl # # Put the full path to perl5.002 on the first line, or a symbolic link to perl in # the startup directory. # # CGIservlet: # A HTTPd "connector" for running CGI scripts on unix systems as WWW # accessible Web sites. The servlet starts a true HTTP daemon that channels # HTTP requests to forked daughter processes. CGIservlet.pl is NOT a # full fledged server. Moreover, this servlet is definitely NOT intended # as a replacement of a real server (e.g., Apache). It's design goal was # SIMPLICITY, and not mileage. # # Note that a HTTP server can be accessed on your local machine WITHOUT # internet access (but WITH a DNS?): # use "http://localhost[:port]/[path]" or "http://127.0.0.1[:port]/[path]" # as the URL. It is also easy to restrict access to the servlet to localhost # users (i.e., the computer running the servlet). # # Suggested uses: # - A testbed for CGI-scripts and document-trees outside the primary server. # When developing new scripts and services, you don't want to mess up your # current Web-site. CGIservlet is an easy way to start a temporary (private) # server. CGIservlet allows to test separate HTTP server components, e.g., # user authentication, in isolation. # # - A special purpose temporary server. # We run identification and other experiments over the inter-/intra-net using # CGI-scripts. This means a lot of development and changes and only a little # actual run-time. The people doing this do not want "scripting" access to our # departmental server with all its restrictions and security. So we need a # small, lightweigth, easy-to-configure server that can be run by each # investigator on her own account (and risk). # # - Interactive WWW presentations. # Not everyone is content with the features of "standard" office presentation # software. HTML and its associated browsers are an alternative (especially # under Linux). However, you need a server to realize the full interactive # nature of the WWW. CGIservlet with the necessary scripts can be run from # a floppie (a Web server in 100 kB). With the "localhost" or "127.0.0.1" id # in your browser you can use it standalone. # # When the servlet is started with the -r option, only requests from "localhost" # or "127.0.0.1" are accepted (default) or from addresses indicated after the # -r switch. # # Running demo's and more information can be found at # http://www.fon.hum.uva.nl/~rob/OSS/OSS.html # # # # Inner workings: # Whenever an HTTP request is received, the specified CGI script is # started inside a child process as if it was inside a real server (e.g., # Apache). The evironment variables are set more or less as in Apache. # Note that CGIservlet only uses a SINGLE script for ALL requests. # No attemps for security are made, it is the script's responsibility to # check access rights and the validity of the request. # # Author: Rob van Son # email: # rob@fon.hum.uva.nl (temporary) # Rob.van.Son@hum.uva.nl (future) # rob.van.son@workmail.com (more private) # mail: # Institute of Phonetic Sciences # University of Amsterdam # Herengracht 338 # NL-1016CG Amsterdam # The Netherlands # tel +31 205252183 # fax +31 205252197 # # copying freely from the mhttpd server by Jerry LeVan (levan@eagle.eku.edu) # Date: May 18, 1999 # Version: 1.0 # Env: Perl 5.002 # # Use: CGIservlet.pl - 2>pid.log & (sh) # CGIservlet.pl - >&pid.log & (csh) # # The servlet prints out pid and port number on STDERR. It is # adviced to store these in a separate file (this will become the # error log). # # Stop: sh pid.log (kills the server process) # # The first line in the file that receives STDERR output is a command # to stop CGIservlet. # # examples: # CGIservlet.pl -p 2345 -d /cgi-bin/CGIscriptor.pl -t /WWW 2>pid.log & # CGIservlet.pl -p 8080 -b 'require "CGIscriptor.pl";' -t $PWD -e \ # 'Handle_Request();' 2>pid.log & # # The following example settings implement a static WWW server using 'cat': # -p 8008 # -t `pwd` # -b '' # -e # '$ENV{QUERY_STRING}="";$ENV{PATH_INFO}=~/\.([\w]+)$/; "Content-type: ".$mimeType{uc($1)}."\n\n";' # -d 'cat -u -s' # -w '/index.html' # -c 32 # -l 512 # # This is identical to the behaviour of CGIservlet when -e '' -d '' -x '' is used. # The CGIservlet command should be run from the intended server-root directory. # # Another setting will use a package 'CGIscriptor.pl' with a function # 'HandleRequest()' to implement an interactive WWW server: # -p 8080 # -t `pwd` # -b 'require "CGIscriptor.pl";' # -e 'HandleRequest();' # -d '' # -w '/index.html' # -c 32 # -l 32767 # # Look below or in the readme.txt file for the current default settings. # # # ############################################################################### # # There are many switches to tailor the workings of CGIservlet.pl. # Some are fairly esoteric and you should only look for them if you # need something special urgently. When building a Web site, # the specific options you need will "suggest" themselves (e.g., port # number, script, or server-root directory). Most default settings # should work fine. # # In any case, it is best to change the default settings instead of # using the option switches. All defaults are put in a single block. # # switches and arguments: # Realy important # -p[ort] port number # For example -p 2345 # Obviously the port CGIservlet listenes to. Suggested Default: -p 8008 # # Script related # -b[egin] perl commands # For example -b 'require "CGIscriptor.pl";' or # 'require "/WWW/cgi-bin/XMLelement.pl";' # Perl commands evaluated at startup # # -d[o] perl script file # For example -d '/WWW/cgi-bin/CGIscriptor.pl' # The actual CGI-script started as a perl {do "scriptfile"} command. # The PATH_INFO and the QUERY are pushed on @ARGV. # # -x shell command # -qx shell command # -exec shell command # OS shell script or command, e.g., -x 'CGIscriptor.pl' or # -x '/WWW/cgi-bin/my-script' # The actual CGI-script started as `my-script \'$Path\' \'$QueryString\'`. # -qx and -exec[ute] are aliases of -x. For secutiry reasons, Paths or # queries containing '-quotes are rejected. # # -e[val] perl commands # For example -e 'Handle_Request();' # The argument is evaluated as perl code. The actual CGI-script # can be loaded once with -b 'require module.pm' and you only have to # call the central function(s). # # WWW-tree related # -t[extroot] path # For example -t "$PWD" or -t "/WWW/documents" # The root of the server hierachy. Defaults to the working directory # at startup time (`pwd`) # # -w[elcome] filepath # For example -w "/index.html" (default) # The default welcome page used when no path is entered. Note that # this path can point to anything (or nothing real at all). # # Security related # The following arguments supply some rudimentary security. It is the # responsibility of the script to ensure that the requests are indeed # "legal". # # -c[hildren] maximum child processes # For example -c 32 # The maximum number of subprocesses started. If there are more requests, # the oldest requests are "killed". This should take care of "zombie" # processes and server overloading. Note that new requests will be # serviced irrespective of the success of killing it's older siblings. # # -l[ength] maximum length of request in bytes # For example -l 32768 # This prevents overloading the server with enormous queries. Reading of # requests simply stops when this limit is reached. This does NOT affect # POST requests. # # -r[estrict] [Remote-address [Remote-host]] # For example -r 127.0.0.1 (default of -r) # A space separated list of client IP addresses and/or domain names that # should be serviced. Default, i.e., '-r' without any addresses or domain # names, is the localhost IP address '127.0.0.1'. # When using CGIservlet for local purposes only (e.g., development or a # presentation), it would be unsafe to allow others to access the servlet. # If -r is used (or the corresponding @RemoteAddr or @RemoteHost lists are # filled in the code below), all requests from clients whose Remote-address # or Remote-host do not match the indicated addresses will be rejected. # Partial addresses and domain names are allowed. Matching is done according # to Remote-addr =~ /^\Q$pattern\E/ (front to back) and # Remote-host =~ /\Q$pattern\E$/ (back to front) # # Speedup # -n[oname] # No arguments. # Retrieving the domain name of the Client (i.e., Remote-host) is a # very slow process and normally useless. To skip it, enter this # option. Note that you cannot use '-r Remote-host' anymore after # you enter -n, only IP addresses will work. # # remarks: # All of the arguments of -d, -e, and -x are processed sequentially # in this order. This might not be what you want so you should be # carefull when using multiple executable arguments. # If none of the executable arguments is DEFINED (i.e., they are entered # as -d '' -e '' -x ''), each request is treated as a simple # text-retrieval. THIS CAN BE A SECURITY RISK! # # (The wiring of an interactive web-server, which also calls shell # scripts, is in place. If you cannot find the relevant switches # yourself, this might be a bad idea to try. The security risks # involved are considerable.) # ################################################################################ # # # LICENCE # # # # This program is free software; you can redistribute it and/or # # modify it under the terms of the GNU General Public License # # as published by the Free Software Foundation; either version 2 # # of the License, or (at your option) any later version. # # # # This program is distributed in the hope that it will be useful, # # but WITHOUT ANY WARRANTY; without even the implied warranty of # # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # # GNU General Public License for more details. # # # # You should have received a copy of the GNU General Public License # # along with this program; if not, write to the Free Software # # Foundation, Inc., 59 Temple Place - Suite 330, # # Boston, MA 02111-1307, USA. # # # ################################################################################ # # Note: CGIservlet.pl was directly inspired by Jerry LeVan's # (levan@eagle.eku.edu) simple mhttpd server which again was # inspired by work of others. CGIservlet is used as a bare bones # socket server for a single CGI script at a time. # # require 5.002; use strict; # Should realy be used! use Socket; use Carp; # could come in handy (can be missed, I think) my $version = "1.0"; my $program = "CGIservlet.pl"; ################################################################## # # # print some information to STDERR, e.g., the process number # # # ################################################################## sub logmsg { print STDERR "kill -KILL $$;exit;\n", # Stop CGIservlet "$0 $$: @_ at ", scalar localtime, "\n" } ############################################################ # # # Parse arguments (you can define DEFAULT VALUES here) # # # ############################################################ my $port = 8008; # The port number my $textroot = $ENV{'PWD'} || `pwd`; # current working directory chomp($textroot); # Remove nasty newline, if present my $doarg = ''; # do "filename", my $beginarg = ''; # eval($Argument) at the start of the program my $evalarg = '$ENV{QUERY_STRING}="";$ENV{PATH_INFO}=~/\.([\w]+)$/; "Content-type: ".$mimeType{uc($1)}."\n\n";'; # eval($Argument) for each request my $execarg = 'cat -u -s'; # `command \'$textroot$Path\' \'$QueryString\'` my $welcome = '/index.html'; # Default path # Rudimentary security, overflow detection my $MaxBrood = 32; # Maximum number of running children my $MaxLength = 512; # Maximum Request Length # If one of the following lists contains any client addresses or names, all others are # blocked (be carefull, your site will be unaccessible if you misspell them). my @RemoteHost = (); # Accepted Hosts, suggest: localhost my @RemoteAddr = (); # Accepted IP addresses, suggest: @RemoteAddr=('127.0.0.1') my $DefaultRemoteAddr = '127.0.0.1'; # default, use localhost IP address my $NONAME = 0; # if 1, do NOT ask for REMOTE_HOST (faster) ###################################### # # # process arguments and defaults # # # ###################################### while ($_ = shift(@ARGV)) { # With switches if(/\-p/is) # Port { $port = shift(@ARGV); } elsif(/\-d/is) # Do { $doarg = shift(@ARGV); } elsif(/\-(x|qx|exec)/is) # Execute { $execarg = shift(@ARGV); } elsif(/\-b/is) # Begin { $beginarg = shift(@ARGV); } elsif(/\-e/is) # Evaluate { $evalarg = shift(@ARGV); } elsif(/\-t/is) # Textroot { $textroot = shift(@ARGV); } elsif(/\-w/is) # Default welcome page { $welcome = shift(@ARGV); } elsif(/\-c/is) # Maximum Children { $MaxBrood = shift(@ARGV) || $MaxBrood; } elsif(/\-l/is) # Maximum Length { $MaxLength = shift(@ARGV) || $MaxLength; } elsif(/\-r/is) # Remote host or address { while(@ARGV && $ARGV[0] !~ /^\-/) # while not a parameter { my $Remote = shift(@ARGV); if($Remote =~ /[\d\.]+/) # A host IP address { push(@RemoteAddr, $Remote); } else # A host domain name, less secure { push(@RemoteHost, $Remote); }; }; # # Use the default Remote Host (Client) IP address (e.g., localhost) # if no addresses or domain names are entered. push(@RemoteAddr, $DefaultRemoteAddr) unless @RemoteAddr || @RemoteHost; } elsif(/\-n/is) # Do NOT extract Remote host { $NONAME = 1; } else # perform unreliable magick without switches { if(/^[0-9]+$/ && $_ > 1024) # A (large) number must be a port { $port = $_; } elsif(-T && /\.pl$/) # Text file with extension .pl/m is a Perl file { $doarg = $_; } elsif(-T && /\.pm$/) # Text file with extension .pm is a Perl module file { $beginarg = $_; } elsif(-x) # Executables can be executed { $execarg = $_; } elsif(-d) # A directory can only be the root { $textroot = $_; } elsif(-T && /^\// && /\.html$/) # An html file path is the default path { $welcome = $_; } elsif(-T) # A text file is something to do { $doarg = $_; } elsif(/[\s\{\`\[\@\%]/) # I give up, just try it { $evalarg = shift(@ARGV); }; }; }; ################################################ # # # All argument values are known. # # Initialize environment variables. # # (should be accessible to eval($beginarg)) # # # ################################################ # # Initialize %ENV $ENV{'SERVER_SOFTWARE'} = "$program $version"; $ENV{'GATEWAY_INTERFACE'} = "CGI/1.1"; $ENV{'SERVER_PORT'} = "$port"; $ENV{'CGI_HOME'} = $textroot; $ENV{'SERVER_ROOT'} = $textroot; # Server Root Directory $ENV{'SCRIPT_NAME'} = $doarg.$execarg.$evalarg; # Combine executable arguments ################################################ # # # The initial argument should be evaluated # # # ################################################ eval($beginarg) if $beginarg; # # Socket related code my $proto = getprotobyname('tcp'); $port = $1 if $port =~ /(\d+)/; # untaint port number socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!"; bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; listen(Server,SOMAXCONN) || die "listen: $!"; # # Report start of server logmsg "server started on port $port"; # Set up SIG vector (every signal will kill the process that receives it) $SIG{CHLD} = 'IGNORE'; $SIG{'KILL'} = "SigHandler"; $SIG{'TERM'} = "SigHandler"; $SIG{'QUIT'} = "SigHandler"; $SIG{'HUP'} = "SigHandler"; # Define text mime types served if no scripts are defined # Note that the "text/osshell" mime-type is executed by CGIservlet ITSELF! my %mimeType = ( 'HTML'=> "text/html", 'TXT' => "text/plain", 'PL' => "text/plain", # This is incorrect, of course 'JPG' => "image/jpeg", 'JPEG' => "image/jpeg", 'GIF' => "image/gif", 'AU' => "audio/basic", 'AIF' => "audio/aiff", 'AIFC' => "audio/aiff", 'AIFF' => "audio/aiff", 'GZ' => "application/gzip", # 'SH' => "text/osshell", # Executes SERVER side shell scripts, HIGHLY DANGEROUS # 'CSH' => "text/osshell", # Executes SERVER side shell scripts, HIGHLY DANGEROUS # 'BSH' => "text/osshell", # Executes SERVER side shell scripts, HIGHLY DANGEROUS 'WAV' => "audio/wav" ); # Map HTTP request parameters to Environment variables # HTTP request => Environment variable my %HTTPtype = ( 'Content-length' => 'CONTENT_LENGTH', # Necessary for POST 'User-agent' => 'HTTP_USER_AGENT', 'Accept' => 'HTTP_ACCEPT', 'Content-type' => 'CONTENT_TYPE', 'Auth-type' => 'AUTH_TYPE', 'Ident' => 'REMOTE_IDENT', 'Referer' => 'HTTP_REFERER', 'User' => 'REMOTE_USER', 'Connection' => 'HTTP_CONNECTION', 'Accept-Language' => 'HTTP_ACCEPT_LANGUAGE', 'Accept-Encoding' => 'HTTP_ACCEPT_ENCODING', 'Accept-Charset' => 'HTTP_ACCEPT_CHARSET', 'Host' => 'HTTP_HOST' ); ############################################################################### # # # Now we start with the real work. When there is a request, get the required # # values and fork a child to service it. # # # ############################################################################### my @brood = (); my $child; # When someone knocks on the door for (;;) { my $paddr; if(!($paddr = accept(Client,Server)) ) # Knock knock { exit 1; # This went terrribly wrong }; # Fork to child and parent if(($child =fork()) == 0) { # this is the child my ($port,$iaddr) = sockaddr_in($paddr); my $address = inet_ntoa($iaddr); # The IP address of the Client # The following is EXTREMELY slow and generally unnecessary. # Use -n or set $NONAME = 1; if you don't need it. my $name = $NONAME ? '' : gethostbyaddr($iaddr,AF_INET); my @Input = (); # # Before doing anything else, check whether the client should be # served at all. # Is IP addr on the list? if(@RemoteAddr && !grep(/^\Q$address\E/, @RemoteAddr)) { print STDERR "Reject $address $name\n"; exit 1; }; # Is name on the list? if(@RemoteHost && !grep(/\Q$name\E$/, @RemoteHost)) { print STDERR "Reject $name $address\n"; exit 1; }; # # Grab a line without using buffered input... Important for # Post methods since they have to read the Client input stream. # my $string = ""; my $ch = ""; my $length = 0; alarm 120 ; # prevent deadly spin if other end goes away while(sysread(Client, $ch, 1)>0) { $string .= $ch; ++$length; last if $length > $MaxLength; # Protect against overflow next if $ch eq "\r"; # skip if($ch eq "\n") { last unless $string =~ /\S/; # stop if empty line push (@Input, split(' ', $string)); # Collect input in list $string = ""; }; }; alarm 0; # clear alarm # Extract input arguments my $method = shift(@Input); my $Request = shift(@Input); my $protocol = shift(@Input); my ($Path, $QueryString) = split('\?', $Request); # Get rest of Input my $HTTPparameter; my %HTTPtable = (); while($HTTPparameter = shift(@Input)) { chop($HTTPparameter); $HTTPtable{$HTTPparameter} = ""; while(@Input && $Input[0] !~ /\:$/) { $HTTPtable{$HTTPparameter} .= " " if $HTTPtable{$HTTPparameter}; $HTTPtable{$HTTPparameter} .= shift(@Input); }; }; # HTTP servers should always add the default path $Path = $welcome if !$Path || $Path eq '/'; # The common default path # Set fixed environment variables $ENV{'PATH_INFO'} = "$Path"; $ENV{'QUERY_STRING'} = "$QueryString"; $ENV{'PATH_TRANSLATED'} = "$textroot$Path"; $ENV{'SERVER_PROTOCOL'} = "$protocol"; $ENV{'REQUEST_METHOD'} = "$method"; $ENV{'REMOTE_ADDR'} = "$address"; # The IP address of the Client $ENV{'REMOTE_HOST'} = "$name"; # Load all request information in the %ENV. # Must be done with a pre-defined list of parameter names. foreach $HTTPparameter (keys(%HTTPtype)) { my $Label = $HTTPtype{$HTTPparameter}; # The following adds environment variables FROM THE REQUEST. # It is a VERY bad idea to just use the client supplied parameter names! $ENV{$Label} = $HTTPtable{$HTTPparameter} unless exists($ENV{$Label}); }; # # Connect STDOUT and STDIN to the client open(STDIN, "<&Client"); open(STDOUT, ">&Client"); print STDOUT "HTTP/1.0 200 OK\n"; # Supply HTTP protocol information # Start processing of request (note that ALL scripts will be executed if # present, i.e., if -d, -x, and -e are entered, they are alle processed). # do perl script @ARGV = ("$textroot$Path", $QueryString); do "$doarg" if $doarg; # The perl script should do the printing # evaluate perl command print STDOUT eval($evalarg) if $evalarg; # execute shell command if($execarg) { my $shellscript = $execarg; # Attempts to use Paths or Queries containing '-quotes are rejected. # Executing these would compromise security. die "Quotes in path: $textroot$Path\n" if "$textroot$Path" =~ /\'/; $shellscript .= " '$textroot$Path'" if $Path; die "Quotes in query: $QueryString\n" if $QueryString =~ /\'/; $shellscript .= " '$QueryString'" if $QueryString; $shellscript = qx{$shellscript}; print STDOUT $shellscript; }; # Output text files if no scripts are given (actually, this should be # handled by a script). Unknown mimetypes are killed. # This is more or less a functional Web server in itself. unless($doarg || $execarg || $evalarg) # Request not already handled { die ".. trick: $address $name $Path $QueryString\n" if $Path =~ m@\.\./@ ; # No tricks! $Path =~ /\.([\w]+)$/; # Get extension my $extension = uc($1); my $mime = $mimeType{$extension} || exit 0; # illegal mime's are killed # Print out the document if($mime eq 'text/osshell') # Don't use this unless you know what you'r doing { # If you want to execute server side shell scripts, use the 'text/osshell' # mime-type (see above) but remember that there is NO SECURITY implemented # whatsoever. # print STDOUT `$textroot$Path`; # This is Russian Roulette } elsif($mime) { # Content-type and document print STDOUT "Content-type: $mime\n\n"; print STDOUT `cat '$textroot$Path'` # lazy, let the OS do the work }; }; close(STDOUT); close(STDIN); # exit 0; # Kill Child } else { # # parent code...some systems will have to worry about waiting # before they can actually close the link to the Client # Determine which of the children are actually still alive my @old_brood = @brood; @brood = (); # empty brood foreach (@old_brood) { push(@brood, $_) if kill (0, $_); }; # Weed out overflow of children (zombies etc.) my $oldest; for($oldest=0; $oldest < scalar(@brood)-$MaxBrood; ++$oldest) { kill "KILL", $brood[$oldest] if $brood[$oldest]; }; # Push new child on the list push (@brood, $child); close Client; }; }; # Interupt handler for shutting down sub SigHandler { my $sig = shift; exit 1; } =head1 NAME CGIservlet - a HTTPd "connector" for running CGI scripts on unix systems as WWW accessible Web sites. =head1 DESCRIPTION The servlet starts a true HTTP daemon that channels HTTP requests to forked daughter processes. =head1 README Whenever an HTTP request is received, the specified CGI script is started inside a child process as if it was inside a real server (e.g., Apache). The evironment variables are set more or less as in Apache. Note that CGIservlet only uses a SINGLE script for ALL requests. No attemps for security are made, it is the script's responsibility to check access rights and the validity of the request. =head1 PREREQUISITES This script requires the C, Socket and Carp modules. =head1 COREQUISITES =pod OSNAMES Unix =pod SCRIPT CATEGORIES CGI Web =cut