jeudi_corrige_perl_1 [ANF Mathrice

- 1
- 2
- 3
- 4
- 5
- 6
- 7

C'est parti pour une partie de ping-pong entre listes.example.com, le serveur de listes de diffusion, et sso.example.com, le serveur CAS.

1

Il s'agit de se connecter une première fois au serveur de listes, pour initier le processus d'authentification.

On utilisera ici les modules CPAN LWP::UserAgent et HTML::Form (cf man LWP, man LWP::UserAgent, man HTML::Form)

lancer une requête pour récupérer la page d'accueil du serveur de listes 'https://listes.example.com/sympa
1. créer un client web (LWP::UserAgent)
2. créer une requête HTTP (HTTP::Request)
3. soumettre la requête
analyser la réponse renvoyée
1. extraire de l'en-tête de la réponse le cookie sympa_session, et le sauvegarder pour plus tard
2. extraire du corps de la réponse le premier formulaire (HTTP::Form)
poster ce formulaire (ce qui correspond au click du bouton Connexion)
regarder ce que l'on obtient

Le client LWP::UserAgent suit (partiellement) les redirections HTTP. Comme nous voulons les gérer nous-mêmes (pour injecter les bons coockies au bon moment), nous allons désactiver cette fonctionnalité avec l'option max_redirect⇒0.

perl

 1: use LWP::UserAgent;
 2: use HTML::Form;
 3: use strict ;
 4:
 5: my $base = 'https://listes.example.com';
 6: my $url = "$base/sympa";
 7:
 8: # on initialise le client HTTP
 9: my $ua = new LWP::UserAgent(
10:            agent => 'Mon client web en Perl a moi'
11:            , ssl_opts => { verify_hostname => 0 }
12:            , max_redirect=> 0
13:          ) ;
14:
15: # on prépare la requête
16: my $req = HTTP::Request->new( GET => $url ) ;
17:
18: # en envoie la requête et récupère la réponse
19: my $rep = $ua->request($req) ;
20: die $rep->status_line unless $rep->is_success() ;
21:
22: # on récupère le cookie sympa_session
23: my $sympa_cookie = $rep->header("Set-Cookie") ;
24: # on enlève ses attributs
25: $sympa_cookie =~ s/;.*// ;
26:
27: # on récupère les formulaires
28: my @form = HTML::Form->parse($rep, base=>$base, verbose => 1 ) ;
29:
30: # on garde le premier formulaire
31: my $form = shift(@form) ;                 # ou bien :  = $form[0] ;
32:
33: # on soumet ce formulaire
34: $rep = $ua->request( $form->click() ) ;
35:
36: # on regarde la réponse
37: printf("%s\n",$rep->as_string()) ;

On constate que l'on obtient un code de retour 302 Found, ce qui signifie que l'on est redirigé vers une nouvelle URL. Cette redirection a pour objectif de nous emmener sur le serveur CAS.

L'URL de redirection exacte se trouve dans le corps de la réponse (pour que l'internaute puisse cliquer) et aussi dans le champ d'en-tête Location.

2

Il s'agit ici d'envoyer une première requête au serveur CAS, en suivant simplement la redirection. Pour cela, nous allons construire de toute pièce une requête à l'aide de l'URL de redirection obtenue à l'étape précédente. On la soumet, et on regarde ce que l'on obtient en retour.

perl

1: # la nouvelle requête
2: $req = HTTP::Request->new( GET => $rep->header("Location") ) ;
3: $rep = $ua->request($req) ;
4:
5: # la réponse
6: printf("%s\n",$rep->as_string()) ;

On constate que l'on obtient à nouveau un 302. Suivons cette redirection (quel suspens…), en dupliquant simplement le code précédent.

Cette fois-ci, nous obtenons un 200 OK, avec la page d'authentification du serveur CAS.

3

La page obtenue précédemment contient plusieurs formulaires. Nous allons soumettre le formulaire fm1 contenu dans cette page, après avoir rempli les champs de type text, password et checkbox. On affichera au passage l'URL destination du post.

perl

 1: # on récupère les formulaires
 2: my @form = HTML::Form->parse($rep) ;
 3:
 4: # on récupère le formulaire fm1
 5: my $form ;
 6: for my $f (@form)
 7: {
 8:   next unless $f->attr("id") eq "fm1" ;
 9:   $form = $f ;
10:   last ;
11: }
12:
13: # on remplit (partiellement) le formulaire
14: for my $i ($form->inputs())
15: {
16:   next unless "|text|password|checkbox|" =~ $i->type() ;
17:   printf("%s (type: '%s', defaut: '%s') : ",$i->name(),$i->type(),$i->value()) ;
18:   my $v = <stdin> ; chomp($v) ;
19:   next unless $v=~/\S/ ;
20:   $i->value($v) ;
21: }
22:
23: # on regarde où le formulaire va être posté
24: printf("action = %s\n",$form->action()) ;
25:
26: # on soumet le formulaire
27: $rep = $ua->request( $form->click() ) ;
28:
29: # et on voit
30: printf("%s\n",$rep->as_string()) ;

L'attribut action du formulaire nous indique que le formulaire est soumis au serveur CAS.

Après soumission, nous obtenons en retour un 302 Moved Temporarily. L'en-tête Location contient une URL qui va nous ramener sur le serveur de listes.

On remarquera que l'on récupère également 2 cookies : CASPRIVACY et CASTGC.

4

On va construire de toute pièce une requête vers le serveur de listes, à l'aide de l'URL de redirection obtenue à l'étape précédente. Il s'agit simplement de fournir les 2 cookies.

On soumet la requête et on voit ce que ça donne.

perl

 1: # on construit l'en-tête contenant les cookies
 2: my $header = new HTTP::Headers ;
 3: for my $c ($rep->header("Set-Cookie"))
 4: {
 5:   $header->push_header("Cookie",$c) ;
 6: }
 7:
 8: # on construit la requête
 9: $req = new HTTP::Request("get",$rep->header("Location"),$header) ;
10:
11: # on soumet
12: $rep = $ua->request($req) ;
13:
14: # et on voit
15: printf("%s\n",$rep->as_string()) ;

On récupère en retour un 302 Found. L'URL de redirection nous laisse sur le serveur de listes.

On récupère au passage un nouveau cookie : MOD_AUTH_CAS_S.

5

Encore une fois, nous allons suivre la redirection renvoyée à l'étape précédente. Mais ici, on va envoyer le cookie MOD_AUTH_CAS_S obtenu à l'étape précédente, ainsi que le ce cookie sympa_session sauvegardé à l'étape 1.

On utilisera le module HTTP::Header pour contruire l'en-tête adéquat.

perl

 1: $header = new HTTP::Headers ;
 2: for my $c ($rep->header("Set-Cookie"))
 3: {
 4:   $header->push_header("Cookie",$c) ;
 5: }
 6:
 7: $req = new HTTP::Request("get",$rep->header("Location"),$header) ;
 8: $rep = $ua->request($req) ;
 9:
10: # et on voit
11: printf("%s\n",substr($rep->as_string(),0,2000)) ;

On récupère encore un 302, et aussi le cookie sympa_session, qu'il faudra envoyer désormais à chaque fois.

6

Pour la dernière fois, nous allons suivre la redirection proposée, tout en passant le cookie sympa_session. On va obtenir en retour la page du serveur de listes sous l'identité fournie initialement au serveur CAS.

Pour le vérifier, on va extraire de la page retournée le contenu de la division id=Identity, qui doit contenir l'identité du visiteur.

Le module HTML::TreeBuilder::XPath permet d'extraire des portions de fichiers HTML à l'aide d'une expression Xpath

perl

 1: header = new HTTP::Headers ;
 2: @h = () ;
 3: for my $c ($rep->header("Set-Cookie"))
 4: {
 5:   $c =~ s/;.*$// ;
 6:   push(@h,$c) ;
 7: }
 8: $header->push_header("Cookie",join("; ",@h)) ;
 9: print Dumper $header ;
10:
11: $req = HTTP::Request->new("GET",$url,$header ) ;
12: $rep = $ua->request($req) ;
13:
14: {
15:   use FileHandle ;
16:
17:   my $fh = new FileHandle(">out.html") or die ;
18:   $fh->print($rep->content()) ;
19:   $fh->close() ;
20: }
21:
22: use HTML::TreeBuilder::XPath;
23:
24: my $tree= new HTML::TreeBuilder::XPath->new;
25: $tree->parse($rep->content());
26: print $tree->findvalue( '/html/body//div[@id="Identity"]');

7

Pour finir, reprendre tout ce qui a été développé dans ce TP pour obtenir un programme qui met bien en évidence l'enchaînement des opérations, avec tous les détails intervenants dans le dialogue :

pour chaque requête :
- affichage de l'URL de destination
- affichage des cookies envoyés
pour chaque réponse :
- affichage du code retour
- affichage des cookies reçus
- affichage du l'URL de redirection, le cas échéant
- stockage du corps de la réponse dans un fichier, pour possible examen a posteriori

Pour cela, nous allons définir une classe MonClient qui hérite de LWP::UserAgent. MonClient aura une méthode request qui surchage la méthode de même nom de LWP::UserAgent et qui :

affiche les éléments de la requête listés ci-dessus,
attend la frappe d'une touche,
exécute la requête,
affiche les éléments de la réponse listés ci-dessus,
enregistre le corps de la réponse dans un fichier,
renvoie l'objet HTTP::Response.

Cette classe sera définie dans le fichier MonCLient.pm

perl

 1: package MonClient ;
 2: require Exporter ;
 3: our @ISA = qw(Exporter LWP::UserAgent);
 4: our @EXPORT=qw() ;
 5:
 6: use LWP::UserAgent;
 7: use HTTP::Request ;
 8: use HTTP::Response ;
 9: use FileHandle ;
10: use strict ;
11:
12: my $iresponse = 0 ;
13:
14: #--------------------
15: sub new
16: {
17:   my ($type) = @_ ;
18:   my $this ;
19:
20:   shift(@_) ;
21:   $this = $type->SUPER::new(@_) ;
22:   bless $this,$type ;
23:
24:   return $this ;
25: }
26:
27: #--------------------
28: sub request
29: {
30:   my ($this,$requete) = @_ ;
31:   shift(@_) ;
32:
33:   printf("\n\n%s\nMonClient: requete:\n\t%s %s\n\t%s = %s\n"
34:         , "-"x40
35:         , $requete->method(), $requete->uri()
36:         , "header('Cookie')", $requete->header('Cookie')
37:         ) ;
38:
39:   print "\npress a key to continue..." ;
40:   <STDIN> ;
41:
42:   my $response = $this->SUPER::request(@_) ;
43:
44:   my $filename = sprintf("content#%d.html",++$iresponse) ;
45:
46:   printf("\nMonClient: reponse:\n\tcode() = %s\n\tmessage() = %s\n"
47:         , $response->code(), $response->message()
48:         ) ;
49:
50:   printf("\theader('Set-Cookie') = %s\n", scalar($response->header('Set-Cookie')))
51:                 if $response->header('Set-Cookie') ;
52:
53:   printf("\theader('Location') = %s\n", $response->header('Location'))
54:                 if $response->header('Location') ;
55:
56:   printf("\tcontent() : voir le fichier '%s'\n", $filename) ;
57:
58:   my $fh = new FileHandle(">$filename") || die $! ;
59:   $fh->print($response->content()) ;
60:   $fh->close() ;
61:
62:   return $response ;
63: }
64:
65: 1 ;

Le programme n'a plus alors qu'à utiliser MonCLient à la place de LWP::UserAgent.

perl

  1: #!/usr/bin/perl
  2:
  3: use HTML::Form;
  4: use HTML::TreeBuilder::XPath;
  5: use MonClient ;
  6: use strict ;
  7:
  8: # Q1
  9:
 10: my $base = 'https://listes.example.com';
 11: my $url = "$base/sympa";
 12:
 13: # on initialise le client HTTP
 14: my $ua = new MonClient(
 15:          agent => 'Mon client web en Perl a moi'
 16:          , ssl_opts => { verify_hostname => 0 }
 17:          , max_redirect=> 0
 18:          ) ;
 19:
 20: # on prépare la requête
 21: my $req = HTTP::Request->new( GET => $url ) ;
 22:
 23: # en envoie la requête et récupère la réponse
 24: my $rep = $ua->request($req) ;
 25: die $rep->status_line if not $rep->is_success() ;
 26:
 27: # on récupère le cookie sympa_session
 28: my $sympa_cookie = $rep->header("Set-Cookie") ;
 29: # on enlève ses attributs
 30: $sympa_cookie =~ s/;.*// ;
 31:
 32: # on récupère les formulaires
 33: my @form = HTML::Form->parse($rep, base=>$base, verbose => 1 ) ;
 34:
 35: # on garde le premier formulaire
 36: my $form = shift(@form) ;                 # ou bien :  = $form[0] ;
 37:
 38: # on soumet ce formulaire
 39: $rep = $ua->request( $form->click() ) ;
 40:
 41: # Q2
 42:
 43: # on suit 2 redirections
 44:
 45: $req = HTTP::Request->new( GET => $rep->header("Location") ) ;
 46: $rep = $ua->request($req) ;
 47:
 48: $req = HTTP::Request->new( GET => $rep->header("Location") ) ;
 49: $rep = $ua->request($req) ;
 50:
 51: # Q3
 52:
 53: # on récupère les formulaires
 54: my @form = HTML::Form->parse($rep) ;
 55:
 56: # on récupère le formulaire fm1
 57: my $form ;
 58: for my $f (@form)
 59: {
 60:   next unless $f->attr("id") eq "fm1" ;
 61:   $form = $f ;
 62:   last ;
 63: }
 64:
 65: # on remplit (partiellement) le formulaire
 66: for my $i ($form->inputs())
 67: {
 68:   next unless "|text|password|checkbox|" =~ $i->type() ;
 69:   printf("%s (type: '%s', defaut: '%s') : ",$i->name(),$i->type(),$i->value()) ;
 70:   my $v = <stdin> ; chomp($v) ;
 71:   next unless $v=~/\S/ ;
 72:   $i->value($v) ;
 73: }
 74:
 75: # on soumet le formulaire
 76: $rep = $ua->request( $form->click() ) ;
 77:
 78: # Q4
 79:
 80: $req = new HTTP::Request("GET",$rep->header("Location")) ;
 81: $rep = $ua->request($req) ;
 82:
 83: # Q5
 84:
 85: my $header = new HTTP::Headers ;
 86: my @h = () ;
 87: for my $c ($rep->header("Set-Cookie"))
 88: {
 89:   $c =~ s/;.*$// ;
 90:   push(@h,$c) ;
 91: }
 92: push(@h,$sympa_cookie) ;
 93: $header->push_header("Cookie",join("; ",@h)) ;
 94:
 95: $req = new HTTP::Request("GET",$rep->header("Location"),$header) ;
 96: $rep = $ua->request($req) ;
 97:
 98: # Q6
 99:
100: $header = new HTTP::Headers ;
101: @h = () ;
102: for my $c ($rep->header("Set-Cookie"))
103: {
104:   $c =~ s/;.*$// ;
105:   push(@h,$c) ;
106: }
107: $header->push_header("Cookie",join("; ",@h)) ;
108:
109: $req = HTTP::Request->new("GET",$url,$header ) ;
110: $rep = $ua->request($req) ;
111:
112: my $tree= new HTML::TreeBuilder::XPath->new;
113: $tree->parse($rep->content());
114: printf("\nidentite de la connexion: %s\n", $tree->findvalue( '/html/body//div[@id="Identity"]')) ;