[couverture de Linux Magazine 57]

LWP, Le Web en Perl (2)

Article publié dans Linux Magazine 57, janvier 2004.

Copyright © 2004 - Philippe Bruhat.

[+ del.icio.us] [+ Developers Zone] [+ Bookmarks.fr] [Digg this] [+ My Yahoo!]

Chapeau de l'article

Dans cette deuxième partie, nous allons continuer à nous intéresser à l'utilisation avancée de LWP et étudier en détail des scripts originaux tirant pleinement partie de la puissance et de la simplicité de LWP. Nous commencerons également à regarder autour de LWP, du côté des modules de traitement du HTML.

Utilisation avancée de LWP (suite)

Les outils fournis avec LWP

LWP inclut plusieurs utilitaires dont lwp-request, qui est très utile pour tester rapidement des connexions HTTP à la main. Il s'utilise comme suit :

    $ lwp-request http://www.perdu.com/
    <html>
    <head>
    <title>
    Vous Etes Perdu ?
    </title>
    </head>
    <body>
    <h1>Perdu sur l'Internet ?</h1>
    <h2>Pas de panique, on va vous aider</h2>
    <strong><pre>    * <----- vous &ecirc;tes ici</pre></strong>
    </body>

    </html>

Les options principales sont :

Sous Unix, les scripts GET, HEAD et POST pointent en fait vers lwp-request, qui sait alors forcer la méthode (comme avec l'option -m).

Voici un exemple d'utilisation de lwp-request :

    $ lwp-request -des http://www.perdu.com/
    200 OK
    Connection: close
    Date: Fri, 28 Nov 2003 12:06:56 GMT
    Accept-Ranges: bytes
    ETag: "108004-d8-3f56cb92"
    Server: Apache/1.3.26 (Unix) Debian GNU/Linux mod_ssl/2.8.9 OpenSSL/0.9.6g PHP/4.1.2
    Content-Length: 216
    Content-Type: text/html; charset=iso-8859-1
    Last-Modified: Thu, 04 Sep 2003 05:20:18 GMT
    Client-Date: Fri, 28 Nov 2003 12:06:56 GMT
    Client-Peer: 64.62.206.195:80
    Client-Response-Num: 1
    Title: Vous Etes Perdu ?

Notez les en-têtes Client-*, qui sont rajoutés par LWP::UserAgent et donnent des informations sur le traitement effectué par LWP.

Naturellement, lwp-request supporte la variable d'environnement HTTP_PROXY, ce qui me permet par exemple de jeter un œil aux modifications faites par mon proxy basé sur HTTP::Proxy aux requêtes que j'envoie (en supprimant les en-têtes ajoutés par LWP) :

    $ HTTP_PROXY=http://localhost:8080/ lwp-request -es -m TRACE http://www.perdu.com/ | grep -v '^Client-'
    200 OK
    Date: Fri, 28 Nov 2003 16:56:12 GMT
    Via: 1.1 rose (HTTP::Proxy/0.11)
    Server: Apache/1.3.26 (Unix) Debian GNU/Linux mod_ssl/2.8.9 OpenSSL/0.9.6g PHP/4.1.2
    Content-Type: message/http

    TRACE / HTTP/1.1
    Connection: Keep-Alive
    Host: www.perdu.com
    Keep-Alive: 300
    User-Agent: lwp-request/2.01
    Via: 1.1 rose (HTTP::Proxy/0.11)

Sans proxy, l'en-tête Via disparaît :

    $ lwp-request -es -m TRACE http://www.perdu.com/ | grep -v '^Client-'
    200 OK
    Connection: close
    Date: Fri, 28 Nov 2003 16:54:44 GMT
    Server: Apache/1.3.26 (Unix) Debian GNU/Linux mod_ssl/2.8.9 OpenSSL/0.9.6g PHP/4.1.2
    Content-Type: message/http
    
    TRACE / HTTP/1.1
    Connection: close
    Host: www.perdu.com
    User-Agent: lwp-request/2.01

Fusion de fichiers de cookies

Nous allons continuer simplement en nous souvenant du petit script de conversion de fichiers de cookies du mois dernier. Cette fois-ci, nous allons essayer de créer un fusionneur de fichiers de cookies. Si vous utilisez plusieurs navigateurs, il peut être intéressant pour vous d'avoir un ensemble cohérent de cookies à votre disposition, quel que le soit le prochain navigateur que vous utiliserez.

Ce petit script, que nous appellerons mergecookies, va lire dans un fichier de configuration la liste des fichiers de cookies et leur format, puis les fusionner dans un cookie jar dédié avant de sauvegarder ce dernier dans chacun des fichiers originaux, au format adéquat.

Commençons par le commencement : le chargement des modules requis et la lecture des options de ligne de commande.

    #!/usr/bin/perl -w
    use strict;
    use HTTP::Cookies;
    use Getopt::Long;
    use File::Spec;

    # valeurs par défaut
    our %CONF = ( config => "$ENV{HOME}/.mergecookiesrc" );
    our %files;

    # paramètres de ligne de commande (cf. LM 49)
    GetOptions( \%CONF, "verbose", "config=s" );

Le fichier de configuration aura la forme suivante :

    # fichiers relatifs à $HOME ou absolus
    # Netscape et les dérivés de Mozilla utilisent "presque" le même format
    Netscape     .netscape/cookies
    Mozilla      .mozilla/book/kdtqv86o.slt/cookies.txt
    Mozilla      .phoenix/default/bt7ivopl.slt/cookies.txt

    # fichier au format natif HTTP::Cookies
    LWP          /tmp/lwp-cookies.txt

    # pas de HTTP::Cookies::Opera pour le moment :-(
    #Opera        /home/book/.opera/cookies4.dat

Nous lirons ce fichier de configuration comme suit :

    @ARGV = ( $CONF{config} );
    while (<>) {
        next if /^\s*(?:#|$)/;    # ignore commentaires et lignes blanches
        chomp;
        my ( $module, $file ) = split ( /\s+/, $_, 2 );
        $module = $module eq 'LWP' ? 'HTTP::Cookies' : "HTTP::Cookies::$module";
        $file = File::Spec->catfile( $ENV{HOME}, $file )
          unless File::Spec->file_name_is_absolute($file);    # portable

        # charge le module requis
        eval "require $module;";
        warn "Impossible de charger $module, abandon de $file\n" and next if $@;
        warn "$file n'existe pas, abandon\n" and next unless -e $file;

        # crée les objets HTTP::Cookies associés
        $files{$file} = $module->new( file => $file, ignore_discard => 1 );
        warn "Fichier $file lu, objet $module créé\n" if $CONF{verbose};
    }

À l'issue de cette phase, nous avons un hachage %file indexé par les noms des fichiers de cookies et ayant pour valeurs les objets HTTP::Cookies correspondant à ces fichiers.

Nous créons ensuite un nouvel objet HTTP::Cookies afin de réaliser la fusion de l'ensemble des cookies.

    my $cookie_jar = HTTP::Cookies->new( ignore_discard => 1 );

Note : nous utilisons le paramètre ignore_discard pour conserver tous les cookies qui peuvent l'être. Cependant la sauvegarde de certains formats (comme Mozilla ou Netscape) supprime les cookies dont la date d'expiration est dépassée.

Pour chaque cookie jar créée ci-dessus, nous allons ajouter un par un tous les cookies qu'elle contient à $cookie_jar. Si deux cookie jars contiennent le même cookie, nous choisirons celui qui expire le plus tard (car c'est logiquement celui qui a été mis à jour le plus récemment).

    my $cookie_jar = HTTP::Cookies->new( ignore_discard => 1);
    for my $cj ( values %files ) {
        $cj->scan(
            sub {
                my ( $version,   $key,    $val,     $path,    $domain, $port,
                     $path_spec, $secure, $expires, $discard, $rest ) = @_;

                # récupère un éventuel cookie du même nom
                # les cookies sont stockés en interne dans un tableau
                # (ceci casse évidemment l'encapsulation)
                my $array = $cookie_jar->{COOKIES}{$domain}{$path}{$key};

                # n'écrase que les cookies qui expirent plus tôt
                my $maxage = defined $expires ? $expires - time : undef;
                $cookie_jar->set_cookie(
                     $version,   $key,    $val,    $path,  $domain,  $port,
                     $path_spec, $secure, $maxage, $discard, $rest )
                  unless defined $array
                     and defined $expires
                     and $array->[5] > $expires;
                warn "Cookie $domain $path $key traité\n" if $CONF{verbose};
            }
        );
    }

La méthode scan() permet de passer en revue tous les cookies d'un objet HTTP::Cookies en passant les informations le concernant à un bout de code (notez le sub {} dans le code ci-dessus) utilisé comme callback.

Attention, les méthodes scan() et set_cookie() fonctionnent un peu différemment : scan() renvoie $expires, c'est-à-dire la date d'expiration du cookie (en secondes depuis le premier janvier 1970), tandis que set_cookie() attend $maxage, c'est-à-dire la durée de vie du cookie. Il n'y a qu'une soustraction à faire, mais il est facile de tomber dans le panneau.

Maintenant que nous disposons d'un objet HTTP::Cookies avec tous les cookies, il ne reste plus qu'à sauver le contenu de ce cookie jar fusionné à la place et au format de chacun des fichiers de cookie que nous avons lus.

    for my $file ( keys %files ) {
        my $class = ref $files{$file};

        # appelle la fonction save() de chaque classe sur notre objet
        no strict 'refs';
        &{"${class}::save"}( $cookie_jar, $file );
    }

Et voilà !

Envoi d'un fichier par POST

Un certain nombre de sites permettent d'envoyer (upload) des fichiers depuis votre ordinateur vers le site, à l'aide de formulaires web. Cet envoi de fichier se fait par la méthode POST, avec l'encodage multipart/form-data.

LWP supporte également ce type de requête, directement ou à travers HTML::Form. Ce type de téléchargement se fait selon la spécification MIME.

La fonction POST() définie dans HTTP::Request::Common permet de construire une requête POST. L'envoi de fichier est déclenché par la spécification d'en-tête Content-Type mise à la valeur form-data. Si l'un des champs du formulaire est une référence à un tableau, elle est comprise comme la spécification d'un fichier à envoyer.

    my $url = 'http://www.example.com/data.html';
    my $res = $ua->request(
        POST $url,
        Content_Type => 'form-data',
        Content      => [
            login    => 'book',
            password => 's3kr3t',
            file     => ['/home/book/fichier.tgz', 'fichier.tgz'],
        ]
    );

Le premier élément est le nom du fichier à envoyer, le second le nom envoyé au serveur. Des en-têtes optionnels peuvent également être fournis. Ils seront passés en paramètre.

LWP::UserAgent dispose d'une méthode post() qui est un raccourci pour request->( HTTP::Request::Common::POST( $url, ... ) ). une requête de type POST directement.

    my $res = $ua->post( $url,
        Content_Type => 'form-data',
        Content => [
            login    => 'book',
            password => 's3kr3t',
            file     => ['/home/book/fichier.tgz', 'fichier.tgz'],
        ],
    );

Un formulaire comportant un champ de type file sera transformé en un objet HTML::Form ayant un champ de type HTML::Form::FileInput. La méthode value() (ou file()) de cet objet permet de définir le nom du fichier à envoyer au serveur. Tout est géré automatiquement par LWP !

Et si vous voulez envoyer des données qui ne sont pas dans un fichier, vous pouvez utiliser la méthode content() pour mettre à jour les données directement.

Je vous renvoie à la documentation de HTTP::Request::Common pour la documentation complète de la fonction POST() et à celle de LWP::UserAgent pour la méthode post(). Vous apprendrez en autre comment fournir le contenu du fichier à l'aide d'une callback.

Authentification HTTP

Le protocole HTTP dispose d'une méthode de contrôle d'accès au contenu de certaines URL. Le protocole est assez simple, comme vous allez le voir :

Il existe d'autres modes d'authentification, standardisés par le W3C (Digest) ou pas (NTLM). LWP sait gérer ces différents modes, mais le plus fréquent reste Basic.

Il existe plusieurs manières pour un programme utilisant LWP::UserAgent de s'authentifier. Nous allons les présenter pour l'exemple du site http://www.example.com/private/ cité ci-dessus.

Notre code va commencer comme d'habitude par les lignes suivantes :

    #!/usr/bin/perl -w
    use strict;
    use LWP::UserAgent;

    my ( $user, $pass ) = qw( book s3kr3t );
    my $ua  = LWP::UserAgent->new();
    my $url = 'http://www.example.com/private/';
    my $req = HTTP::Request->new( GET => $url );

Vous avez ensuite trois possibilités :

Une fois la problématique de l'identification prise en compte, la requête est exécutée de la même façon dans nos trois exemples, pour nous retourner la réponse associée :

    my $res = $ua->request( $req );

Nous utilisons ici la méthode request(), car elle sait enchaîner plusieurs requêtes successives si nécessaire pour atteindre l'objectif. Ici, après une réponse 401, l'agent va rechercher les identifiants requis et réitérer sa requête. Dans le cas d'une réponse 301 ou 302, l'agent se chargerait de suivre automatiquement les indications données dans l'en-tête Location, pour atteindre la ressource demandée.

Connexion HTTPS

De nombreux sites utilisent le protocole HTTPS pour sécuriser les connexions. Ce protocole s'appuie sur SSL (Secure Socket Layer) pour crypter le protocole HTTP.

LWP supporte HTTPS, mais pas directement, comme nous allons le constater en essayant de contacter le site sécurisé de vente en ligne de la FSF. (Pour nos premiers tests, nous utiliserons lwp-request.)

    $ lwp-request -ds https://order.fsf.org/
    501 Protocol scheme 'https' is not supported

Cette erreur est renvoyée directement par le client LWP::UserAgent (sans consulter le serveur), qui ne supporte pas par défaut le protocole HTTPS.

Pour pouvoir vous connecter en HTTPS, vous devez avoir installé le module Crypt::SSLeay. Une fois celui-ci installé, tout fonctionne :

    $ lwp-request -des https://order.fsf.org/
    200 OK
    Connection: close
    Date: Fri, 28 Nov 2003 12:17:57 GMT
    Accept-Ranges: bytes
    ETag: "8076-5f8d-3fbd1da9"
    Server: Apache/1.3.26 Ben-SSL/1.48 (Unix) Debian GNU/Linux mod_python/2.7.8 Python/2.1.3 PHP/4.1.2
    Content-Length: 24461
    Content-Type: text/html; charset=iso-8859-1
    Last-Modified: Thu, 20 Nov 2003 20:01:45 GMT
    Client-Date: Fri, 28 Nov 2003 12:33:18 GMT
    Client-Peer: 199.232.76.171:443
    Client-Response-Num: 1
    Client-SSL-Cert-Issuer: /C=US/O=Entrust.net/OU=www.entrust.net/CPS incorp. by ref. (limits liab.)/OU=(c) 1999 Entrust.net Limited/CN=Entrust.net Secure Server Certification Authority
    Client-SSL-Cert-Subject: /C=US/ST=Massachusetts/L=Boston/O=Free Software Foundation, Inc./OU=Donations and Sales/CN=agia.fsf.org
    Client-SSL-Cipher: DES-CBC3-SHA
    Client-SSL-Warning: Peer certificate not verified
    Link: <mailto:webmasters@www.gnu.org>; rev="made"
    Title: Order from the Free Software Foundation (FSF)

Les en-têtes Client-SSL-* permettent d'obtenir des informations sur la connexion SSL.

Des variables d'environnement permettent de contrôler le fonctionnement de la connexion SSL : informations de déboggage, certificat client, proxy https, version du protocole SSL, vérification de la CA, etc. Pour plus de détails, je vous renvoie à la documentation de Crypt::SSLeay.

L'analyse de HTML

Je vais terminer ce deuxième article avec un exemple de programme complet écrit avec LWP, afin de vous montrer les techniques mises en œuvre lors de l'automatisation de scripts web.

Tout script parcourant le web de façon automatique a besoin d'analyser au moins en partie les pages HTML qu'il récupère. Hormis pour quelques cas très simples, les expressions rationnelles ne suffisent pas en général. Il existe quelques modules spécialisés pour traiter du HTML (HTML::LinkExtor, HTML::TreeBuilder, HTML::TableExtractor, HTML::FormParser, etc.), mais le module de traitement générique de HTML est HTML::Parser, que nous allons découvrir dans l'exemple qui suit.

Recherche de paquetages Debian

Utilisateur d'une distribution Debian sur mon PC à la maison, j'aime cette distribution pour la simplicité de sa mise à jour. Hélas, certains paquetages ne sont pas disponibles sur les serveurs officiels (pour des raisons de licence ou de délais de mise à jour) Heureusement, de nombreuses personnes créent des paquetages utilisables avec apt et les recensent sur http://www.apt-get.org/.

Ce site dispose d'un moteur de recherche pour vous permettre de trouver un dépôt (repository) hébergeant les paquetages que vous cherchez.

Nous allons donc construire un petit utilitaire, nommé apt-find qui va trouver les dépôts hébergeant les paquetages recherchés et nous renvoyer les lignes à ajouter à notre fichier /etc/apt/sources.list.

Le formulaire du site est très simple : il contient un champ texte pour la requête, une liste de sélection (multiple) et un bouton d'envoi.

Comme on peut accéder à ce formulaire par la méthode GET, nous allons commencer par des requêtes simples, sur le résultat desquelles nous pratiquerons l'extraction des données utiles, avant de poursuivre par l'utilisation de toutes les options du formulaire avec un objet HTML::Form.

http://www.apt-get.org/search.php?query=mplayer nous renverra donc la liste des sites où se trouvent des paquetages correspondants au critère de recherche mplayer. Nous allons donc regarder comment retrouver les informations utiles dans la page de résultats. Voici un extrait de source HTML contenant les données qui nous intéressent (le HTML a été reformaté pour être lisible) :

    <li class="verifiedsite">
    <img src="/img/check.png" width="16" height="16" alt="(Verified)" />
    <a name="entry274"></a>
    <span class="descr">
        Developer version of vdr, a few vdr-plugins and the required
        dvb-driver</span>
    <span class="timeadded">
        (Added 2003-04-16, last checked 2003-10-18)</span>
    <span class="download">
        <a href="/text/?site=274">(Download as text)</a></span>
    <span class="maintainer"> - maintained by thomas dot schmidt at in
        dot stud dot tu-ilmenau dot de</span>
    <br/>
    <span class="packages">
        <a href="/list/?site=274">Packages</a>: dvb, vdr,
            vdr-plugin-console, vdr-plugin-dvd, vdr-plugin-games,
            vdr-plugin-mp3, vdr-plugin-mplayer, vdr-plugin-stream,
            vdr-plugin-tictactoe, vdr-plugin-vcd</span><br/>
    <span class="packages">Architectures: all, i386</span><br/>
    <span class="url">
        deb <a href="http://www.stud.tu-ilmenau.de/~thsc-in/debian/">
        http://www.stud.tu-ilmenau.de/~thsc-in/debian/</a> woody main
    <br/>
        deb-src <a href="http://www.stud.tu-ilmenau.de/~thsc-in/debian/">
        http://www.stud.tu-ilmenau.de/~thsc-in/debian/</a> woody main
    <br/>

    <br/>
        deb <a href="http://www.stud.tu-ilmenau.de/~thsc-in/debian/">
        http://www.stud.tu-ilmenau.de/~thsc-in/debian/</a> unstable main
    <br/>
        deb-src <a href="http://www.stud.tu-ilmenau.de/~thsc-in/debian/">
        http://www.stud.tu-ilmenau.de/~thsc-in/debian/</a> unstable main
    <br/>
    </span><br/>
    </li>
    <li class="packagelist">
    Matches:<br/>
    vdr-plugin-mplayer 0.8.1-3.woody (i386)<br/>
    vdr-plugin-mplayer 0.8.1-4 (i386)<br/>
    <br/><br/>
    </li>

Pour analyser ce document HTML, plutôt que de nous construire une collection compliquée d'expressions rationnelles, nous allons utiliser le module HTML::Parser. Ce module permet de construire un analyseur événementiel pour notre document HTML. Dans la suite de cet article, nous parlerons uniquement de l'API version 3 de HTML::Parser.

HTML::Parser

Le module HTML::Parser (toujours par Gisle Aas) permet d'associer des routines à chaque événement pouvant se produire pendant l'analyse d'un document HTML. L'analyse peut provoquer les événements suivants :

L'initialisation de l'objet HTML::Parser permet d'associer les routines et les événements, ainsi que de définir les paramètres attendus par chaque routine.

Analyse du document HTML

Revenons au document HTML pour étudier sa structure. Chaque section est facile à repérer, grâce aux attributs des balises <li> et <span> utilisées, ce qui va nous simplifier un petit peu la tâche.

Chaque section correspondant à un nouveau dépôt commence par la balise <li class="verifiedsite">. Le texte entre <span class="url">...</span> correspond ensuite aux lignes du fichier sources.list, tandis que la liste des paquetages correspondant au critère de recherche se trouve entre <li class="packagelist">...</li>.

Enfin, chaque dépôt est identifié par une balise de type <a name="entryXXX"></a> (ou XXX est un nombre), qui est d'ailleurs la seule balise a avec un attribut name.

Il en découle que seuls les événements start, text et end nous intéresseront.

    use LWP::Simple;     # on a dit qu'on commençait simple
    use HTML::Parser;    # mais ça se complique ;-)
    use HTML::Form;

    # récupère la page web correspondant au critère de recherche
    my $content = get( "http://www.apt-get.org/search.php?query=" . shift );

    # crée un nouvel analyseur
    my $p = HTML::Parser->new();

    # définit les gestionnaires d'événements
    $p->handler( text  => \&text,  "text" );
    $p->handler( start => \&start, "tagname,attr" );
    $p->handler( end   => \&end,   "tagname" );
    $p->unbroken_text( 1 );

    # analyse le document
    $p->parse($content);
    $p->eof;

La méthode handler() permet d'associer un gestionnaire à un événement. Le premier paramètre est le nom de l'événement, suivi d'une référence à la routine gestionnaire de l'événement et le troisième donne la liste des paramètres qu'accepte la routine (je vous renvoie à la documentation de HTML::Parser pour la liste des paramètres possibles et leur signification). Ici, tagname permet d'avoir le nom de la balise et attr une référence à un hachage qui correspond à la liste des attributs. text renvoie le texte complet correspondant à l'événement. Pour start ou end, c'est la balise complète telle qu'elle apparaît dans le document HTML original.

La méthode unbroken_text permet de demander que les gestionnaires associés aux événements text soient appelés avec le texte complet. Sinon, l'analyseur peut les appeler plus tôt, avec un texte incomplet.

Il nous reste donc à écrire les trois routines associées aux événements que nous voulons traiter.

Notre automate va avoir besoin de conserver son état, que nous allons stocker dans quelques variables :

    # éléments de l'automate
    my $status = '';    # l'état courant de l'automate
    my $this;           # le dépôt en cours d'analyse
    my %data = ();      # la structure de données complète

Le gestionnaire d'événements start va permettre de modifier l'état courant de l'automate en fonction des balises rencontrées.

    sub start {
        my ( $tag, $args ) = @_;

        if ( $tag eq 'li' ) {
            # début d'un nouveau dépôt
            if ( $args->{class} eq 'verifiedsite' ) {
                $this   = {};      # nouvelle structure vide
                $status = 'NEW';
            }
            # début d'une liste de paquetages
            elsif ( $args->{class} eq 'packagelist' ) {
                $this->{pkg} = [];
                $status = 'PKG';
            }
        }

        # les entrées du sources.list
        elsif ( $tag eq 'span' ) {
            if ( $args->{class} eq 'url' ) {
                $status = 'URL';
                push @{ $this->{deb} }, "";
            }
        }

        # ici, on ajoute l'entrée en cours de création
        # dans la structure $data, avec la clé entryXXX
        elsif ( $tag eq 'a' ) {
            if ( $status eq 'NEW' ) {
                 $data{ $args->{name} } = $this if( $args->{name} );
            }
        }

        # séparateurs texte du formulaire
        elsif ( $tag eq 'br/' ) {
            if ( $status eq 'URL' ) {
                push @{ $this->{deb} }, "";
            }
            elsif ( $status eq 'PKG' ) {
                push @{ $this->{pkg} }, "";
            }
        }
    }

Le principe est simple : en fonction de la balise rencontrée et de l'état de l'automate à ce moment, on met à jour l'état courant de l'automate et éventuellement la structure de données. Par exemple pour les balises <br/> qui séparent les entrées de la liste de paquetage, on ajoute une chaîne vide au tableau des paquetages. La chaîne sera mise à jour dans le gestionnaire d'événement text.

Les événements end vont principalement nous servir à modifier l'état courant de l'automate.

    sub end {
        my $tag = shift;

        # fin des urls
        $status = 'NEW' if $tag eq 'span' and $status eq 'URL';

        # fin de la liste de paquetages
        $status = 'NEW' if $tag eq 'li'   and $status eq 'PKG';
    }

Enfin, le gestionnaire text va réaliser la collecte des données pour mettre à jour la structure.

    sub text {
        my $text = shift;

        # supprime les sauts lignes
        $text =~ y/\012\015//d;

        # texte du sources.list
        $this->{deb}[-1] .= $text if $status eq 'URL';

        # liste des paquetages (ignore la première ligne)
        if ( $status eq 'PKG' ) {
            $this->{pkg}[-1] = $text unless $text eq 'Matches:';
        }
    }

Les chaînes sont ajoutées à la fin des tableaux deb et pkg en fonction de l'état courant de l'automate.

Il ne reste plus alors qu'à afficher le contenu de la structure de données %data qui a été mise à jour par notre automate.

    for ( keys %data ) {
        print "# $_\n" for grep { $_ } @{ $data{$_}{pkg} };
        print "$_\n"   for grep { $_ } @{ $data{$_}{deb} };
        print "\n";
    }

La structure du fichier HTML, avec plusieurs <br/> qui se suivent, fait que des chaînes vides apparaîtront dans les deux listes deb et pkg. C'est la raison de la présence du grep { $_ } qui filtre les chaînes vides.

Et nous pouvons commencer à regarder notre script à l'œuvre :

    $ ./apt-find stunnel
    # webmin-stunnel 1.080-1 (all)
    deb http://www.fs.tum.de/~bunk/debian woody/bunk-2 main contrib non-free
    deb-src http://www.fs.tum.de/~bunk/debian woody/bunk-2 main contrib non-free

Options supplémentaires

Il est temps d'ajouter quelques fonctionnalités à notre script. Le formulaire à l'adresse http://www.apt-get.org/search.php est en fait beaucoup plus complet, puisqu'il permet de sélectionner les plates-formes pour lesquelles faire la recherche. Regardons ce que donne la méthode dump() de HTML::Form :

      query=
      submit=<UNDEF>                  (submit)  
      arch[]=i386                     (option)  [<UNDEF>|*i386]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|alpha]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|arm]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|hppa]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|hurd-i386]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|ia64]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|m68k]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|mipsel]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|mips]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|powerpc]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|s390]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|sh]
      arch[]=<UNDEF>                  (option)  [*<UNDEF>|sparc]
      arch[]=all                      (option)  [<UNDEF>|*all]

Par défaut, si arch[] n'est pas passé en paramètre à la requête, la recherche se fait avec les critères i386 et all. Nous allons modifier le script pour permettre à nos utilisateurs de passer des paramètres comme --powerpc pour sélectionner l'architecture pour la recherche.

Nous allons donc modifier notre script (avant la création de l'objet HTML::Parser) comme suit :

    use LWP::UserAgent;
    use HTML::Form;
    use Getop::Long;

    my $VERSION = '0.01';
    my $base    = 'http://www.apt-get.org/search.php';

    # récupère le formulaire sur le site
    my $ua = LWP::UserAgent->new( agent => "apt-find/$VERSION", env_proxy => 1 );
    my $res = $ua->request( HTTP::Request->new( GET => $base ) );
    my $form = ( HTML::Form->parse( $res->content, $base ) )[0];

Nous allons maintenant nous appuyer sur les champs <option> du formulaire pour créer les options acceptées par le script :

    # crée un hachage des inputs de type option
    my %inputs = map { ref eq 'HTML::Form::ListInput'
                     ? ( ( $_->possible_values )[1], $_ ) : () } $form->inputs;

    # création des options de ligne de commande à partir du formulaire
    my %CONF;
    Getopt::Long::Configure(qw( no_auto_abbrev ));
    GetOptions( \%CONF, "verbose|v+", (map { "$_+" } keys %inputs) )
      or die "Usage: apt-org [options] query\nValid arch options:\n@{[keys %inputs]}\n";

L'option --verbose permettra d'afficher la liste des paquetages correspondant au critère de recherche, sous forme de commentaires.

Il ne reste plus qu'à remplir le formulaire, comme nous l'avons vu le mois dernier :

    # le critère de recherche est le seul paramètre du script
    $form->value( query => shift );

    # les options du formulaire nommées "arch[]"
    for my $input
      ( grep { defined $_->name && $_->name eq 'arch[]' } $form->inputs ) {
        # coche les cases correspondant aux options du script
        my $value = ( grep { defined } $input->possible_values )[0];
        $input->value( $CONF{$value} ? $value : undef );
    }

Ainsi, si le script est appelé avec l'option --powerpc, la case correspondante dans le formulaire sera cochée. Puisque dans le cas où aucun paramètre n'est passé, le moteur de recherche utilise i386 et all (cases cochées par défaut dans le formulaire), nous n'avons donc pas à traiter le cas où aucune option n'est passée à notre script.

Reste à lancer la recherche :

    $res = $ua->request( $form->click );

L'analyseur que nous avons créé précédemment saura traiter le contenu de la réponse :

    $p->parse( $res->content );

Et nous pouvons maintenant sélectionner les paquetages correspondant seulement à notre plate-forme :

    $ ./apt-find -v --powerpc proxy
    # lbxproxy 4.3.0-0ds4 (powerpc)
    # proxymngr 4.3.0-0ds4 (powerpc)
    deb http://debian.fabbione.net/debian-ipv6 woody ipv6
    deb-src http://debian.fabbione.net/debian-ipv6 woody ipv6
    deb http://debian.fabbione.net/debian-ipv6 sarge ipv6
    deb-src http://debian.fabbione.net/debian-ipv6 sarge ipv6
    deb http://debian.fabbione.net/debian-ipv6 sid ipv6
    deb-src http://debian.fabbione.net/debian-ipv6 sid ipv6

Références

L'auteur

Philippe 'BooK' Bruhat, <book@mongueurs.net>.

Philippe Bruhat est vice-président de l'association les Mongueurs de Perl et membre du groupe Paris.pm. Il est consultant spécialisé en sécurité, et l'auteur des modules Log::Procmail, HTTP::Proxy et Regexp::Log, disponibles sur CPAN.

Merci aux membres du groupe de travail « articles » des Mongueurs de Perl pour leur relecture attentive.

[IE7, par Dean Edwards] [Validation du HTML] [Validation du CSS]