SUCHE MIT Google
Web virtualuniversity.ch
HOME DIDAKTIK ECDL ELEKTRONIK GUIDES HR MANAGEMENT MATHEMATIK SOFTWARE TELEKOM
DIENSTE
Anmeldung
Newsletter abonnieren
Sag's einem Freund!
VirtualUniversity als Startseite
Zu den Favoriten hinzufügen
Feedback Formular
e-Learning für Lehrer
Spenden
Autoren login
KURSE SUCHEN
Kurse veröffentlichen

Suche nach Datum:

Suche mit Schlüsselwort:

Suche nach Land:

Suche nach Kategorie:
PARTNER
ausbildung24.ch - Ausbildungsportal, Seminare, Kursen... 

 
HTMLopen.de - Alles was ein Webmaster braucht

 
PCopen.de - PC LAN Netze und Netzwerke - alles was ein IT Profi und Systemtechnicker braucht

TELEKOM

Multi-Thread-Server und -Client in Perl

Der folgende Server bedient die Anfragen nicht selbst, sondern erzeugt fürjede Anfrage einen Kindprozeß, der sich dann dem Client widmet. Der Vorteil liegt darin, daß der Server selbst sofort wieder auf dem Port lauschen kann,für den er zuständig ist. Wie schon besprochen, muß dafürgesorgt werden, daß keine Zombies zurückbleiben. Dazu wird das schonbekannte Schema mittels Signal-Handler verwendet. Gegenüber dem vorhergehendenServer neu ist nur der fork()-Aufruf. Da ein Kindprozeß allesvom Elternprozeß erbt, kann der Kindprozeß auch weiter überdie von accept() geöffnete Socketverbindung mit dem Client kommunizieren. Wenn sich der Kindprozeß beendet,wird der Signalhandler aufgerufen. Er schließt den Socket und nimmtden Return-Wert des Kindes entgegen.

#!/usr/bin/perl# tcp-server-mt.pl -- Ein Multithreaded-TCP-Serveruse strict;use IO::Socket;use constant MYPORT => 2000;my $sock = '';my $client = '';$sock = new IO::Socket::INET(LocalPort => MYPORT, Reuse => 1, Listen=> 5) or die "can't create local socket: $@\n"; # Zombies verhindern $SIG{'CHLD'} = sub { wait(); $client ->close; }; print "Accepting connections on Port ", MYPORT, "...\n"; while ($client = $sock->accept()) { # Verbindung ist aufgebaut print "Accepted connection from ", $client->peerhost(), ":", $client->peerport(), "\n"; # Erzeugen eines Kindprozesses und Uebergabe an $client. if (fork() == 0) # Kindprozess { # Echo, das alles umdreht: while (<$client>) { chomp; print $client scalar(reverse($_)), "\n"; } } }

Kommuniziert der erste Eigenbau-Client mit einem Server, der mehrere Zeilen zurückliefert, geht anscheinend irgendetwas schief. Der folgende Versuch, mit einem FTP-Server zu kommunizieren geht beim Login noch gut, aber danach wird die Kommunikation asynchron. Die Ausgaben des help-Befehls kommen nur Zeile für Zeile und man muß nach jeder Zeile die Enter-Taste drücken. Danach werden vom FTP-Server die leeren Eingaben mit einer Fehlermeldung quittiert:

plate@atlas:~/server > perl tcp-st-client.pl localhost 21 user plate >> 331 Password required for plate. pass Tralala >> 230 User plate logged in. help >> 214-The following commands are recognized (* =>'s unimplemented). >> USER PORT STOR MSAM* RNTO NLST MKD CDUP >> PASS PASV APPE MRSQ* ABOR SITE XMKD XCUP >> ACCT* TYPE MLFL* MRCP* DELE SYST RMD STOU >> SMNT* STRU MAIL* ALLO CWD STAT XRMD SIZE >> REIN* MODE MSND* REST XCWD HELP PWD MDTM >> QUIT RETR MSOM* RNFR LIST NOOP XPWD >> 214 Direct comments to root@localhost. quit >> 500 '': command not understood. >> 500 '': command not understood. >> 500 '': command not understood. >> 500 '': command not understood. Der Client muß die Ausgaben vom Server getrennt von den eigenen Eingaben behandeln. Wenn mehrere Zeilen vom Server zurückkommen, müssen auch mehrere Zeilen lokal angezeigt werden. Es gibt nur ein Problem: Das Ende der gesamten Kommunikation kann erkannt werden, aber nicht das Ende einer momentanen Ausgabe. Daher trennen wir auch beim Client die Kommunikation in zwei Prozesse auf. Der Elternprozeß übernimmt ausschließlich das Senden der Eingaben zum Server. Der Kindprozeß sorgt für die Ausgabe der Zeilen, die vom Server kommen. Nun treten keine Asynchronitäten mehr auf.

#!/usr/bin/perl # tcp-mtclient.pl -- Ein multithreaded interaktiver TCP-Client. # Verwendung: $0 remote_host remote_port use strict; use IO::Socket; my $sock = ''; use constant TIMEOUT => 5; $sock = new IO::Socket::INET(PeerAddr => $ARGV[0], PeerPort => $ARGV[1], Proto => 'tcp', Timeout => TIMEOUT) or die "can't connect to $ARGV[0]:$ARGV[1]: $@\n"; # An dieser Stelle teilen wir mit fork() in zwei Prozesse auf: if (fork()) # == 0 --> Kind { # Der Kindprozess: Server -> Mensch while (<$sock>) { print $_; } $sock->close() if defined $sock; die "server closed connection.\n"; } else { # Der Elternprozess: Mensch -> Server while (<STDIN>) { print $sock $_; } $sock->close(); # fertig, aufhaengen! wait(); } Man kann den gleichen Effekt auch Resourcen-schonender erreichen, indem man IO::Select verwendet. Der Client prüft nun bei allen in $select eingetragenen Handles, ob Daten vorliegen und so kann das Programm die Daten unabhängig voneinander bearbeiten.

#!/usr/bin/perl # Ein single-threaded interaktiver TCP-Client. # Benutzt nur einen Prozess, aber IO::Select. # Verwendung: $0 remote_host remote_port use IO::Socket; use IO::Select; use strict; my ($socket, $select, $handle); my @ready = (); $sock = new IO::Socket::INET(PeerAddr => $ARGV[0] PeerPort => $ARGV[1], Proto => 'tcp', Timeout => 5) or die "can't connect to $ARGV[0]:$ARGV[1]: $@\n"; $select = IO::Select->new(); $select->add($sock); $select->add(\*STDIN); while (@ready = $select->can_read()) { foreach $handle (@ready) { last unless defined($reply = <$handle>); if ($handle == $sock) { print $reply; } else { print $sock $reply; } } } $sock->close(); # fertig, aufhaengen!

Der erste HTTP-Server

Nun soll der Server für Anfragen auf dem HTTP-Port verwendet werden. Der erste Server ist recht einfach gehalten, denn er sendet nur eine Fehlermeldung ("Not found"). Trozdem sind schon Kenntnisse des HTTP-Protokolls und gegebenenfalls HTML-Kenntnisse erforderlich. Wie so viele höhere Protokolle ist auch HTTP recht einfach gehalten. Jede Nachricht (vom Client an den Server wie auch vom Server an den Client) besteht aus einem Header und einem Body, die durch eine Leerzeile voneinander getrennt sind (deshalb muß man beim Testen per Telnet-Programm auch eine Leerzeile eingeben, ehe der Server reagiert). Unser Serverprogramm von oben wurde nur leicht verändert: Der Port ist nun 8080. Der Server nimmt nach Verbindungaufbau die Anfrage des Client entgegen und gibt sie zur Kontrolle auf dem Bildschirm aus. Da der Socket vom Client nicht geschlossen wird, können wir nur an der Leerzeile erkennen, wann die Anfrage zuende ist. Da man auch nicht wissen kann, ob nur ein Newline-Zeichen oder Carriage-Return und Newline geschickt werden, geht man davon aus, daß Zeilen mit weniger als zwei Zeichen Länge, Leerzeilen sind. Danach schickt der Server erst den Header:

HTTP/1.0 404 Not Found Server: Tralala 1.0 Content-Type: text/html Connection: close gefolgt von einer Leerzeile. Anschließend wird auch noch die Fehlermeldung als Mini-Webdokument geschickt und danach die Verbindung beendet.

#!/usr/bin/perl # Ein Mini-Webserver: Nur Fehlermeldung use strict; use IO::Socket; use constant MYPORT => 8080; my $sock = ''; my $client = ''; $sock = new IO::Socket::INET(LocalPort => MYPORT, Reuse => 1, Listen => 5) or die "can't create local socket: $@\n"; print "Accepting connections on Port ", MYPORT, "...\n"; while ($client = $sock->accept()) { # Verbindung ist aufgebaut print "Accepted connection from ", $client->peerhost(), ":", $client->peerport(), "\n"; # Erzeugen eines Kindprozesses und Uebergabe an $client. if (fork() == 0) # Kindprozess { $client->autoflush; my ($dummy); # Gaaaaaanz einfacher Webserver # Eingabe wird ignoriert, aber ausgegeben do { chomp($dummy = <$client>); print "$dummy\n"; } while(length($dummy) > 1); print $client "HTTP/1.0 404 Not Found\n"; print $client "Server: Tralala 1.0\n"; print $client "Content-Type: text/html\n"; print $client "Connection: close\n"; print $client "\n"; print $client "<html><head><title>404 Not Found
</title></head>\n"; print $client "<body><h1>404 Not Found</h1>\n"; print $client "&Auml;tschib&auml;tsch!\n"; print $client "</body></html>\n"; print "*** FERTIG ***\n"; $client ->close; } } Leider hat dieser Webserver noch einen Nachteil. Nach jedem Connect von einem Client bleibt ein Zombie zurück - denn der Elternprozeß hat vergessen, das Signal CHLD vom Kindprozeß anzunehmen. Deshalb wird auch hier der schon aus dem letzten Kapitel bekannte Signalhandler eingebaut:

#!/usr/bin/perl # Ein Mini-Webserver: Nur Fehlermeldung use strict; use IO::Socket; use constant MYPORT => 8080; my $sock = ''; my $client = ''; $sock = new IO::Socket::INET(LocalPort => MYPORT, Reuse => 1, Listen => 5) or die "can't create local socket: $@\n"; $SIG{'CHLD'} = sub { wait(); }; # Zombies verhindern print "Accepting connections on Port ", MYPORT, "...\n"; while ($client = $sock->accept()) { # Verbindung ist aufgebaut print "Accepted connection from ", $client->peerhost(), ":", $client->peerport(), "\n"; # Erzeugen eines Kindprozesses und Uebergabe an $client. if (fork() == 0) # Kindprozess { $sock->close; # not needed in child $client->autoflush; my ($dummy); # Gaaaaaanz einfacher Webserver # Eingabe wird ignoriert, aber ausgegeben do { chomp($dummy = <$client>); print "$dummy\n"; } while(length($dummy) > 1); print $client "HTTP/1.0 404 Not Found\n"; print $client "Server: Tralala 1.0\n"; print $client "Content-Type: text/html\n"; print $client "Connection: close\n"; print $client "\n"; print $client "<html><head><title>404 Not Found
</title></head>\n"; print $client "<body><h1>404 Not Found</h1>\n"; print $client "&Auml;tschib&auml;tsch!\n"; print $client "</body></html>\n"; print "*** FERTIG ***\n"; $client ->close; } $client ->close; # not needed in parent } Dieser Server läßt sich recht einfach so erweitern, daß die vom Client gewünschte HTML-Datei geschickt wird. Dazu wird im Server ein Startverzeichnis festgelegt, das für die Anfragen der Clients das Wurzelverzeichnis bildet. Deshalb werden beim Auswerten der Anfrage auch URLs der Form "/.. usw. verhindert. Die Anfragezeile selbst hat den Aufbau

GET dateiname HTTP/1.x Der Dateiname läßt sich recht einfach aus dieser Zeile herausziehen. Ist die angegebene Datei vorhanden, wird sie gesenden, andernfalls erfolgt die Fehlermeldung 404.

#!/usr/bin/perl # Ein Mini-Webserver - Dateiausgabe, aber nur Text use strict; use IO::Socket; # Port waehlen use constant MYPORT => 8080; # Startdirectory (Server-Root) festlegen my $startdir = '/home/plate/server/'; my $sock = ''; my $client = ''; $sock = new IO::Socket::INET(LocalPort => MYPORT, Reuse => 1, Listen => 5) or die "can't create local socket: $@\n"; $SIG{'CHLD'} = sub { wait(); }; # Zombies verhindern print "Accepting connections on Port ", MYPORT, "...\n"; while ($client = $sock->accept()) { # Verbindung ist aufgebaut print "Accepted connection from ", $client->peerhost(), ":", $client->peerport(), "\n"; # Erzeugen eines Kindprozesses und Uebergabe an $client. if (fork() == 0) # Kindprozess { my ($input, $get, $file); $sock->close; # not needed in child $client->autoflush; # Gaaaaaanz einfacher Webserver # Eingabe wird untersucht und ausgegeben do { chomp($input = <$client>); print "$input\n"; $get = $input if ($input =~ /GET/); } while(length($input) > 1); # Aus der GET-Zeile Dateinamen extrahieren $get =~ /GET ([^ ]*) HTTP/; $file= "$1"; $file = $file . 'index.html' if ($file =~ /\/$/); $file =~ s/^\///g; # '/' am Anfang weg $file =~ s/\.\.\///g; # URLS der Form '/' unterbinden $file = $startdir . $file; # Server-Root davor setzen print "Senden $file\n"; # Datei oeffnen und zum Client schicken. if (!open(DATEI,"$file")) { print $client "HTTP/1.0 404 Not Found\n"; print $client "Server: Tralala 1.0\n"; print $client "Content-Type: text/html\n"; print $client "Connection: close\n"; print $client "\n"; print $client "<html><head><title>404 Not Found</title></head>\n"; print $client "<body><h1>404 Not Found</h1>\n"; print $client "</body></html>\n"; print "*** FERTIG **\n"; $client ->close; } else { print $client "HTTP/1.0 200 OK\n"; print $client "Server: Tralala 1.0\n"; print $client "Content-Type: text/html\n"; print $client "Connection: close\n"; print $client "\n"; print $client $_ while(<DATEI>); close(DATEI); print "*** FERTIG **\n"; $client ->close; } } $client ->close; # not needed in parent } Da dieser Server zeilenorientiert arbeitet, können keine Bilder oder andere Multimedia-Inhalte gesendet werden. Dieser Mangel ist aber relativ leicht zu beheben. Aber auch dann sind die beiden Webserver noch nicht für eine Produktionsumgebung, sondern nur für Tests und Demonstrationen geeignet.

Außerdem wird davon ausgegangen, daß die Kindprozesse in der Reichenfolge beendet werden, in der sie kreiert wurden, da sonst der einfache Signalhandler nicht funktioniert und wieder Zombies entstehen. Man muß also eine Prozeßverwaltung einrichten, wie es schon im vorhergehenden Kapitel gezeigt wurde. Einen Server, der dies macht, finden Sie bei den Beispielen als webserver3.pl.

Weitere Server

Der folgende Server ist ein Spaß-Server mit leicht ernstem Hintergrund. Erinnern Sie sich noch an das Keks-Monster-Programm unter MS-DOS. Es verlangte dauern Kekse ("Ich will KEKSE!") und hörte erst auf, wenn man ihm welche gab, indem man das Wort "KEKSE" eintippte. Diesmal ist es kein Programm, sondern ein Server, der KEKSE verlangt. Man könnte ihn beispielsweise auf Port 23 legen statt auf Port 2300. Der Server produziert für jede Anfrage einen Kindprozeß, weil davon auszugehen ist, daß der Dialog mit dem Benutzer länger dauert. Das Quittieren des Todes eines Kindes ist ebenfalls integriert. Auß ist das der erste Server, der einen Hauch von Protokoll implementiert:
  1. Sende "Ich will KEKSE".
  2. Lies eine Zeile vom Client und prüfe sie auf das Wort "KEKSE".
  3. Fall ja, sende "Mampf, Mampf...." und beende, andernfalls gehe zu 1.



#!/usr/bin/perl # Keks-Monster use strict; use IO::Socket; use constant MYPORT => 2300; my $sock = ''; my $client = ''; $sock = new IO::Socket::INET(LocalPort => MYPORT, Reuse => 1, Listen => 5) or die "can't create local socket: $@\n"; $SIG{'CHLD'} = sub { wait(); }; # Zombies verhindern print "Accepting connections on Port ", MYPORT, "...\n"; while ($client = $sock->accept()) { # Verbindung ist aufgebaut print "Accepted connection from ", $client->peerhost(), ":", $client->peerport(), "\n"; # Erzeugen eines Kindprozesses und Uebergabe an $client. if (fork() == 0) # Kindprozess { $sock->close; # not needed in child # Das Monster in Aktion print $client "Ich will KEKSE!\n"; while (<$client>) { chomp; if ($_ =~ /KEKSE/) { print $client "\nMampf, Mampf....\n\n"; $client->close; } print $client "Ich will KEKSE!\n"; } } $client->close; # not needed in parent }

Der folgende Server ist etwas anspruchsvoller. Er liefert, wie das UNIX-Programm fortune, einen mehr oder weniger coolen Spruch. Dazu wird das fortune-Programm in Perl nachempfunden. In der Datei
/usr/share/fortune/fortunes stehen die meist mehrzeiligen Sprüche und sind jeweils durch eine Zeile getrennt, die nur ein %-Zeichen enthält. Deshalb wird beim Zugriff auf die Datei der Zeilentrenner mit
$/ = "\n%\n" umdefiniert. So kann ein mehrzeiliger Text in eine skalare Stringvariable eingelesen und auf einmal an den Client gesendet werden. Nach der Ausgabe des Cookies wird die Verbindung sofort beendet.

#!/usr/bin/perl # Fortune-Server use strict; use IO::Socket; use constant MYPORT => 2000; my $sock = ''; my $client = ''; $sock = new IO::Socket::INET(LocalPort => MYPORT, Reuse => 1, Listen => 5) or die "can't create local socket: $@\n"; $SIG{'CHLD'} = sub { wait(); }; # Zombies verhindern print "Accepting connections on Port ", MYPORT, "...\n"; while ($client = $sock->accept()) { # Verbindung ist aufgebaut print "Accepted connection from ", $client->peerhost(), ":", $client->peerport(), "\n"; # Erzeugen eines Kindprozesses und Uebergabe an $client. if (fork() == 0) # Kindprozess { $sock->close; # not needed in child # Jetzt kommt der Spruch $/ = "\n%\n"; my ($data,$cookie); $data = '/usr/share/fortune/fortunes'; srand($$); open(KEKS,"$data") || die "Keine Kekse\n"; rand($.) < 1 && ($cookie = $_) while <KEKS>; $cookie =~ s/%$//; print $client "\n$cookie\n"; close(KEKS); $client->close; } $client->close; # not needed in parent }

Ein Timeserver-Proxy

"Proxy" heißt "Stellvertreter". Der folgende Server wird als ein Stellvertreter für einen anderen Server arbeiten und dabei gleich auch noch das Protokoll umsetzen.

RFC 867 behandelt die Spezifikation des Protokolls "daytime", das sowohl über TCP/IP als auch über UDP auf dem Port 13 abgewickelt wird. Für die Syntax des zurückgegebenen Daytime-Strings gibt es keine allgemeinen Regeln, dieser String ist von Server zu Server unterschiedlich und kann beispielsweise das Format

Tag Monat Jahr Stunde:Minute:Sekunde besitzen. Außer dem Service "daytime" gibt es noch einen Dienst "time" welcher ebenfalls über TCP/IP im Internet von einigen Servern zur Verfügung gestellt wird. Hier wird die genaue Zeit im Binärformat auf Port 37 zurückgegeben.

Das folgende Perl-Script liefert die Systemzeit des lokalen Rechners im Klartext.

#!/usr/bin/perl # Ein einfacher Daytime-Server use IO::Socket; my $serversock = new IO::Socket::INET ( LocalPort => 13, Listen => $SOMAXCONN, Proto => 'tcp', Reuse => 1) || die "$!\n"; # In der Schleife auf eingehende Verbindungen warten... print "Accepting connections on Port 13...\n"; while (my $clientsock = $serversock->accept() ) { my $cur_time = localtime(time); print $clientsock "$cur_time\n"; $clientsock->close() if defined $clientsock; } Das war nicht weiter interessant, denn es handelt sich nur um eine leichte Modifikation des allerersten Servers. Interessanter wird es dagegen, wenn die Uhrzeit nicht vom lokalen Server geholt wird, sondern von einem Server, der die Zeit einer Atomuhr bezieht (oder von einem Server, der seinerseits auf die Atomzeit zugreift). Solche "Timeserver" liefern die Uhrzeit jedoch im Binärformat - und auch nicht zur Basis des 1.1.1970 0 Uhr GMT (die UNIX-Epoche), sondern zur Basis 1.1.1900 0 Uhr GMT.
Beim Zugriff auf einen solchen Server sind somit folgende Schritte notwendig:

  1. Aktuellen Binärwert holen und in eine "Perl-Zahl" entpacken.
  2. Die Anzahl Sekunden zwischen 1.1.1970, 0 Uhr GMT und 1.1.1900, 0 Uhr GMT subtrahieren (das sind nach RFC 868 genau 2'208'988'800 Sekunden).
  3. Das Ergebnis in einen Datumsstring für "Daytime" umwandeln.
Genau das macht das folgende Programm. Sobald es als Daytime-Server auf Port 13 angesprochen wird, eröffnet es seinerseits eie Verbindung zum Zeitserver auf Port 37 und holt als Time-Client die Zeit. Danach erfolgt die Konvertierung und der Client bekommt seine Uhrzeit.

Damit stellt dies Programm nicht mehr einen einfachen Server dar, sondern hat Proxy-Funktion. Es wird nicht nur die Anfrage an einen anderen Rechner weitergereicht, sondern auch zwei verschiedene (wenn auch sehr einfache) Protokolle implementiert. Da es sich trotz aller Einfacheit um höhere Protokolle handelt, wird hiermit auch das Prinzip eines Gateways demonstriert.

#!/usr/bin/perl # Script baut eine Verbindung zum ausgewaehlten "Zeitserver" auf # und liefert dann die genaue Uhrzeit an den Client use IO::Socket; use strict; # Clientport und Serverport use constant CLPORT => 13; use constant SVPORT => 37; # Differenz zwischen 1.1.1900 (Time-Server) # und 1.1.1970 (UNIX-Epoche) use constant KORR => 2208988800; # Mein Zeitserver my $hostname = "ptbtime1.ptb.de"; # Timeserver der Physikalisch-Technischen # oder ptbtime2.ptb.de # Bundesanstalt in Braunschweig my $serversock = new IO::Socket::INET ( LocalPort => CLPORT, Listen => 5, Proto => 'tcp', Reuse => 1) or die "can't create local socket: $@\n"; # In der Schleife auf eingehende Verbindungen warten... print "Accepting connections on Port ", CLPORT, "...\n"; while (my $clientsock = $serversock->accept() ) { my $cur_time = &get_time; print $clientsock "$cur_time\n"; $clientsock->close() if defined $clientsock; } # Zeit vom anderen Server holen sub get_time { my ($binarytime, $servertime); my $ts_sock = new IO::Socket::INET ( PeerAddr => $hostname, PeerPort => SVPORT, Proto => 'tcp') or die "can't create local socket: $@\n"; read($ts_sock,$binarytime,4); $ts_sock->close(); $servertime = unpack('N',$binarytime); $servertime = localtime($servertime - KORR); return "$servertime"; }

Preforking

Ist damit zu rechnen, daß die Serverlast ständig recht hoch ist (z. B. bei einem WWW-Server), kann es sinnvoll sein, schon beim Start des Serverprozesses einige Kundprozesse zu starten. So wird bei mehreren gleichzeitigen Anfragen die Zeit zum Starten der Kindprozesse gespart und die Performance des Systems gesteigert. Eine übliche Lösung ist das sogenannte "preforking", wobei der Serverprozeß gleich eine Anzahl von Kindprozessen startet und jeder dieser Kindprozesse individuell einen accept()-Aufruf. Jeder Kindprozeß behandelt dann ein eingehende Anfrage und kann entweder endlos weiterlaufen oder sich beenden. Der ursprüngliche Elternprozeß überwacht alle laufenden Kindprozesse und startet gegebenenfalls neue, wenn sich die Kinder beenden. Außerdem muß er beim Herunterfahren des Serverdienstes auch alle Kinder beenden. Prinzipiell stellt sich der Ablauf folgendermaßen dar:

for (1..ANZ_PREFORK) { $child = fork(); next if ($child != 0); # Elternprozess macht nix do_child($child); # Ablauf Kindprozess exit(0); # Ende Kindprozess } sub do_child { my $socket = shift; my $connection_count = 0; while ($ch = $socket->accept()) { handle_connection($ch); $ch->close(); } } Eine reale Implemetierung erfordert jedoch noch die Beachtung (und programmtechnische Realisierung) vieler Details und gestaltet sich relativ komplex.

Einen Dämon erzeugen

Dämonen sind Prozesse, die sich vom steuernden Terminal abkoppeln und im Hintergrund weiterlaufen. Beim Start versetzt sich der Dämon selbst in den Hintergrund und koppelt sich vom steuernden Terminal ab. Ein Dämon reagiert auch nicht auf ein HUP-Signal uns läuft so weiter, auch wenn sich der startende Prozeß beendet. Ausserdem muß ein richtiger Dämon noch mehr tun:
  • das Rootverzeichnis als aktuelles Verzeichnis wählen, da der Start ja auch von einem unmountbarem Verzeichnis aus erfolgen könnte,
  • umask auf einen bekannten Wert ändern,
  • die PATH-Variable anpassen,
  • Prozeß-ID in einer Datei in /var/run/ ablegen,
  • gegebenenfalls Logging initialisieren (Logfile oder Syslog-Mechanismus),
  • gegebenenfalls Signalhandler einrichten (z. B. HUP für einen Restart)
  • gegebenenfalls Konfigurationsdatei einlesen und verarbeiten,
  • gegebenenfalls User- und Gruppen-ID ändern (z. B. von root auf nobody),
  • gegebenenfalls mit chroot() eine geschützte Umgebung schaffen.
Ganz einfache Dämonen lassen sich fast so simpel erzeugen, wie ein Multi-Thread-Server:

#!/usr/bin/perl $|=1; use strict; my ($pid, $i); $pid = fork(); die "cannot fork: $!\n" if ($pid == -1); # Parent beendet sich if ($pid > 0) { print "Parent exits\n"; exit(0); } # Kindprozess wird von init adoptiert chdir "/tmp" or die "could not chdir to /tmp: $!\n"; for($i = 0; $i < 100; $i++) { print "This is the Daemon.\n"; sleep(5); } Der wesentliche Punkt ist, daß der Parent terminiert, so daß der Kindprozeß von Init adoptiert wird und im Hintergrund weiterläuft. Der chdir-Aufruf setzt das aktuelle Verzeichnis in diesem Fall auf das /tmp-Verzeichnis. Wenn man bei obigem Beispiel die Shell beendet, in welche die Dämon-Ausgaben laufen, läuft der Dämon im Hintergrund weiter; die print-Aufrufe würden dann Fehler liefern. Im Beispiel stört das nicht, korrekterweise müßte man die drei Standard-Dateihandles (stdin, stdout, stderr) im Kindprozeß schließen.

Das folgende Unterprogramm erledigt einige weitere Aufgaben und eignet sich daher schon besser für den Praxiseinsatz. Die POSIX-kompatible Funktion setsid() kreiert jeweils neue neue Session- und Prozeß-Gruppe und macht den aktuellen Prozeß zum Session-Leader (wird an dieser Stelle nicht vertieft). Gleichzeitig wird der Prozeß komplett vom steuernden Terminal getrennt. Amschließend werden die Standarddateien wieder geöffnet, aber dabei auf /dev/null umgeleitet. So werden eventuelle Schreib- und Leseversuche von Subprozessen vernichtet. Man kann sie aber auch mittels close(\*STDIN); close(\*STDOUT);
close(\*STDERR); komplett schließen.

use POSIX 'setsid'; sub become_daemon # () { my $child = fork(); unless (defined($child)) die "Cannot fork!\n"; exit(0) if ($child > 0); # Eltenprozess beendet sich make_pidfile(PIDFILE,$$); # Pid-Datei anlegen (s. u.) setsid(); # Abtrennen open(STDIN, "</dev/null"); # Standarddateien umlenken open(STDOUT, ">/dev/null"); open(STDERR, ">&STDOUT"); chdir('/'); # Arbeitsverzeichnis / umask(0); # UMASK definieren # Pfad definiert setzen: $ENV{PATH} = '/bin; /sbin; /usr/bin; /usr/sbin;'; return $$; } Die zweite hier vorzustellende Funktion legt eine Datei mit der Prozeß-ID des Dämons an, damit er leicht leicht mit dem Kommando

kill -TERM `cat /var/run/server.pid` beendet werden kann. Der Dämon sollte dann die Datei server.pid auf jeden Fall noch löschen, bevor er sich beendet. Die Funktion trifft gegebenfalls auf eine noch vorhandene pid-Datei. Dann läuft entweder noch ein Serverprozeß oder ein früherer Serverprozeß ist abgestürzt, ohne die Datei zu löschen. Durch den Aufruf "kill 0 prozessnummer" kann festgestellt werden, ob es noch einen laufenden Prozeß mit dieser Nummer gibt und damit arbeitet die Funktion recht intelligent:

sub make_pidfile # (dateiname, newpid) { my $filename = shift; my $newpid = shift; if (-e $filename) # Datei schon vorhanden { open PID "<$filename"; my $pid = <PID>; close PID; # gibt's den Server noch? die "Server already running ($pid)\n" if kill 0 => $pid; # Hier ggf. noch nachsehen, ob der Prozess auch ein alter # Serverprozess ist und nicht zufaellig ein anderer Prozess # diese Prozessnummer besitzt # Nun die alte Datei platt machen unlink $filename || die "Cannot delete $filename\n"; } # Neue Datei anlegen und Zugriffsrechte setzen open PID ">$filename"; print PID $newpid; close PID; chmod(644 $filename); } Im Hauptprogramm sind dann nur noch einige Aufrufe und Festlegungen nötig:

# Namen der PID-Datei festlegen use constant PIDFILE => '/var/run/myserver.pid'; # Exit-Handler setzen $SIG{TERM} = $SIG{INT} = sub { exit 0; } # Daemon werden my $daemonpid = become_daemon(); # Sicherstellen, dass beim Exit die PID-Datei # auf jeden Fall geloescht wird # (Der Elternprozess muss die Datei aber in Ruhe lassen) END { unlink(PIDFILE) if ($daemonpid == $$); }

Benutzer- und Gruppen-ID ändern

Ein privilegierter Prozeß kann seine (reale und effektive) User-ID wechseln. Die heute allgemein anerkannte Methode zum Abfragen von Daten aus einem privilegierten Programm heraus ist es, einen Kindprozeß abzuspalten, im Kind dann die Identität des nichtprivilegierten Users anzunehmen, die Aktion auszuführen, und den Elternprozeß zu benachrichtigen. Perl hat vier spezielle Variablen zur Steuerung von User und Gruppe:
  • $<   Reale User-ID des Prozesses (numerisch)
  • $(   Reale Gruppen-ID des Prozesses (numerisch)
  • $>   Effektive User-ID des Prozesses (numerisch)
  • $)   Effektive Gruppen-ID des Prozesses (numerisch)
Ein Prozeß der von root gestartet wurde, kann also mittels Äderung von $> seine Benutzeridentität ändern und damit seine Privilegien reduzieren. Werden reale und effektive User-ID geändert, ist der Weg zurück zu root-Privilegien versperrt.

Analog lassen sich auch die Gruppenrechte verändern. Ist der Benutzer in mehreren Gruppen vertreten, enthalten die Variablen $) und $( eine Liste der Gruppen-IDs, jeweils durch Leerzeichen getrennt. Für den Wechsel der "primary group" wird ein einziger Wert an die Variable $( zugewiesen. Um die effektive Gruppen-ID zu wechseln, wird ein einziger Wert in $) gespeichert. Wird eine Liste von (durch Leerzeichen getrennten) Gruppen-IDs an $) zugewiesen, wird die erste Zahl zur effektiven Gruppen-ID und die folgenden zu den "supplementary groups". Besteht die Liste aus nur zweimal demselben Wert, hat der Prozeß nur noch eine einzige Gruppen-ID.

Protokollierung

Da ein Serverprozeß normalerweise vom kontrollierenden Terminal abgetrennt wird, kann Information über die ausgeführte Arbeit des Servers oder aufgetretenen Unregelmässigkeiten nicht direkt an die Standardausgabe oder die Standardfehlerausgabe geleitet werden. Die Protokollierung der Server-Tätigkeit muß also auf anderem Wege erfolgen. Dazu bieten sich (neben anderen) zwei Möglichkeiten an:
  • Verwendung des Syslog-Mechanismus
    Unter UNIX gibt es den Syslog-Daemon, der Nachrichten per Prozeßkommunikation (UNIX Domain Socket) entgegennimmt und im Standard-Logfile speichert. Perl erlaubt die komfortable Syslog-Nutzung mit Hilfe des Pakets Sys::Syslog, auf das an dieser Stelle nicht weiter eingegangen wird.
  • Schreiben in eine Log-Datei
    Eine einfache Alternative zum Syslog ist das führen einer eigenen Logdatei, die - wie andere Logfiles - unterhalb von /var/log beheimatet sein sollte. Eine eigene Log-Datei gestattet auch eine einfache statistische Auswertung, da nur Einträge eines einzigen Serverdienstes in der Datei stehen und der Programmierer frei im Aufbau eines Eintrags ist. Das einzige Problem taucht auf, wenn es ggf. mehrere Kondprozesse gibt, die alle in dieselbe Log-Datei schreiben wollen und dies auch noch gleichzeitig. Dafür stellt Perl aber einen einfachen Filelocking-Mechanismus zur Verfügung. Für die Dauer des Schreibvorgangs kann die Datei mit der Funktion flock() für andere Zugriffe gesperrt und später wieder freigegeben werden. Die Syntax lautet $boolean = flock(FILEHANDLE, $how);, wobei $how den Modus enthält:

    WertNameBeschreibung
    1LOCK_SHShared Lock
    2LOCK_EXExclusive Lock
    4LOCK_NBNon-Blocking Lock
    8LOCK_UNUnlock (Freigabe)

Netterweise erlaubt uns Perl auch die Umleitung der Standardfunktionen die und warn, sie lassen sich also im Programm weiterhin verwenden, nur daß jetzt der Output im Logfile landet. Das ist besonders dann interessant, wenn man nachträglich Logging hinzufügt.

Für das Logging sind nur wenige Unterprogramme nötig:

  • start_log($dateiname): Öffnet die die Datei (append) und leitet die und warn um.
  • log_info($message): gibt eine informative Nachricht ins Logfile aus.
  • log_warn($message): gibt eine Warnung (Fehlermeldung) ins Logfile aus.
  • log_die($message): gibt eine Fehlermeldung ins Logfile aus und beendet den Prozeß.
  • end_log: schliesst die Logdatei.
Die Implementierung ist ohne Besonderheiten. Für die Dateioperationen wird IO::File benötigt.

use strict; sub start_log #(Dateiname) { my $filename = shift; open(FH,">>".$filename) || return 0; chmod($filename,644); # Autoflush setzen fuer FH my $oldfh = select(FH); $| = 1; select($oldfh); # Lock freigeben flock(FH,8); # warn und die umleiten $SIG{__WARN__} = \&log_warn; $SIG{__DIE__} = \&log_die; return 1; } sub end_log { close(FH); } sub log_info #(Message) { my $time = localtime; my $mesg = join(' ',@_) || "Oops!"; $mesg = $time . " [INFO] " . $mesg . "\n"; flock(FH,2); print FH $mesg; flock(FH,8); } sub log_warn #(Message) { my $time = localtime; my $mesg = join(' ',@_) || "Oops!"; $mesg = $time . " [ERROR] " . $mesg . "\n"; flock(FH,2); print FH $mesg; flock(FH,8); } sub log_die #(Message) { my $time = localtime; my $mesg = join(' ',@_) || "Oops!"; $mesg = $time . " [FATAL] " . $mesg . "\n"; flock(FH,2); print FH $mesg; flock(FH,8); close(FH); die @_; }

Timeouts abfangen

Bei Clients und Proxies kann es durchaus vorkommen, daß der angesprochene Server nicht reagiert oder auf dem Ziel-Port kein Serverprozeß läuft. In diesem Fall würde der Connect hängen bleiben, bis der Netzwerk-Timeout die Verbindung schließt, was mitunter lange dauern kann. Dieser Fall kann über einen Timeout mit der Perl-Funktion alarm() abgefangen werden. Der Timeout löst einen Interrupt aus, der die Verbindung schließt oder den Prozeß beendet. Es muß ein Signalhandler für ALRM eingesetzt und über die Funktion alarm() die Timeout-Zeit (in Sekunden) festgelegt werden. Bei jedem Aufruf von alarm() wird die Zeit wieder neu gesetzt. Das folgende Beispiel zeigt die Arbeitsweise:

#!/usr/bin/perl use strict; # Signalhandler setzen $SIG{"ALRM"} = sub { print "Timeout - terminated!\n"; exit(1); }; # Timeout nach 10 Sekunden alarm(10); # Damit was passiert my $count = 0; while (1) { $count++; print "Rumpelstilzchen $count!\n"; sleep(1); }

DIPLOMARBEITEN UND BÜCHER

Diplomarbeiten zum Runterladen:

Suche im Katalog:
Architektur / Raumplanung
Betriebswirtschaft - Funktional
Erziehungswissenschaften
Geowissenschaften
Geschichtswissenschaften
Informatik
Kulturwissenschaften
Medien- und Kommunikationswissenschaften
Medizin
Psychologie
Physik
Rechtswissenschaft
Soziale Arbeit
Sozialwissenschaften


JOBS
HOME | E-LEARNING | SITEMAP | LOGIN AUTOREN | SUPPORT | FAQ | KONTAKT | IMPRESSUM
Virtual University in: Italiano - Français - English - Español
VirtualUniversity, WEB-SET Interactive GmbH, www.web-set.com, 6301 Zug

Partner:   Seminare7.de - PCopen.de - HTMLopen.de - WEB-SET.com - YesMMS.com - Ausbildung24.ch - Manager24.ch - Job und Karriere