 |
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 "Ätschibä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 "Ätschibä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:
- Sende "Ich will KEKSE".
- Lies eine Zeile vom Client und prüfe sie auf das Wort "KEKSE".
- 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:
- Aktuellen Binärwert holen und in eine "Perl-Zahl" entpacken.
- 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).
- 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:
| Wert | Name | Beschreibung |
| 1 | LOCK_SH | Shared Lock |
| 2 | LOCK_EX | Exclusive Lock |
| 4 | LOCK_NB | Non-Blocking Lock |
| 8 | LOCK_UN | Unlock (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);
}
|
|
|
DIENSTE
