Keine Angst vor select()!

Martin H. Sluka <martin@sluka.de>

2003-03-05

Hin und wieder steht man vor dem Problem, dass man parallel mehrere File- bzw. Socket-Handles lesend und oder schreibend bedienen möchte. Diese Handles können aber möglicherweise nicht alle zu lesenden Daten auf einen Schlag liefern oder alle zu schreibenden auf einmal aufnehmen. In diesen Fällen erweist sich die Kenntnis von select() oft als hilfreich.

  1. Gegenstand dieses Beitrags

    2. Dieser Beitrag erklärt die Funktionsweise der Funktion select() und demonstriert deren praktischen Einsatz anhand von zwei Beispielen.

    Zur Vermeidung von Missverständnissen sei darauf hingewiesen, dass es in Perl zwei select()-Funktionen gibt, die jedoch mit Ausnahme ihres Namens nichts gemein haben, vgl. "perldoc -f select" bzw. <http://www.perldoc.com/perl5.8.0/pod/func/select.html>:

    select FILEHANDLE
    select

    Returns the currently selected filehandle. Sets the current default filehandle for output, if FILEHANDLE is supplied. This has two effects: first, a write or a print without a filehandle will default to this FILEHANDLE. Second, references to variables related to output will refer to this output channel. For example, if you have to set the top of form format for more than one output channel, you might do the following: 

        select(REPORT1);
    $^ = 'report1_top';
    select(REPORT2);
    $^ = 'report2_top';

    FILEHANDLE may be an expression whose value gives the name of the actual filehandle. Thus: 

        $oldfh = select(STDERR); $| = 1; select($oldfh);

    Some programmers may prefer to think of filehandles as objects with methods, preferring to write the last example as: 

        use IO::Handle;
    STDERR->autoflush(1);

    select RBITS,WBITS,EBITS,TIMEOUT

    This calls the select(2) system call with the bit masks specified, which can be constructed using fileno and vec, along these lines: 

        $rin = $win = $ein = '';
    vec($rin,fileno(STDIN),1) = 1;
    vec($win,fileno(STDOUT),1) = 1;
    $ein = $rin | $win;

    If you want to select on many filehandles you might wish to write a subroutine: 

        sub fhbits {
	my(@fhlist) = split(' ',$_[0]);
	my($bits);
	for (@fhlist) {
	    vec($bits,fileno($_),1) = 1;
	}
	$bits;
    }
    $rin = fhbits('STDIN TTY SOCK');

    The usual idiom is: 

        ($nfound,$timeleft) =
      select($rout=$rin, $wout=$win, $eout=$ein, $timeout);

    or to block until something becomes ready just do this 

        $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);

    Most systems do not bother to return anything useful in $timeleft, so calling select() in scalar context just returns $nfound.

    Any of the bit masks can also be undef. The timeout, if specified, is in seconds, which may be fractional. Note: not all implementations are capable of returning the $timeleft. If not, they always return $timeleft equal to the supplied $timeout.

    You can effect a sleep of 250 milliseconds this way: 

        select(undef, undef, undef, 0.25);

    Note that whether select gets restarted after signals (say, SIGALRM) is implementation-dependent.

    WARNING: One should not attempt to mix buffered I/O (like read or <FH>) with select, except as permitted by POSIX, and even then only on POSIX systems. You have to use sysread instead.

    Auszug aus <http://www.perldoc.com/perl5.8.0/pod/func/select.html>

    Im Folgenden wird ausschließlich von der letztgenannten Variante "select RBITS,WBITS,EBITS,TIMEOUT" die Rede sein.

    Da die Perl-Standard-Dokumentation zu select() neben dem obigen Zitat effektiv nur noch ein kurzes, m. E. nicht sonderlich repräsentatives Beispiel in perlipc(1) bietet, die Funktion aber ein wenig eigen ist und sich in ihrem Umfeld noch mehrere andere ansonsten eher ungebräuchliche Funktionen wie fileno() oder vec() tummeln, halte ich es für angebracht, darüber ein paar Worte in Form dieses Beitrags zu verlieren.

  2. die Funktion der Funktion — in eigenen Worten

    1. Grundlegendes

      2. select() wird in Situationen aufgerufen, in denen ein oder mehrere File- und/oder Socket-Handles zu Lesen und/oder Schreiben geöffnet, jedoch nicht alle Handles dazu bereit sind, z. B. weil ein Programm seine Ausgabe erst noch "errechnen" muss oder bei einem TCP-Socket die Daten durchs Internet einige Zeit unterwegs sind. select() wartet dann, bis mindestens eines der Handles zur gewünschten Verwendung bereit ist, und teilt mit, um welche(s) es sich handelt. Optional kann eine Zeitspanne (Timeout) angegeben werden, nach der select() spätestens zurückkehren soll, d. h. auch dann, wenn zwischenzeitlich keine der angegeben Handles bereit wurden.

      Die Rest der Arbeit, d. h. das eigentliche Lesen und/oder Schreiben, wird dem Anwender bzw. der Anwenderin überlassen. Daher wird select() meist im Rahmen von Schleifen verwendet.

    2. Aufrufsyntax

      3. select() erwartet vier Argumente:

      $rbits
      eine "Liste" von Handles, bei denen darauf gewartet werden soll, dass Daten zum Lesen anstehen
      $wbits
      eine "Liste" von Handles, bei denen darauf gewartet werden soll, dass sie Daten aufnehmen können
      $ebits
      eine "Liste" von Handles, bei denen auf Exceptions gelauert werden soll
      $timeout
      die Zeitspanne, nach der select() die Kontrolle spätestens ans aufrufende Programm zurückgeben soll

      Näherer Erläuterungen bedürfen hierbei insbesondere die ersten drei Argumente, die ich bislang etwas salopp als "Liste" bezeichnet habe. Tatsächlich handelt es sich um Bit-Vektoren; aus Perls Sicht sind das im Prinzip Strings. Dabei macht man es sich zunutze, dass intern jedem Handle ein File-Deskriptor mit eindeutigen Nummer zugeordnet ist; normalerweise entspricht 0 STDIN, 1 STDOUT und 2 STDERR; die weiteren Nummern werden an die vom Programm geöffneten Handles vergeben. Die Nummer eines bestimmten Handles lässt sich mittels der Funktion fileno() ermitteln, z. B. "fileno(STDIN)", "fileno($filehandle)".

      Um select() nun mitzuteilen, dass man von Handle Nummer n lesen möchte, setze man das n-te Bit des Vektors $rbits. Dazu wiederum bietet sich die Funktion vec() an: vec($rbits, $n, 1) = 1;

      Möchte man von gar keinen Handles lesen (sondern z. B. nur auf welche schreiben), gibt man für $rbits einfach undef oder einen leeren String an; Gleiches gilt freilich für die anderen beiden Vektoren.

      $timeout wird in Sekunden angegeben. Anzumerken ist dabei, dass auch Sekundenbruchteile möglich sind. Zusammen mit dem oben Geschriebenen ergibt sich so ein netter Nebennutzen: Man kann select() auch gut als Ersatz für sleep() missbrauchen, wenn man die Ausführung eines Scripts vorübergehend anhalten möchte, ganze Sekunden aber zu ungenau wären: select(undef, undef, undef, 0.42);
      Möchte man keinen Timeout setzen, kann auch hier undef angegeben werden.

    3. Rückgabewerte

      4. Die Art und Weise, in der select() mitteilt, was nun Sache ist, steht der Aufrufsyntax in puncto Gewöhnungsbedürftigkeit keineswegs nach.

      Zuerst wären da einmal die (potenziell) beiden Rückgabewerte:

      $nfound
      enthält die Anzahl der zum Lesen oder Schreiben bereiten Handles (mithin 0, falls die Funktion aufgrund eines gesetzten $timeout zurückgekehrt ist)
      oder -1, falls ein Fehler aufgetreten ist (zu dem Details sich dann, wie gewohnt, in $! finden)
      $timeleft
      gibt die bis zum $timeout verbleibende Zeit an.
      Allerdings kann man sich (laut Perl-Dokumentation) nicht auf allen Systemen auf diesen Wert verlassen. Es erscheint daher ratsam, die Zeit lieber selbst zu berechnen, falls sie benötigt wird; Details dazu im zweiten Anwendungsbeispiel.

      Wird select() in einem skalaren Kontext aufgerufen, wird nur $nfound zurückgeliefert.

      So weit, so gut. Die im Regelfall jedoch interessanteste Information, nämlich welche Handles denn nun zum Lesen bzw. Schreiben bereit sind, enthalten diese Rückgabewerte offensichtlich nicht.

      Des Rätsels Lösung: Diese Information ist in den übergebenen Bit-Vektoren enthalten, die von select() nämlich dreisterweise verändert werden. Genauer gesagt bleiben nach Durchlaufen der Funktion in jedem Vektor nur jeweils die Bits gesetzt, die zu den lese- ($rbits) bzw. schreibbereiten ($wbits) Handles gehören.

      Also gilt es erneut, diese Vektoren mittels vec() zu analysieren, doch dazu mehr im Rahmen des (ersten) Anwendungsbeispiels.

    4. Zusammenfassung

      5. Der select()-Aufruf wird also üblicherweise in folgenden Kontext eingebettet sein:

      1. Zusammenbasteln der Bit-Vektoren
      2. Aufruf von select()
      3. Analyse des Rückgabewerts $nfound:
        < 0
        es ist ein Fehler aufgetreten; Details siehe $!
        == 0
        Timeout
        > 0
        bereite(s) Handle(s), also ran an die Analyse der Bit-Vektoren

    Da all das auch bei ausführlicher Erläuterung noch recht abstrakt sein dürfte, einige nicht ganz unwichtige Details bislang unterschlagen wurden und der tiefere Sinn des Ganzen sich erst im Kontext erschließt, wird es nun höchste Zeit für das bereits mehrfach erwähnte

  3. Anwendungsbeispiel: Daten puffern

    4. Ein Script soll Daten von Standardeingabe lesen und auf Standardausgabe ausgeben. Falls nötig, d. h. falls die Standardausgabe die Daten nicht so schnell entgegennehmen kann wie sie eingeliefert werden, soll bis zu einem Megabyte Daten zwischengepuffert werden. Können über einen Zeitraum von einer Minute weder Daten gelesen noch geschrieben werden, soll das Script abbrechen. Auf STDERR sollen Debug-Meldungen ausgegeben werden.

    Zunächst einige allgemeine Definitionen und Hilfsroutinen, die (hoffentlich) keiner weiteren Erläuterung bedürfen:

    01| #!/usr/bin/perl -Tw
02|
03| use 5.006;
04| use strict;
05| use warnings;
06|
07| use Errno 'EINTR';
08| use IO::Handle (); # stellt ->blocking (vgl. Z. 26) zur Verfuegung
09|
10| use constant BUFFSIZE => 2**20;    # 1 MB
11| use constant TIMEOUT  => 60;       # 60 Sekunden = 1 Minute
12|
13| sub bytes($) {
14|     my $bytes = shift;
15|     "$bytes byte" . ( $bytes != 1 && 's' );
16| }
17|
18| sub print_status($$$) {
19|     my ( $mode, $bytes, $bufflength ) = @_;
20|     printf STDERR "  \u%s %s; buffer now contains %s (%.1f %% full).\n",
21|                   $mode,
22|                   bytes $bytes,
23|                   bytes $bufflength,
24|                   100 * $bufflength / BUFFSIZE;
25| }
26| defined $_->blocking(0) or die "Cannot set $_ to non-blocking mode: $!\n"
27|   for \*STDIN, \*STDOUT;        # Erlaeuterungen folgen
28|
29| my $buffer = '';                # unser Zwischenspeicher
30| my $done_reading;               # Flag, ob es auf STDIN noch was zu lesen gibt
31| my $Read = my $Written = 0;     # Counter fuer die Statistik

    Damit sind alle notwendigen Vorbereitungen getroffen, und wir kommen zur Haupt-Schleife des Programms:

    33| while ( !$done_reading || length $buffer ) {
34|
35|     my $rbits = my $wbits = '';
36|     vec( $rbits, fileno STDIN , 1 ) = 1
37|       unless $done_reading || length $buffer == BUFFSIZE;
38|     vec( $wbits, fileno STDOUT, 1 ) = 1 if length $buffer;

    Diese soll grundsätzlich durchlaufen werden, solange es auf STDIN etwas zu lesen gibt oder sich noch nicht ausgegebene Daten im Puffer befinden (Zeile 33).

    In Zeilen 35 bis 38 werden die Bit-Vektoren für select() vorbereitet:

    Nun ist die Zeit für den lang ersehnten select()-Aufruf (Zeile 48) gekommen:

    40|     print STDERR "\nselect("
41|                  . join ( ',', $rbits ? 'R' : "''",
42|                                $wbits ? 'W' : "''",
43|                                'undef',
44|                                TIMEOUT
45|                         )
46|                  . ')...';
47|
48|     if ( ( my $nfound = select $rbits, $wbits, undef, TIMEOUT ) < 0 ) {
49|         if ( $! == EINTR ) { print STDERR " got signal.\n" }
50|         else { die "select(): $!\n" }
51|     }
52|
53|     elsif ( !$nfound ) {
54|         print STDERR " timed out.\n";
55|         last;
56|     }
57|
58|     else {
59|         print STDERR " returned $nfound:\n";

    Anhand des Rückgabewertes $nfound sind drei Fälle zu unterscheiden:

    $nfound < 0 (Zeilen 48 bis 51):
    select() wurde aufgrund eines Fehlers unterbrochen.
    In Erwägung gezogen werden sollte hierbei (vgl. Zeile 49), dass der Grund in einem für diesen Prozess eintreffenden System-Signals liegen könnte; dazu wird überprüft, ob der in $! enthaltene Fehlercode der aus Errno.pm importierten Konstante EINTR entspricht; falls ja, besteht kein Handlungsbedarf.
    In allen anderen (Fehler-)Fällen wird die Ausführung des Scripts abgebrochen (Zeile 50).
    $nfound == 0 (Zeilen 53 bis 56):
    select() wartete vergeblich die in TIMEOUT angegebene Zeitspanne, ohne dass STDIN oder STDOUT bereit geworden wären; die Schleife wird abgebrochen.
    $nfound > 0 (Zeilen 58 ff.)
    STDIN und/oder STDOUT sind bereit; Zeit, sich das genauer anzusehen:
    60|         if ( vec $wbits, fileno STDOUT, 1 ) {   # STDOUT bereit?
61|             unless ( defined( my $written = syswrite STDOUT, $buffer ) )
62|             {
63|                 die "syswrite(): $!\n";
64|             }
65|             elsif ( !$written ) { die "  Right side has closed its STDIN.\n" }
66|             else {
67|                 substr( $buffer, 0, $written ) = '';
68|                 $Written += $written;
69|                 print_status wrote => $written, length $buffer;
70|             }
71|         }

    In Zeile 60 wird vec() mit den gleichen Argumenten aufgerufen, mit denen in Zeile 38 das Bit für STDOUT in diesem Vektor gesetzt wurde, nur dieses Mal, ohne einen Wert zuzuweisen. Somit liefert die Funktion (nur dann) einen wahren Wert zurück, wenn dieses Bit immer noch gesetzt ist, STDOUT also bereit ist, Daten aufzunehmen, so dass die weiteren Befehle in diesem if-Block zum Tragen kommen:

    Um die Daten zu senden, kommt in Zeilen 63 bis 65 syswrite() zur Anwendung. Dabei zwar versucht, alle in $buffer enthaltenen Daten zu schreiben, durch Schalten von STDOUT in den nicht-blockierenden Modus in Zeilen 26 f. ist aber sichergestellt, dass die Funktion in jedem Fall sofort zurückkehrt und ggf. nur einen Teil der Daten sendet. Anhand des Rückgabewertes in $written sind dabei wiederum drei Fälle zu differenzieren:

    undef (Zeilen 62 bis 64)
    Es ist ein Fehler aufgetreten; das Script wird abgebrochen.
    0 (Zeile 65)
    Der Prozess, der die Ausgabe dieses Scripts seinerseits entgegennehmen sollte, wurde beendet bzw. kann dauerhaft keine weiteren Daten mehr entgegennehmen.
    > 0 (Zeilen 66 bis 70)
    $written enthält die Anzahl der geschriebenen Bytes, die daraufhin in Zeile 67 aus dem Puffer entfernt werden.

    Nun zum lesenden Teil:

    73|         if ( vec $rbits, fileno STDIN, 1 ) {    # STDIN bereit?
74|             unless (
75|                 defined(
76|                     my $read = sysread STDIN,
77|                                        $buffer,
78|                                        BUFFSIZE - length $buffer,
79|                                        length $buffer
80|                 )
81|               )
82|             {
83|                 die "sysread(): $!\n";
84|             }
85|             elsif ( !$read ) {
86|                 print STDERR "  Left side has closed its STDOUT.\n";
87|                 $done_reading = 1;
88|             }
89|             else {
90|                 $Read += $read;
91|                 print_status read => $read, length $buffer;
92|             }
93|         }

    Wie man sieht, weist der Code große strukturelle Ähnlichkeiten zum schreibenden auf, nur dass an Stelle von syswrite() sysread() zum Einsatz kommt und hierbei die maximal zu lesende Datenmenge in Zeile 78 auf den noch freien Teil des Puffers beschränkt sowie durch das Offset in Zeile 79 sichergestellt wird, dass die Daten an den Puffer angehängt werden. Wiederum wird durch den nicht-blockierenden Modus sichergestellt, dass die Funktion sofort und damit ggf. auch nach weniger gelesenen Daten zurückkehrt.

    Sofern der Prozess, von dem das Script gelesen hat, seine Ausgabe beendet und sysread() entsprechend 0 zurückgegeben hat (Zeile 85), wird in Zeile 87 das Flag $done_reading gesetzt.

    Das war's:

    94|
95|     }
96| }
97|
98| printf "\nDone: read %s, wrote %s.\n", bytes $Read, bytes $Written;

  4. Anwendungsbeispiel: whois-Abfragen

    5. Eine der größten Herausforderungen bei der Verwendung von select() innerhalb einer Schleife und mit mehreren gleichzeitigen Ein-/Ausgabekanälen besteht oft darin, sich über die einzelnen Durchläufe dieser Schleife hinweg und für jeden Kanal einzeln den aktuellen Status zu merken und entsprechend unterschiedliche Aktionen auszuführen. Dies soll im Folgenden anhand eines weiteren, komplexeren Anwendungsfalles demonstriert werden, der außerdem einige Kniffe im Zusammenhang mit TCP-Verbindungen beschreibt. (Beim im Folgenden besprochenen Script handelt es sich um eine vereinfachte Version des unter <https://www.noris.net/cgi-bin/whois> installierten.)

    Ein Script soll nähere Informationen (Inhaber(innen)daten etc.) zu einem Internet-Domain-Namen, z. B. checkts.net, ermitteln. Als Quellen der Weisheit stehen mehrere whois-Server zur Verfügung, die alle befragt werden sollen, da sie möglicherweise unterschiedliche Detailinformationen beisteuern können. Um den Benutzer oder die Benutzerin des Scripts nicht unnötig warten zu lassen, sollen die Anfragen dabei parallel durchgeführt werden. Da es weiterhin vorkommen kann, dass ein beteiligter Server gar nicht bzw. nur sehr schleppend antwortet, soll der Versuch nach maximal 42 Sekunden abgebrochen werden.

    Exkurs: whois-Abfragen

    Die Durchführung von whois-Abfragen ist recht simpel (vgl. auch RFC 954); hier ein Rezept:

    1. Man baue eine TCP-Verbindung zu Port 43 des whois-Servers auf.
    2. Man sende den Domain-Namen bzw. die eindeutige Kennung des Objekts, zu dem man nähere Auskünfte bekommen möchte, mit einem abschließenden CRLF.
    3. Der Server antwortet mehrzeilig (mit der netzwerküblichen Zeilenendkennung CRLF) und schließt die Verbindung.

    Erstmal ein paar grundsätzliche Dinge:

    001| #!/usr/bin/perl -Tw
002|
003| use 5.006;
004| use strict;
005| use warnings;
006|
007| use Errno;
008| use Fcntl;
009| use FindBin;
010| use IO::Handle;
011| use Socket;
012|
013| my ( $domain, @whoisserver ) = @ARGV;
014|
015| my $timeout = $^T + 42; # Timeout 42 Sekunden nach Scriptbeginn

    Zentrale Datenstruktur sei ein Hash of Hashes mit einem Element pro abzufragenden whois-Server; Schlüssel sei dabei der Servername (FQDN):

    016| my %whoisserver = map +( $_ => {} ), @whoisserver;

    Die einzelnen Unter-Hashes werden nach und nach folgende Elemente bekommen:

    {peer}
    eine Referenz auf eine Liste von IP-Adressen/Port-Kombinationen (sockaddr_in-Strukturen) dieses whois-Servers im gepackten Format (wie es etwa Socket::inet_aton() liefert)
    {socket}
    das Handle des TCP-Sockets zu diesem whois-Server
    {write}
    der noch ausstehende Teil der zu sendenden whois-Anfrage
    (Wird erst gesetzt, sobald die TCP-Verbindung wirklich aufgebaut ist)
    {data}
    die Antwort auf unsere whois-Anfrage
    {error}
    Fehlermeldungen im Zusammenhang mit der Abfrage dieses Servers

    Aus Effizienzgründen werden außerdem zwei eigenständige Hashes %read und %write angelegt. Die Schlüssel dieser Hashes sind ebenfalls die FQDNs der whois-Server, die Werte die Nummer des File-Deskriptors des TCP-Sockets zum jeweiligen Server. %write enthält dabei (nur) die Server, bei der unsere whois-Abfrage noch nicht (vollständig) gesendet wurde (Phasen 1 und 2 im obigen Rezept), %read diejenigen, bei denen die Abfrage bereits gesendet wurde, die Antwort aber noch nicht vollständig eingetroffen ist. Server, bei denen die Abfrage bereits vollständig abgeschlossen ist, sind in keinem der beiden Hashes enthalten.

    Beginnen wir nun mit den Verbindungsaufbauten. Normalerweise könnte der Code dazu etwa folgendermaßen aussehen:

            while ( my ( $fqdn, $w ) = each %whoisserver ) {
            if (
                $w->{socket} = new IO::Socket::INET PeerAddr => $fqdn,
                                                    PeerPort => 'whois'
            ) {
                $write{$fqdn} = fileno $w->{socket}
            }
            else { $w->{error} .= "Cannot connect: $!\n" }
        }

    Dieses Vorgehen hätte aber einen erheblichen Nachteil: Bereits ein TCP-Verbindungsaufbau via connect() kann (relativ) lange dauern. Um keine Zeit zu verlieren, sollte also nach Möglichkeit nicht gewartet werden, bis dieser abgeschlossen ist, sondern der Verbindungsaufbau nur initiiert und anschließend gleich zum nächsten übergegangen werden.

    Dazu muss das Socket vor dem connect() mittels fcntl() auf (die aus Fcntl.pm importierte Konstante) O_NDELAY gesetzt werden. connect() kehrt dann sofort mit Status false zurück, und $! meldet ein EINPROGRESS (aka "Operation in progress"); diese Konstante kann aus Errno.pm importiert werden.

    Leider bietet IO::Socket::INET meines Wissens keine Möglichkeit, diesen Mechanismus zu nutzen; wir werden das oben Geschilderte sowie all die Dinge, die dieses Modul ansonsten freundlicherweise automagisch tun würde, daher wohl oder übel zu Fuß erledigen müssen:

    017| {
018|     my %write;
019|     {
020|         defined( my $proto = getprotobyname 'tcp' )
021|           or die "Cannot get protocol number for TCP.\n";
022|
023|         defined( my $port = getservbyname 'whois', 'tcp' )
024|           or die "Cannot get port number for whois (TCP).\n";
025|
026|         while ( my ( $fqdn, $w ) = each %whoisserver ) {
027|
028|             socket $w->{socket}, PF_INET, SOCK_STREAM, $proto
029|               or die "socket(PF_INET, SOCK_STREAM, 'tcp'): $!\n";
030|
031|             fcntl $w->{socket},
032|                   F_SETFL,
033|                   ( fcntl $w->{socket}, F_GETFL, 0
034|                       or die "Cannot get flags for socket: $!\n" )
035|                   | O_NDELAY | O_NONBLOCK
036|               or die "Cannot set socket to O_NDELAY and O_NONBLOCK: $!\n";
037|
038|             {
039|                 ( undef, undef, undef, undef, my @addrs ) =
040|                   gethostbyname $fqdn;
041|                 @{ $w->{addrs} } = map scalar sockaddr_in( $port, $_ ),
042|                                        @addrs;
043|             }
044|
045|             while ( defined( my $peer = shift @{ $w->{addrs} } ) ) {
046|                 if ( connect( $w->{socket}, $peer ) || $!{EINPROGRESS} )
047|                 {
048|                     $write{$fqdn} = fileno $w->{socket};
049|                     last;
050|                 }
051|                 $w->{error} .= "connect(): $!\n";
052|             }
053|
054|         }
055|     }

    In Zeilen 31 bis 36 wird hier zunächst das erzeugte TCP-Socket auf O_NDELAY (vgl. oben) und außerdem O_NONBLOCK (mehr dazu später) gesetzt. Das etwas längere Konstrukt verbindet dabei das Auslesen der bisherigen Einstellungen des Sockets (Zeilen 33 f.) mit dem Setzen der zusätzlichen Flags, die dazu mit dem ermittelten Wert bitweise oder-verknüpft werden müssen.

    In Zeilen 38 bis 43 werden dann alle im DNS eingetragenen IP-Adressen des jeweiligen whois-Servers ermittelt und mittels der aus Socket.pm importierten Funktion sockaddr_in() für connect() mundgerecht vorbereitet.

    In Zeilen 45 bis 52 werden schließlich diese IP-Adressen durchprobiert, bis zu einer entweder ein connect() direkt klappt (was aufgrund des O_NDELAY-Modus eigentlich nicht sein kann) oder zumindest mit Status EINPROGRESS (vgl. oben) "fehlschlägt". Sobald dies der Fall ist, wird die Deskriptoren-Nummer des Sockets in %write vermerkt.

    Damit sind die Vorbereitungsarbeiten abgeschlossen, und wir kommen zum eigentlich interessanten Teil, der select() (enthaltenden) Schleife:

    056|     my %read;
057|
058|     while ( keys %write || keys %read ) {
059|
060|         my $rbits = my $wbits = '';
061|         vec( $rbits, $_, 1 ) = 1 for values %read;
062|         vec( $wbits, $_, 1 ) = 1 for values %write;
063|
064|         unless (
065|             my $nfound = select $rbits, $wbits, undef, $timeout - time
066|         ) {
067|             $whoisserver{$_}{error} .=
068|               'Timeout before receiving any data.' for keys %write;
069|             $whoisserver{$_}{error} .=
070|               'Timeout while receiving data.' for keys %read;
071|             last;
072|         }
073|         elsif ( $nfound < 0 && !$!{EINTR} ) { die "select(): $!\n" }

    Zunächst werden in Zeilen 60 bis 62 die beiden Bit-Vektoren für select() vorbereitet.

    In Zeile 65 schließlich ist es endlich soweit: select() kann aufgerufen werden. Beim ersten Durchlauf der while-Schleife wird %read noch leer, d. h. $rbits entsprechend ein leerer String sein, so dass zunächst nur auf Sockets in $wbits gewartet wird, deren connect()s abgeschlossen sind. Da select() als Timeout eine relative Zeitangabe erwartet, muss vom in $timeout enthaltenen absoluten Zeitpunkt (vgl. weiter oben Zeile 15) die aktuelle Systemzeit (ermittelt durch einen Aufruf von time()) abgezogen werden.

    Liefert der select()-Aufruf in $nfound nun 0 zurück, kam es tatsächlich zu einem Timeout, der in Zeilen 67 bis 71 behandelt wird; die umgebende while-Schleife wird dabei durch das last in Zeile 71 verlassen.

    Andernfalls wird in Zeile 73 geprüft, ob select() einen Fehler in Form eines negativen Werts zurückgeliefert hat; falls ja, wird die Ausführung des Scripts hier abgebrochen. Eine Ausnahme hiervon sollte gemacht werden, wenn select() nur aufgrund eines für diesen Prozess eintreffenden System-Signals unterbrochen wurde; in diesem Falle wäre $!{EINTR} (vgl. Errno.pm) gesetzt.

    In allen anderen Fällen können wir uns nun mit der eigentlichen Kommunikation via TCP beschäftigen.

    Betrachten wir dabei zunächst den sendenden Teil, also dem, der in Phasen eins und zwei des obigen whois-Kochrezepts zum Zuge kommt:

    074|       WRITE: for ( keys %write ) {
075|
076|             next unless vec $wbits, $write{$_}, 1;
077|
078|             unless ( defined $whoisserver{$_}{write} )
079|             {          # noch Phase 1: TCP-Verbindungsaufbau
080|                 unless ( defined( getpeername $whoisserver{$_}{socket} ) )
081|                 {      # Fehler beim TCP-Verbindungsaufbau
082|                     $whoisserver{$_}{error} .= "connect(): $!\n";
083|                     while (
084|                         defined(
085|                             my $peer = shift @{ $whoisserver{$_}{addrs} }
086|                         )
087|                       )
088|                     {
089|                         next WRITE
090|                           if connect $whoisserver{$_}{socket}, $peer
091|                              or $!{EINPROGRESS};
092|                         $whoisserver{$_}{error} .= "connect(): $!\n";
093|                     }
094|                     delete $whoisserver{$_}{socket};
095|                     delete $write{$_};
096|                     next WRITE;
097|                 }
098|                 else { # TCP-Verbindungsaufbau war erfolgreich
099|                     $whoisserver{$_}{write} = $domain . $Socket::CRLF
100|                 }
101|             }
102|
103|             unless (
104|                 defined(
105|                     my $sent = send $whoisserver{$_}{socket},
106|                                     $whoisserver{$_}{write},
107|                                     0
108|                 )
109|               )
110|             {
111|                 die "Error send()ing data to $_: $!\n";
112|             }
113|             elsif ( not $sent ) { die "Sent 0 bytes to $_!?\n" }
114|             else {
115|                 substr( $whoisserver{$_}{write}, 0, $sent ) = '';
116|                 $read{$_} = delete $write{$_}
117|                   unless length $whoisserver{$_}{write};
118|             }
119|         }

    In der umschließenden while-Schleife (Zeilen 74 bis 119) durchlaufen wir hier all diejenigen Sockets, die oben in $wbits vorkamen.

    Zunächst wird nun in Zeile 76 geprüft, ob beim jeweiligen Socket tatsächlich eine Statusänderung eingetreten, also das korrespondierende Bit in $wbits (jetzt) nach dem select()-Aufruf immer noch gesetzt ist. Ist dies nicht der Fall, gibt es insofern nichts zu tun, und der Rest der Schleife kann übersprungen werden.

    Sodann muss unterschieden werden, ob wir uns beim zu behandelnden Socket noch in Phase 1 (Verbindungsaufbau) oder bereits in Phase 2 (Anfrage senden) befinden. Das Kriterium ist dabei, ob das Hash-Element {write} bereits benutzt wurde (Zeile 78), um darin den Text der zu sendenden whois-Anfrage zwischenzuspeichern; falls nicht, befinden wir uns noch in der Phase des Verbindungsaufbaus, d. h. haben es mit einem Socket zu tun, bei dem sich seit dem vom connect()-Versuch in Zeile 46 (der mutmaßlich mit einem EINPROGRESS endete) etwas getan haben muss: Entweder er scheiterte, oder es besteht nun eine TCP-Verbindung. Eine Unterscheidung dieser beiden Fälle ermöglicht uns getpeername() (Zeile 80):

    In Zeilen 103 bis 118 erfolgt nun das eigentliche Senden der Daten; aufgrund der next-Statements in Zeilen 89 und 96 wird dieser Teil nur für Sockets erreicht, die sich bereits in Phase 2 befinden, also grundsätzlich zum Senden von Daten bereit sind.

    Das Senden der Daten erledigt die Funktion send() in Zeilen 105 bis 107. Je nach deren Rückgabewert sind nun wiederum drei Fälle zu unterscheiden:

    undef
    Es ist ein Fehler aufgetreten; wir sterben (Zeile 111).
    0
    Dieser in Zeile 113 behandelte Fall würde darauf hindeuten, dass die Gegenstelle die Verbindung beendet hat.
    sonst
    ... gibt send() die Anzahl der gesendeten Bytes zurück, die in Zeile 115 entsprechend aus dem Sendepuffer entfernt werden. Bleiben anschließend keine zu sendenden Daten mehr übrig, erfolgt in Zeilen 116 f. ein Übergang in Phase 3, indem die Deskriptorennummer des Sockets aus %write gelöscht und entsprechend in %read eingetragen wird.

    Nun zum lesenden Teil, der diejenigen Verbindungen behandelt, die sich bereits in Phase 3 befinden:

    120|         for ( keys %read ) {
121|
122|             next unless vec $rbits, $read{$_}, 1;
123|
124|             $whoisserver{$_}{data} = ''
125|               unless defined $whoisserver{$_}{data};
126|
127|             unless (
128|                 defined(
129|                     my $read = sysread $whoisserver{$_}{socket},
130|                                        $whoisserver{$_}{data},
131|                                        4096,
132|                                        length $whoisserver{$_}{data}
133|                 )
134|               )
135|             {
136|                 die "Error read()ing data from $_: $!\n";
137|             }
138|             elsif ( not $read ) {
139|                 close delete $whoisserver{$_}{socket}
140|                   or push @{ $whoisserver{$_}{error} }, "close(): $!";
141|                 delete $read{$_};
142|             }
143|         }

    Auch hier werden wieder alle Verbindungen geprüft, bei denen wir darauf warten, dass Daten zum Lesen bereit sind (Zeile 120) und dabei diejenigen gleich wieder übersprungen, bei denen dies nicht der Fall ist (Zeile 122).

    Die Initialisierung des Lese-Puffers in Zeilen 124 f. dient lediglich zur Vermeidung von Warnungen im Rahmen des folgenden sysread() in Zeilen 129 ff. Bei diesem sind — im Grunde analog zum send() weiter oben — wiederum drei Fälle zu unterscheiden:

    undef
    Es ist ein Fehler aufgetreten; wir sterben (Zeile 110).
    (Man könnte selbstverständlich darüber nachdenken, diesen Fehler nur in {error} zu vermerken und mit den übrigen Verbindungen fortzufahren, aber das hätte das Beispiel noch weiter verkompliziert.)
    0
    Die Gegenstelle hat die Verbindung beeendet; es ist also davon auszugehen, dass die Antwort nun komplett ist, und wir können diese Verbindung abschließen (Zeilen 139 f.) und vergessen (Zeil 141).
    sonst
    ... gibt sysread() die Anzahl der gelesenen Bytes zurück. Da diese jedoch bereits in den Puffer {data} gelesen wurden und die Verbindung noch nicht "fertig" ist, gibt es hier erstmal nichts weiter zu tun.

    Schleife zu...

    144|     } # Ende der in Zeile 58 beginnenden while-Schleife
145| }

    ... und fertig:

    146| print "\n$_ - ",
147|       defined $whoisserver{$_}{error} ? "FEHLER:\n$whoisserver{$_}{error}"
148|                                       :     "OK:\n$whoisserver{$_}{data}"
149|   for sort keys %whoisserver;

  5. abschließende Anmerkungen