!init OPT_STYLE="paper" !define DOC_NAME "Wie ich mit Perl Apache und thttpd erschlug" !define DOC_AUTHOR "Marc Lehmann " !build_title H1: Ein reißerischer Titel Ja, theatralisch war ich schon immer ;) H2: Das Problem, das es zu lösen galt Wie bei allen meiner Programme und Module, stand am Anfang ein Problem: Ich hatte Festplatten. Damals grooose Festplatten (insgesamt 320Gb). Mit Dateien drauf. Groooosen Dateien. Beliiiebten Dateien. Filme! Animes, um genau zu sein. Und weil man das nur sehr schwer bekommt, dachte ich mir, packe sie auf einen Webserver und bring' sie unter das Volk. Und da fingen die Probleme an: "beliebt" ist leicht untertrieben. Innerhalb von fünf Tagen wuchs die Zahl der gleichzeitig offenen Verbindungen von 100 (erster Tag) auf 700. Natürlich hatte ich da schon längst von apache auf thttpd umgestellt. Einen Prozeß (oder Thread, was das gleiche ist) pro Verbindung war indiskutabel (das war mir schon vorher klar), ein Webserver wie thttpd, der alle Verbindungen in einem Prozeß bedient, ist eine Notwendigkeit. H2: Die Probleme mit thttpd Schon nach kurzer Zeit stellte sich dann heraus, daß thttpd Bugs, häßliche, zerstörerische Bugs, hatte. Ein solcher Bug war, daß thttpd zum Fileserven mmap+write benutze. Bei Dateien, die 100-700MB gross sind, ist der virtuelle Speicher schnell aufgebraucht, so daß mmap fehlschlägt. thttpd reagiert darauf mit einem "500 Internal Error". Und verloren. Da er den mmap-cache auch so einfahc nicht wieder hergibt, macht thttpd seine eigene Denial-of-Service attack... Aber, ich bin ja ein kompetenter C-Programmierer (ah, wie ich das hasse! C!), also habe ich thttpd umgeschrieben, so daß er auf read+write zurückfällt bei grossen Dateien. Danach ging es, wenn man "ging" als "korrekt, aber langsam" versteht. 7 Mbit ist nicht gerade berauschend (auf einem PC, unsere SGI von 1995 mit 13x4GB SCSI-Platten brachte es auf sage und schreibe 20MBit!). H2: Warum neuschreiben in Perl schöner war Es sollte klar sein, daß das vertreiben dieser Filme nicht legal ist. Tatsächlich gibt es eine Art ungeschriebene Übereinkunft zwischen den japanischen Firmen und "Anbietern" wie mir: solange ein Film/Serie ausserhalb Japans nicht lizensiert wurde, wird das kopieren geduldet, da es ja einen Markt schafft (zwischen Lizensierung und Verkauf liegen manchmal Jahre). Zudem steckt in den Untertitelungen von Fans auch viel Arbeit (manche Firmen kaufen die Rechte der Untertitelungen von den Fans oder schreiben mir, wenn eine Serie lizensiert wird, so daß ich sie sperren kann). Ich lege "ausserhalb Japans" etwas inkorrekt aus als: "wenn in Land X keine Lizenz bekannt ist, dürfen Leute aus Land X downloaden". Also muss ich irgendwie das Land feststellen, am besten über whois-Anfragen. Letzteres ist ein schwieriges Problem (da ARIN, die amerikanische IP-Addressen-"Registry", leider ein völlig chaotisches und teilweise nicht parsebares Format hat, während RIPE (Europa) und APNIC (Asien&Pazifik) ein standardisiertes Format verwenden) und müsste zudem asynchron im Webserver stattfinden, etwas, was ich nicht in C machen wollte. Nebenbei wollte ich nicht glauben, daß der Rechner "nur" ca. 7Mbit liefern konnte, in Perl müsste man doch mehr Leistung erreichen. H1: Der Webserver - und Coro "Zufällig" hatte ich eine Woche vor dieser Erkenntnis das Coro-Modul in einer benutzbaren Form fertiggestellt. Die Stärke von Coro ist weniger Effizienz oder Geschwindigkeit der Programme, sondern die Effizienz und Geschwindigkeit, mit der Programme geschrieben werden können. In weniger als einer Stunde hatte ich einen HTTP/1.0-Webserver, der virtual hosts, nph-cgi und byte-ranges (wichtig fürs resumes) unterstützte. In 367 Zeilen (ist als Beispiel eg/myhttpd in der Coro-Distribution). H1: Das Programm Wie jeder andere "forkende" Server, erzeugt auch dieser Webserver eine Listen-Socket und wartet auf Verbindungen: !block perl my $port = new Coro::Socket LocalAddr => $SERVER_HOST, LocalPort => $SERVER_PORT, ReuseAddr => 1, Listen => 1, or die "unable to start server"; my $connections = new Coro::Semaphore $MAX_CONNECTS; # Starte den "Accept-Prozeß" async { slog 1, "accepting connections"; while () { $connections->down; async { $_[0] or return; # accept liefert manchmal undef eval { conn->new($_[0])->handle }; close $_[0]; slog 1, "$@" if $@ && !ref $@; $connections->up; } $port->accept; } }; # Springe in die Event-Hauptschleife loop; !endblock Das Coro::Socket-Modul hat (ungefähr) die gleiche Bedienung und Semantik wie IO::Socket::INET, der Aufruf ist also nicht neues. Der nächste Abschnitt erzeugt eine Coro::Semaphore. Jedesmal, bevor eine Verbindung 'accepted' wird, wird diese Semaphore gelockt und erst wieder freigegeben, wenn die Socket wieder geschlossen wird. Dadurch wird die Zahl der offenen Filehandles effektiv begrenzt, was, zumindest bei meinem Server, dringend notwendig war (1000-2000 Verbindungen). Die Schleife um den C-Aufruf besteht im wesentlichen aus: !block perl async { eval { ... Verbindung behandeln ...}; } $port->accept; !endblock Das muß man rückwärts lesen, denn der Aufruf von C kann erst stattfinden, wenn alle Argumente vollständig sind, und C<$port->accept> kann eine sehr lange Zeit dauern, wenn keine Verbindungen aufgebaut werden. Wenn C zurückkehrt, wird eine neue Coroutine erzeugt. Die Klasse C implementiert ein "Verbindungsobjekt", C verarbeitet die Anfragen. H2: Lesen des HTTP-Headers Ein HTTP-Header besteht aus mehreren (nichtleeren) Zeilen, gefolgt von einer leeren Zeile. Ein idealer Job für C<$/>, aber in Programmen mit Coroutinen ist C<$/> gefährlich, da die Variable von allen Coroutinen gemeinsam benutzt wird. Da dies nur problematisch bei Coro::Handle ist (normaler I/O blockiert den Prozeß, ein C reicht also), besitzt die C-Methode ein optionales zweites Argument - den effektiven Wert von C<$/>. !block perl # Lese den HTTP-Request $fh->timeout($::REQ_TIMEOUT); my $req = $fh->readline("\015\012\015\012"); $fh->timeout($::RES_TIMEOUT); defined $req or $self->err(408, "request timeout"); $req =~ /^(?:\015\012)? (GET|HEAD) \040+ ([^\040]+) \040+ HTTP\/([0-9]+\.[0-9]+) \015\012/gx or $self->err(403, "method not allowed", { Allow => "GET,HEAD" }); $2 >= 2 or $self->err(506, "http protocol version not supported"); $self->{method} = $1; $self->{uri} = $2; !endblock C liefert den {{ganzen}} Request-Header, die Regex parsed nur die erste Zeile (eine Leerzeile am Anfang stammt evt. noch von einem kaputten vorherigen POST-Request. Kann ohne Keep-Alive zwar nicht passieren, aber falls persistente Connections jemals implementiert werden (sie wurden es), ist es besser, wenn der Rest damit klarkommt). Bei dieser (und der folgenden) Regex wurde auf Geschwindigkeit geachtet: Im Normalfall (kein Syntaxfehler) ist das Parsen linear, d.h. keine komplizierten Alternativen, kein non-greedy-modifier (?). Die Methode C (um etwas abzuschweifen) ist der General-Abbruch. Sie gibt eine absolut primitive Fehlerseite aus und ruft dann: !block perl die bless {}, err::; !endblock ... auf. C ist eine echte Exception-Klasse, nur eben vollkommen leer ;) Dadurch wird auch die folgende Zeile im Hauptprogramm klar: !block perl slog 1, "$@" if $@ && !ref $@; !endblock Zurück zum Header-Parsen: !block perl # Parse die Header { my (%hdr, $h, $v); $hdr{lc $1} .= ",$2" while $req =~ /\G ([^:\000-\040]+): [\008\040]* ((?: [^\015\012]+ | \015\012[\008\040] )*) \015\012 /gxc; $req =~ /\G\015\012$/ or $self->err(400, "bad request"); $self->{h}{$h} = substr $v, 1 while ($h, $v) = each %hdr; } $self->{server_port} = $self->{h}{host} =~ s/:([0-9]+)$// ? $1 : 80; !endblock Da HTTP-Header case-insensitive sind, Perl das von Haus aus aber nicht unterstützt, wird alle Header (z.B. "Content-Length") in Kleinbuchstaben gespeichert ("content-length"). Die Regex in der Schleife ist meines Wissens nach vollkommen korrekt und ließe sich auch auf andere RFC-2822-Header anwenden (News, Mail, ...). Auch hier wurde auf Geschwindgkeit geachtet. Der einfache (aber falsche) Weg wäre, den Kopf in Zeilen zu zerlegen und jede Zeile als Header betrachten. RFC2822-Header sind jedoch mehrzeilig. Für Perl jedoch kein Problem: durch den g und den c-Modifier und das \G am Anfang der Regex parsed Perl genau dort weiter, wo die vorherige Regex aufgehört hat. Die while-Schleife hört auf, sobald der Header zu Ende ist oder ein illegaler Header auftaucht. Das prüft die nächste Zeile, denn nach dem Header sollte eine einzelne, leere Zeile folgen. Die folgende Schleife kopiert den Header in den Hash C<$self->{h}>. Hier würde ich mich Fragen, was denn das C<.= ",$2"> und das C da zu suchen haben. Nun, manche Header können mehrfach vorkommen (tun dies auch), und das ist so ungefähr gleichwertig mit einem Header, in dem mehrere durch Komma getrennte Werte vorkommen. Das steht auch in C<%hdr>, mit einem "," am Anfang, was vom C weggeschnitten wird. In neueren Perl-Versionen (5.8 ;) geht das (dank Value-Sharing) mit einem: !block perl $_ = substr $_, 1 for values %hdr; !endblock Aber ich bin ja portabel... Jetzt muß der Request bearbeitet werden: !block perl $self->map_uri; $self->respond; !endblock Ok, nicht sehr beeindruckend. Hier das wichtigste von C: !block perl my $uri = $self->{uri}; # mach aus der uri was pfad-ähnliches $uri =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr hex $1/ge; $uri =~ s%//+%/%g; $uri =~ s%/\.(?=/|$)%%g; 1 while $uri =~ s%/[^/]+/\.\.(?=/|$)%%; $uri =~ m%^/?\.\.(?=/|$)% and $self->err(400, "bad request"); $self->{name} = $uri; # now do the path mapping $self->{path} = "$::DOCROOT/$host$uri"; !endblock Die vielen Regexes dienen dazu, "%xx", ".." und ähnliches in der URI aufzulösen. Am Ende sollte nirgendwo mehr ein ".." vorkommen, sonst haben wir ein Problem a'la Microsoft: !block perl 213.114.180.157 - - [11/Dec/2001:04:44:44 +0100] "GET /msadc/..%255c../..%255c../..%255c/..%c1%1c../..%c1%1c../..%c1%1c../winnt/system32/cmd.exe?/c+dir HTTP/1.0" 404 265 213.114.180.157 - - [11/Dec/2001:04:44:44 +0100] "GET /scripts/..%c1%1c../winnt/system32/cmd.exe?/c+dir HTTP/1.0" 404 231 !endblock (ein tail -f auf ein beliebiges accesslog zu einer beliebigen Zeit reicht vollkommen aus, um sowas zu finden. Man beachte, daß Microsoft Zugriffschecks und ähnliches macht, {{bevor}} die URI geparsed wird. Hätten sie es blind nach Standard gemacht, wäre der Code sicherlich einfacher. Ach ja, der Hack hätte auch nicht funktioniert, aber Microsoft macht's gerne etwas besser als es im Standard steht. Das nennt man dann "Feature", glaube ich). C ist auch nicht weiter interessant: !block perl my $path = $self->{path}; stat $path or $self->err(404, "not found"); # ich glaube nicht, daß ich mir den nächsten Kommentar # hätte verkneifen können ;) # idiotic netscape sends idiotic headers AGAIN my $ims = $self->{h}{"if-modified-since"} =~ /^([^;]+)/ ? str2time $1 : 0; if (-d _ && -r _) { # Verzeichnis if ($path !~ /\/$/) { # Redirect erzeugen, um einen "/" am Ende zu bekommen # (macht sich besser ;) $self->err(301, "moved permanently", { Location => "http://".$self->server_hostport."$self->{uri}/" }); } else { ... verzeichnis anzeigen } } elsif (-f _ && -r _) { -x _ and $self->err(403, "forbidden"); $self->handle_file($queue_file); } else { $self->err(404, "not found"); } !endblock H1: Asynchrone Ein-/Ausgabe, und warum Linux Müll ist Eigentlich wäre jetzt C an der Reihe (oder die Werbepause, machen wir zuerst die Werbepause). Ich habe den Server geschrieben, um mehr Möglichkeiten und mehr Freiheiten zu erhalten, mit dem Server herumzuexperimentieren. Er war nicht schneller als thttpd. Ein C (ist fast immer sehr lehrreich) zeigte, daß der Serevr (wie thttpd) ca 90% der Realzeit im C-syscall steckte. Das ist auch logisch, wenn mans weiß: bei, sagen wir, 800 gleichzeitigen Downloads kann man sich den read-ahead sonstwo hinstecken: er findet nicht statt (außer in Linux, aber damit rechne ich gleich ab). Deshalb ist jeder Zugriff auch ein Seek (minimum), und dauert somit mindestens 0.01s, manchmal auch doppelt oder dreimal so lang. Und in 0.01s könnte ich schon mehr als 100kb/s ins Internet blasen (100Mbit Netzwerkkarte). Leider kann der Webserver in dieser Zeit auch nichts anderes tun, er steht ja und wartet auf die Platte, obwohl er doch so viele andere Filehandles zu bedienen hätte. Viele Threads würden hier helfen (nein, falsch, aber dazu komme ich gleich), und viele Java-Anhänger kennen nur den einen Weg (klar, die Sprache {{kann}} es ja auch nicht anders, und wenn man nur einen Hammer hat, sieht eben alles wie ein Nagel aus), aber die wahre Lösung heißt: "Asynchrone Ein-/Ausgabe" Natürlich kann Linux das nicht. Noch nicht. Aber man hat ja Threads, was ja (Java zeigt es uns!) dasselbe ist, aber Perl kann leider keine Threads (nein, wirklich, Perl kann keine Threads). Also muss XS her. Dank Linux kann ich auch einfach gcc verlangen, und dank gcc kann ich closures benutzen, und dank closures kann ich errno ohne Assembler abfangen, und wenn man diesen Horror in ein Modul packt, merkts auch keiner: !block perl #undef errno #include static int aio_proc(void *thr_arg) { aio_thread *thr = thr_arg; aio_req req; int errno; /* we rely on gcc's ability to create closures. */ _syscall3(int,lseek,int,fd,off_t,offset,int,whence) _syscall3(int,read,int,fd,char *,buf,off_t,count) _syscall3(int,write,int,fd,char *,buf,off_t,count) _syscall3(int,open,char *,pathname,int,flags,mode_t,mode) _syscall1(int,close,int,fd) sigprocmask (SIG_SETMASK, &fullsigset, 0); /* then loop */ while (read (reqpipe[0], (void *)&req, sizeof (req)) == sizeof (req)) { req->thread = thr; errno = 0; if (req->type == REQ_READ || req->type == REQ_WRITE) { if (lseek (req->fd, req->offset, SEEK_SET) == req->offset) { if (req->type == REQ_READ) req->result = read (req->fd, req->dataptr, req->length); else req->result = write(req->fd, req->dataptr, req->length); } } else if (req->type == REQ_OPEN) ... req->errorno = errno; write (respipe[1], (void *)&req, sizeof (req)); } return 0; } !endblock Ja, dies ist kein Perl, sondern C (aber nicht ANSI), aber dieses Jahr soll auf dem Perl-Workshop ja mehr praktisches gezeigt werden und, so leid es mir tut, hier kommt die Wirklichkeit angerollt. Aber etwas langsamer: Das Linux-AIO-Modul ist relativ klein (C ist eben umständlich). Es startet im wesentlichen einen (oder mehrere) Thread(s), die in einer Schleife auf Anfragen (von Perl) warten, diese abarbeiten und das Ergebnis zurückmelden. Da dies in einem Thread passiert, kann der eigentliche Webserver weiterarbeiten. Als Anfragen kann man read() und write() stellen, aber auch open(), denn open kann sehr lange dauern. Eigentlich sollte man auch stat() einbauen, aber dazu bin ich noch nicht gekommen. Die Anwendung ist recht einfach, statt einem: !block perl sysread $fh, $buf, $h > $bufsize ? $bufsize : $h or last; !endblock (C springt aus einer hier nicht gezeigten Schleife), schreibt man "einfach": !block perl my $current = $Coro::current; my $r; aio_read($fh, $l, ($h > $bufsize ? $bufsize : $h), $buf, 0, sub { $r = $_[0]; $current->ready; }); &Coro::schedule; last unless $r; !endblock Ok, gelogen, es sieht umständlich und langsam aus. Es ist auch umständlich und langsam. Es ist genau so, wie ich es damals zum Testen geschrieben hatte, ohne Abstraktion (IO::Handle => Coro::Handle => Linux::AIO::Handle??). Es sieht auch heute noch so aus, denn es funktioniert und war bisher nicht das Nadelöhr. C hat die gleichen Argumente wie C und dann noch eins (den File-Offset) und dann noch eins (eine Code-Referenz, die aufgerufen wird, wenn die Daten gelesen wurden, es heißt ja nicht umsonst {{asynchrone}} Ein-/Ausgabe) und dann war's das aber. Nachdem der Lesevorgang "in Auftrag" gegeben wurde, legt sich die Coroutine schlafen: C kehrt nicht von sich aus zurück. Der Callback speichert die Anzahl der gelesenen Byte ($! ist übrigens gesetzt) in C<$r> und weckt die Coroutine wieder auf, die - früher oder später - nach C weiterläuft. H2: Linux... Jetzt kommts. AIO brachte den Webserver sofort auf 20Mbit. Toll, so shcnell war er noch nie. Aber irgendwie... irgendwie... war das wenig, denn über "Kunden" konnte sich der Webserver nicht beklagen. Was habe ich nach der Ursache gesucht. Und gesucht. Naja, vielleicht ist IDE einfach Müll, dachte ich.... Und schließlich habe ich bemerkt, daß zwar ca. 5MB/s von den Festplatten gelesen wurde, asber irgendwie nur wenig mehr als 2MB/s im Netz landeten. Merkwürdig. Zwei Wochen(!) Diskussion auf der Kernel-Liste später, war das Problem gefunden: Read-Ahead. Was normalerweise absolut notwendig ist, war hier Fatal: der Webserver liest (sagen wir mal) 256Kbyte, der Kernel hängt 128Kbyte Read-Ahead dran und 600 Filehandles später wird der Speicher knapp und der Kernel schmeißt weg - genau, die Read-Ahead-Daten. Gut, es ließ sich fixen. Ich hatte noch ein anderes Problem: Zehn parallele Threads (und ca. 10 parallele Read-Requests) sollten dem Kernel erlauben, wesentlich effizienter über die Plattenoberfläche zu Rasen als immer nur einer. Leider braucht ein einzelner Read-Request, nicht 10 (oder 9 mal) so lange, wie bei einem Thread sondern schlichtweg 80 oder 90 mal so lange. In Mbit: 7. Irgendwie ging dieses Problem auf der Kernel-Liste unter, und ergo benutze ich nur einen Thread. Sieht eh' viel hübscher aus. Und wenn die FreeBSD-Leute sich jetzt toll fühlen: wenn ich unter FreeBSD auf einen Event (kqueue) warte, bleiben alle Threads stehen. Yeah ;) (Aber die VM von FreeBSD ist geil!) H1: Back to the roots... ... Perl! Gut. Ich war schließlich bei ca. 70Mbit (immer pro Sekunde, übrigens ;) angekommen. Die restlichen 10Mbit (am Wochenende sogar 20!) waren ganz einfach zu erreichen: Diesmal waren es {{wirkllich}} die Festplatten: Wer viel Platz braucht (und kein Geld dafür ausgeben will) landet zwangsläufig bei 80GB-Maxtor-Platten. Genau, die langsamen. Eine Beschränkung auf (willkürliche) 400 Datenverbindungen gleichzeitig (also eine Art "Download-Queue") brachte diesen erhofften Durchbruch - in nur zwei Zeilen: !block perl # Am Programmanfang my $transfers = new Coro::Semaphore 400; # In handle_file, nach dem der HTTP-Response-Header # geschickt wurde: my $gaurd = $transfers->guard; !endblock C ist ähnlich wie C, leifert aber ein Objekt, das in der C-Methode ein C macht - also sobald sicht die Funktion beendet, abgebrochen wird, abstürzt.... H2: Ach ja, C und die bösen Windows-User !block perl !endblock !block perl !endblock !block perl !endblock !block perl !endblock !block perl !endblock