#!/usr/bin/perl # MicroWeb - ein minimalistischer Webserver zu Lehrzwecken # (C) 2006 Veit Wahlich package MicroWeb; our $VERSION='1.0'; # Benoetigte Module und Pragmas importieren: use strict; # Wir programmieren stets strict use warnings; # und haetten gerne Warnmeldungen. use IO::Socket::INET; # Wir moechten IP-Sockets use IO::File; # und Dateien verwenden. use POSIX qw(strftime); # Fuer saubere Timestamps benutzen wir strftime(). # globale Variable, speichert die Anzahl der aktuell laufenden Kindprozesse my $children=0; # globale Konfiguration my $conf={ bind_address => '0.0.0.0', # IP-Adresse, an die wir binden. bind_port => 8080, # TCP-Port, an den wir binden. root => 'htdocs/default', # Basisverzeichnis der Dokumente. index_file => 'index.html', # Datei zu laden wenn nur ein # Verzeichnis angefragt wurde. max_connections => 10, # Max. Anzahl paralleler # Verbindungen (== Kindprozesse). max_url_length => 4096, # Max. Laenge einer URL in Bytes. max_headers_length => 4096, # Max. Groesse der Headers in Bytes. client_timeout => 5, # Max. Wartezeit fuer Empfang von # Anfragen. mime_types => { # Relationen Dateierweiterung zu # MIME-Typ. html => 'text/html', htm => 'text/html', txt => 'text/plain', css => 'text/css', xml => 'text/xml', xsl => 'text/xml', jpg => 'image/jpeg', jpeg => 'image/jpeg', png => 'image/png', gif => 'image/gif', mp3 => 'audio/mpeg', wav => 'audio/x-wav', mid => 'audio/midi', mpg => 'video/mpeg', mpeg => 'video/mpeg', avi => 'video/x-msvideo', ogg => 'application/ogg', js => 'application/x-javascript', swf => 'application/x-shockwave-flash', gz => 'application/x-gzip', tgz => 'application/x-gzip', bz2 => 'application/x-bzip2', tbz2 => 'application/x-bzip2', tar => 'application/x-tar', zip => 'application/zip', '*' => 'application/octet-stream' }, }; # Variablen wegen Verwendung in Signalhandlern in globalem Scope: my $socket; # Enthaelt spaeter den Listener. my $client; # Enthaelt spaeter das Filehandle des aktuellen Clients. sub main(){ my $pid; # Enthaelt spaeter die PID des Client-Kindprozesses. # Ein Signalhandler faengt SIGTERM und SIGINT ab: $SIG{TERM}=$SIG{INT}=sub{ # Listener sauber beenden: logError('Server received SIGTERM/SIGINT - exiting gracefully'); $socket->shutdown(2); $socket->close(); STDOUT->close(); STDERR->close(); exit(0); }; # Bei SIGCHLD wurde ein Kindprozess beendet und muss geerntet werden: $SIG{CHLD}=\&reapPid; # Listener anlegen... $socket=new IO::Socket::INET( Listen => 5, LocalAddr => $conf->{bind_address}, LocalPort => $conf->{bind_port}, Proto => 'tcp', Reuse => 1 ); # und auf Erfolg ueberpruefen. unless(defined($socket)){ die("Unable to bind port to address: $!\n"); } # Server-Endlosschleife betreten while(1){ # Auf neue Client-Verbindung warten und in $client speichern: $client=$socket->accept(); # Moderne Betriebssysteme geben ein $client==undef zurueck, wenn $socket # noch nicht wieder bereit ist - dann die Schleife von vorn beginnen: # *FIXME*: Hier sollte man eigentlich kurz warten, sonst 100% CPU-Last, # bis Socket wieder Verbindungen annimmt! next unless(defined($client)); # Nur neue Verbindungen verarbeiten, wenn nicht zu viele Verbindungen # aktiv sind: if($children < $conf->{max_connections}){ # Prozess duplizieren und PID speichern. $pid=fork(); # Wenn fork() erfolgreich ist, ist $pid definiert: if(defined($pid)){ # Und wenn $pid == 0 ist, sind wir gerade im Kindprozess - sonst sind # wir im Mutterprozess. if($pid == 0){ # Im Client-Kindprozess brauchen wir den Listener nicht. $socket->close(); # Signalhandler im Client sind anders als die im Server: $SIG{TERM}=$SIG{INT}=sub{ logError('Child '.$$ .' received SIGTERM/SIGINT - exiting gracefully'); exitChild(); }; # Uebergebe Verarbeitung der Verbindung an die Zulieferer-Funktion: processConnection($client); # Ist die Verbindung verarbeitet, kann die Client-Verbindung # geschlossen und der Prozess beendet werden: exitChild(); } # Wenn wir im Mutterprozess sind: else{ # Anzahl von Kindprozessen inkrementieren: $children++; # Im Mutterprozess benoetigen wir die Client-Verbindung nicht. $client->close(); } } # Wenn fork() fehlschlug, Meldung ausgeben: else{ logError('Unable to fork: '.$!); } } # Wenn die maximale Anzahl von Verbindungen ueberschritten wurde, geben # wir einfach eine Meldung an den Client, ohne die Verbindung wirklich zu # verarbeiten, und schliessen die Verbindung: else{ logError('Maximum count of children reached!'); sendError($client,503,'Service Unavailable', 'Too many concurrent connections. Please try again later.'); $client->shutdown(2); $client->close(); } } } # Verarbeite eine HTTP-Client-Verbindung: sub processConnection($){ my($client)=@_; my $getString; # Enthaelt spaeter den GET-Parameter-String. my $file; # Enthaelt spaeter den Pfad zur angeforderten Datei. my $host; # Enthaelt spaeter den Hostname (Host:-Header). # Definiere einen SIGALRM-Handler: $SIG{ALRM}=sub{ # Timeout-Meldung senden, Client-Verbindung etc. schliessen und # Kindprozess beenden: sendError($client,408,'Request Time-Out', 'The server did not receive a propper request within ' .$conf->{client_timeout}.' seconds.'); exitChild(); }; # Setze ein Timeout fuer den Empfang der Header vom Client: alarm($conf->{client_timeout}); # Erste Zeile der Anfrage enthaelt HTTP-Methode, -URL und -Version, # empfange und teile nur die ersten max_url_length+100 Bytes: my($method,$url,$version) =split(/ /,substr(readline($client),0,$conf->{max_url_length}+100),3); # Sende Nachricht und beende Verbindung, falls URL zu lang: if(length($url) > $conf->{max_url_length}){ sendError($client,414,'Request URL Too Long', 'The URL requested is longer than '.$conf->{max_url_length}.' bytes.'); exitChild(); } # Extrahiere GET-Parameter aus dem URL: ($url,$getString)=split(/\?/,$url,2); # Konvertiere URI-enkodierte Hex-Werte im URL fuer Pfad zu normalen Zeichen: $file=decodeUri($url); # Fahre nur fort, wenn URL ausschliesslich aus "sichere Zeichen" besteht # und mit / beginnt, ausserdem muessen double-dot-Attacken ausgeschlossen # sein: # *FIXME* Ansich sollte ein Server .. aufloesen koennen - das waere z.B. # durch s/\/.*?\/\.\.// moeglich, wird aber hier nicht implementiert um den # Code nicht zu komplex (und damit fehlertraechtig) zu machen. if(not($file=~/^\/[\/a-z0-9\.\_\- ]*$/i) || $file=~/\/\.\.(\/|$)/){ sendError($client,400,'Bad Request', 'The filename ('.$file.') requested contains bad characters.'); exitChild(); } # Ueberspringe uebermittelte HTTP-Headers (bis Leerzeile empfangen): getHeaders($client); # Setze Pfad zur angeforderten Datei im Root-Verzeichnis zusammen: $file=$conf->{root}.'/'.$file; # Setze Hostname auf gebundene IP-Adresse: $host=$conf->{bind_address}; # Entferne alle double slashes: $file=~s/\/\//\//g; # Wenn URL nicht auf / endet und ein Verzeichnis ist, leite den Client dort # hin weiter: if(not($url=~/\/$/) && -d $file){ logAccess($client->peerhost().' 302 '.$url.' => '.$url.'/'); sendHeader($client,302,'Found',{Location => $url.'/'}); sendStatus($client,302,'Found', 'This document is located at '.$url.''); exitChild(); } # Akzeptiere GET-Methode: if(uc($method) eq 'GET'){ serveFile($client,$file,$url,$host); } # Alle anderen HTTP-Methoden werden nicht unterstuetzt: else{ sendError($client,405,'Method Not Allowed', 'The method used in request is not allowed here.'); exitChild(); } } # Schicke die angeforderte Datei zum Client: sub serveFile($$$$){ my($client,$file,$url,$host)=@_; my $fh; # Enthaelt spaeter das Dateihandle. my $buffer; # Buffer fuer das Einlesen von Daten. my $fileExt; # Enthaelt spaeter die Dateierweiterung. my $mimeType; # Enthaelt spaeter den MIME-Type zur Dateierweiterung. # Index-Datei an Pfad anhaengen, falls Verzeichnis: if(-d $file && $file=~/\/$/){ $file.=$conf->{index_file}; } # Dateierweiterung aus Dateiname extrahieren und MIME-Type bestimmen: ($fileExt)=($file=~/.*\/.*?\.([a-z0-9]+)$/i); $mimeType=(defined($fileExt) && exists($conf->{mime_types}->{lc($fileExt)})) ? ($conf->{mime_types}->{lc($fileExt)}) : ($conf->{mime_types}->{'*'}); # Wenn Datei nicht existiert, gebe Fehler aus: # *FIXME* Trifft auch zu, falls Datei in einem Verzeichnis ohne Zugriffsrechte # liegt! unless(-f $file){ logAccess($client->peerhost().' 404 '.$host.' '.$file); sendError($client,404,'Not Found', 'The file requested ('.$url.') does not exist on '.$host.'.'); exitChild(); } # Oeffne Datei und gebe Fehler aus, falls ohne Erfolg: $fh=new IO::File($file,'r') || do{ logAccess($client->peerhost().' 403 '.$host.' '.$file); sendError($client,403,'Forbidden', 'You are not allowed to access the file requested ('.$url.') on ' .$host.'.'); exitChild(); }; # Sende 200 OK inkl. Header der Dateigroesse: sendHeader($client,200,'OK', { Length => -s $file, 'Content-Type' => $mimeType } ); # Schalte Dateihandle und Client-Verbindung in den Binaermodus und schiebe # alle Daten aus dem File zum Client durch, schliesse dann das File. binmode($fh); binmode($client); while(read($fh,$buffer,4096)){ print($client $buffer); } $fh->close(); # Erfolg protokollieren und Verbindung schliessen, Prozess beenden. logAccess($client->peerhost().' 200 '.$host.' '.$file.' ('.$mimeType.')'); exitChild(); } # Empfange alle Headers und verwerfe sie: sub getHeaders($){ my($client)=@_; my $bytes=0; # Byte-Counter fuer maximale Header-Groesse. # Enthaelt die (erste) zu verarbeitende Header-Zeile. my $line=readline($client); # Bis zu ersten Leerzeile sind alles Header: while(defined($line) && not($line=~/^[\r\n]+$/)){ # Erhoehe den Byte-Counter und beende Verbindung, wenn uebergelaufen: $bytes+=length($line); print($line); if($bytes > $conf->{max_headers_length}){ sendError($client,413,'Request Entity Too Large', 'Your request was bigger than '.$conf->{max_headers_length}.' bytes.'); exitChild(); } # Lese naechste Zeile: $line=readline($client); } } # Sende eine vollstaendige Fehlermeldung und erzeuge Log-Eintrag: sub sendError($$$$){ my($client,$code,$status,$message,)=@_; sendHeader($client,$code,$status,{}); sendStatus($client,$code,$status,$message); logError($client->peerhost().' ERROR'.$code.': '.$status); } # Erzeuge und sende einen HTTP-Header: sub sendHeader($$$\%){ my($client,$code,$status,$addHeaders)=@_; # Default-Werte: my %headers=( 'Content-Type' => 'text/html', 'Server' => 'MicroWeb/'.$VERSION, ); # Fuege alle Header in $addHeaders %headers hinzu: foreach(keys(%{$addHeaders})){ $headers{$_}=$addHeaders->{$_}; } # Sende HTTP-Header an den Client: print($client 'HTTP/1.0 '.$code.' '.$status."\r\n"); foreach(keys(%headers)){ print($client $_.': '.$headers{$_}."\r\n"); } print($client "\r\n"); } # Erzeuge und sende eine HTTP-Statusmeldung in HTML: sub sendStatus($$$){ my($client,$code,$status,$message)=@_; print($client <<__EOF);
$message
MicroWeb $VERSION, a simple HTTP server implementation — © 2006 Veit Wahlich
__EOF } # Erzeuge einen Timestamp mit der aktuellen lokalen Zeit fuer Log-Nachrichten # unter Verwendung von POSIX::strftime(): sub timestamp(){ return(strftime('[%Y-%m-%d %H:%M:%S] ',localtime(time))); } # Gebe eine Nachricht auf STDERR aus: sub logError($){ my($message)=@_; print(STDERR timestamp().$message."\n"); } # Eine Nachricht auf STDOUT ausgeben: sub logAccess($){ my($message)=@_; print(STDOUT timestamp().$message."\n"); } # Beendet den Kindprozess und schliesst zuvor sauber alle Handles: sub exitChild(){ $client->shutdown(2); $client->close(); STDOUT->close(); STDERR->close(); exit(0); } # Der SIGCHLD-Handler erntet tote Kinder. Das nennt man wirklich so... sub reapPid(){ # Warte auf die PID des toten Kindprozesses... my $pid=wait(); # Wenn sie richtig uebergeben wurde, dekrementiere die Anzahl laufender # Kindprozesse. if($pid > 0){ $children--; } # Setze den SIGCHLD-Handler zur Sicherheit nochmal: $SIG{CHLD}=\&reapPid; } # Dekodiere URI-encodierten String: sub decodeUri($){ my($line)=@_; if(defined($line)){ $line=~tr/+/ /; $line=~s/%([a-f0-9]{2})/pack('C',hex($1))/egi; } return($line); } main(); 1;