Les Mongueurs de Perl / Groupe de travail Articles / Conférences Perl

Nous rejoindre / SVN / Relecture / Rédaction / Planning / Liens /

Publications : Linux Magazine France, Perles, Brèves, Production, Comptes-Rendus, Interviews, Traductions, Spoofathon

• Interface programmable rapidement

  Perl est un langage de script, et en cela permet de faire beaucoup plus facilement qu'en C des requêtes puis des modifications / insertions dans l'annuaire. Un autre avantage de Perl quand on travaille sur des informations nommées telles que celles que l'on trouve dans LDAP réside dans l'utilisation des hachages. Ainsi, avec les seuls utilitaires présentés ici, on peut faire énormément de choses, mais en passant toujours par le format LDIF, qu'il faut générer.

  Perl aide donc à cela, facilement et rapidement.

  Enfin, avec le remplacement de chaîne (s/// ou substr()), il est facile de se faire une sorte de patron (%U est le nom d'utilisateur, %G son groupe principal, etc) et de faire générer du LDIF ou de faire des modifications paramétrées dans l'annuaire.

• Remplacer LDIF par Net::LDAP

  Le choix d'utiliser LDIF dans nos premiers scripts est celui de l'assurance. En effet, aucune modification n'est faite dans l'annuaire, seuls des fichiers texte sont générés. Mais si LDIF est facile à utiliser pour les ajouts, il devient un enfer de volubilité quand il s'agit de faire des modifications en masse dans un annuaire. Et ce, d'autant plus quand il s'agit de faire la même modification pour toute une branche, ou tous les objets couverts par un filtre de sélection.

• Renommer les objets en masse

  Il m'est arrivé d'avoir à modifier en masse la structure de l'arbre des informations de l'annuaire (le DIT), car le modèle en OU choisi au départ s'est avéré malheureux, malaisé, bref à changer. Si cette opération devait être réalisée manuellement, ce serait une requête pour obtenir les DN des objets à renommer, puis autant de requêtes à l'utilitaire ldapmodrdn. Pas pratique, alors qu'en Perl, on interroge, on boucle sur les DN, et on renomme dans la foulée. Plus rapide, plus pratique, mais aussi plus dangereux en cas de mauvaise manipulation, encore qu'il soit tout à fait possible de tester sur quelques objets de test dans une OU de test.

C'est ainsi que nous allons voir comment utiliser Net::LDAP afin de faire nos modifications directement dans notre annuaire.

  root@ldap1# cpan Net::LDAP¶

  my $ldap = Net::LDAP->new('ldap1.example.com', port => 389, version => 3)
    or die "erreur LDAP: Impossible de contacter l'annuaire ($@)";

  my $ldap = Net::LDAP->new('ldapi://%2fvar%2frun%2fldapi_socket',
                            version => 3)

  $ldap->bind ( "cn=Manager,dc=example,dc=com", password => "secret" );

  if ( $mon_objet->sa_methode(\%entrees, \%sorties) ) {
    # Nous traitons ici dans ce bloc de code une erreur.
    ...
  }

  $mesg->code && die $mesg->error;

• LDAP_SUCCESS (0)

  Opération terminée sans erreur

• LDAP_OPERATIONS_ERROR (1)

  Le serveur a rencontré une erreur interne.

Des informations complémentaires vous sont aussi données dans les pages de manuel Net::LDAP::Message et Net::LDAP::FAQ.

Mais passons à notre première requête : ou=Paris

  #!/usr/bin/perl -w
  use strict;
  use Net::LDAP;

  my $mesg;

  my $ldap = Net::LDAP->new("ldap1.example.com", port => 389, version => 3)
     or die "erreur LDAP: Can't contact master ldap server ($@)";

  $mesg = $ldap->bind( "cn=Manager,dc=example,dc=com", password => 'secret' );
  $mesg->code && die $mesg->error;

  $mesg = $ldap->search(
    base   => 'dc=example,dc=com',
    scope  => 'sub',
    filter => '(ou=Paris)'
  );

  $mesg->code && die $mesg->error;
  foreach my $entry ($mesg->all_entries) {
    print "dn: ".$entry->dn()."\n";
    foreach my $attr ($entry->attributes) {
        foreach my $value ($entry->get_value($attr)) {
          print "$attr: $value\n";
      }
    }	
  }

  $ldap->unbind();

Notez l'imbrication des méthodes pour accéder au contenu des objets LDAP. Un fait qui peut être troublant est que la méthode attributes renvoie toujours un tableau (ou une référence sur un tableau si l'option asref => 1 est passée à la méthode get_values). Cela est dû au fait qu'il n'y a pas de différence de traitement entre les attributs multivalués et ceux qui ne le sont pas.

L'appel à la méthode unbind signifie la demande de déconnexion de l'annuaire par le programme.

La méthode search peut aussi prendre un paramètre nommé attrs qui permet de limiter la liste des attributs retournés par la requête. Par défaut, tous les attributs auxquels les listes de contrôle d'accès vous permettent d'accéder sont retournés. Si vous ne voulez que tester la présence ou non d'objets par rapport à votre filtre, spécifiez attrs => [ '1.1' ]. Vous pouvez aussi accéder aux attributs de gestion de l'annuaire, comme les horodatages sur les objets :

  $mesg =  $ldap->search(
    base   => 'dc=example,dc=com',
    scope  => 'sub',
    filter => '(&(objectClass=posixAccount)(ou=Paris))'
    attrs  => [ qw( * createTimestamp modifyTimestamp ) ]
  );

L'étoile est le joker désignant tous les attributs retournés par défaut. Ainsi, tous les attributs « normaux » sont retournés, plus createTimestamp et modifyTimestamp.

  $mesg = $ldap->add( "uid=dmitri,ou=Moscou,ou=People,dc=example,dc=com",
    attr => [
        uid           => 'dmitri',
        cn            => 'dmitri',
        objectClass   =>
            [ 'top', 'person', 'inetOrgPerson', 'posixAccount', 'shadowAccount' ],
        uidNumber     => 1007,
        gidNumber     => '513',
        userPassword  => '$pass',
        cn            => 'dmitri',
        loginShell    => '/bin/bash',
        gecos         => 'Charlie dmitri',
        description   => 'System User',
        homeDirectory => '/home/dmitri',
        sn            => 'dmitri'
    ]
  );

  #!/usr/bin/perl -w

  use strict;
  use Getopt::Std;
  use Net::LDAP;

  use vars qw($attr $val $opt_h $opt_a $opt_m $opt_d);

  sub say_usage {

    print "modldap - Modificateur simple d'attributs LDAP\n";
    print "\n\n\t$0  [-a] attribut valeur ...\n";
    print << 'EOT';

  Options:
    [-d] :			Détruire un attribut
    [-m] :			Modifier un attribut
    [-a] :			Ajouter un attribut (pour les attributs multivalués)
    [-h] :			help : montre ce texte d'aide
  EOT
    exit 0;
  }

  getopts('admh');  # Sets opt_*
  say_usage if $opt_h;

  if (! defined($attr=shift)) {
    print "ERREUR : Spécifiez un attribut LDAP à modifier\n";
    say_usage;
  };
  if (! $opt_d && ! defined($val=shift)) {
    print "ERREUR : Spécifiez une valeur pour l'attribut\n";
    say_usage;
  };

  my $ldap = Net::LDAP->new('ldap1.example.com', port => 389, version => 3)
    or die "ERREUR LDAP : Impossible de contacter l'annuaire ($@)";

  $ldap->bind ( "cn=Manager,dc=example,dc=com", password => "secret" );

  my $mesg = $ldap->search( base => 'ou=People, dc=example,dc=com',
          scope  => 'sub',
          filter => '(objectClass=*)'
          );
  $mesg->code && die $mesg->error;
  LOOP: foreach my $entry ($mesg->all_entries) {
    my $uid    = lc($entry->get_value('uid'));
    my $action = 'nop';
    my @attrl;
    $action = 'add'    if $opt_a;
    $action = 'modify' if $opt_m;
    $action = 'delete' if $opt_d;

    @attrl = $entry->get_value($attr);
    print "Old values :".join(" ", @attrl)."\n" if @attrl;

    my $newval = $val;
    $newval =~ s/\%U/$uid/g;

    ACTION: for ($action) {
      /nop/ and do {
        print "Rien à faire\n";
        last ACTION;
      };
      /add/ and do {
        print "Ajout attribut $attr à $newval\n";
        $entry->add($attr, $newval);
        $entry->update($ldap);
        last ACTION;
      };
      /modify/ and do {
        next LOOP if $newval eq $attrl[0];  # Attention ici, pas de modification
                                            # si l'attribut a déjà la bonne valeur
        print "Modification attribut $attr à $newval\n";
        $entry->replace($attr, $newval);
        $entry->update($ldap);
        last ACTION;
      };
      /delete/ and do {
        if (@attrl) {
          print "Destruction attribut $attr\n";
          $entry->delete($attr, [ ]);
          $entry->update($ldap);
        }
        last ACTION;
      };
    }
    print "-" x 60 . "\n";
  }
  $ldap->unbind;

Ce script m'a rendu maintes fois service sur des annuaires importants. N'oubliez pas que Perl sait facilement faire des manipulations (des filtres ?) sur le texte, comme par exemple la ligne $newval =~ s/\%U/$uid/g; qui permet de modifier un %U présent dans la valeur de l'attribut en l'uid du compte : pratique pour modifier un attribut tel que le répertoire racine (home directory) des comptes utilisateurs.

  #!/usr/bin/perl -w

  use strict;
  use Net::LDAP;

  my $ldap = Net::LDAP->new('ldap1.example.com', port => 389, version => 3)
    or die "erreur LDAP : Impossible de contacter l'annuaire ($@)";

  $ldap->bind ( "cn=Manager,dc=example,dc=com", password => "secret" );

  my $mesg = $ldap->search( base => "ou=People, dc=example,dc=com",
                            scope => 'sub', filter => '(objectclass=person)'
  );
  $mesg->code && die $mesg->error;
  foreach my $entry ($mesg->all_entries) {
    my $dn = $entry->dn();
    my $newrdn = $1 if $dn =~ m/([^,]+)/;
    print STDERR "$dn sera renommé en $newrdn\n";
    $mesg = $ldap->moddn( $dn, newrdn => $newrdn,
        newsuperior => "ou=Mongueurs,ou=People,dc=example,dc=com");
    $mesg->code && die "Impossible de renommer $dn : ".$mesg->error;
  }
  $ldap->unbind;

  $ ldapsearch -D "cn=Manager,dc=example,dc=com" -s sub -b 'dc=example,dc=com' \
  > -w secret -s sub -x '(objectClass=posixAccount)' -LLL dn | sed '/^$/d' | sort¶

  dn: uid=book,ou=Europe,dc=example,dc=com
  dn: uid=grinder,ou=Europe,dc=example,dc=com
  dn: uid=grinder,ou=Paris,ou=People,dc=example,dc=com
  dn: uid=leon,ou=Bath,ou=People,dc=example,dc=com
  dn: uid=leon,ou=Europe,dc=example,dc=com
  dn: uid=nicholas,ou=Europe,dc=example,dc=com
  dn: uid=nicholas,ou=London,ou=People,dc=example,dc=com
  dn: uid=sniper,ou=Paris,ou=People,dc=example,dc=com
  dn: uid=ymmv,ou=Europe,dc=example,dc=com
  dn: uid=ymmv,ou=Paris,ou=People,dc=example,dc=com

  #!/usr/bin/perl -w
  use strict;
  use Net::LDAP;
  use Data::Dumper;

  my %comptes;
  my $debug = 0;

  sub ldirread($$$)
  {
      my ( $ldapconn, $pow2, $comptes) = @_;
      print STDERR "Lecture annuaire sur ". $ldapconn->{host} ."\n" if $debug;

      my $ldap = Net::LDAP->new( $ldapconn->{host} , port => 389, version => 3 );
      $ldap->bind( $ldapconn->{cn}, password => $ldapconn->{pass} );

      my $mesg = $ldap->search( base => $ldapconn->{base}, scope  => 'sub',
          filter => $ldapconn->{filter} );

      $mesg->code && die $mesg->error;
      foreach my $entry ( $mesg->all_entries ) {
          $comptes->{$entry->get_value('uid')} |= $pow2;
      }
  }

  my $annuaire = 0;
  ldirread(
      {
          host => 'localhost', cn => 'cn=Manager, dc=example, dc=com',
          filter => '(uid=*)', pass => 'secret',
          base => 'ou=People,dc=example,dc=com',
      },
      1 << $annuaire,
      \%comptes);

  $annuaire++;
  ldirread(
      {
          host => 'localhost', cn => 'cn=Manager, dc=example, dc=com',
          filter => '(uid=*)', pass => 'secret',
          base => 'ou=Europe,dc=example,dc=com',
      },
      1 << $annuaire,
      \%comptes);

  foreach ( keys %comptes ) {
      print " !  $_ uniquement dans l'annuaire source\n" if $comptes{$_} == 1; 
      print "!!  $_ uniquement dans l'annuaire cible\n"  if $comptes{$_} == 2;
      print "    $_ dans les deux annuaires\n"           if $comptes{$_} == (1|2); 
  }
  print Dumper \%comptes if $debug;

Ainsi que vous pouvez le voir, nous créons une fonction ldirread qui se charge de lire l'un ou l'autre des annuaires. On lui passe en paramètre une référence sur un hachage qui contient l'essentiel des informations de connexion (%ldapconn dans la fonction). En plus de ces informations, nous passons aussi une variable contenant la valeur à ajouter aux valeurs existantes (quand elles existent) du troisième paramètre : le hachage global %comptes, passé par référence, qui est vu comme $comptes dans la fonction.

Ainsi, nous appelons deux fois la fonction ldirread, avec des informations de connexion différentes (dans notre cas, seule la base de recherche diffère), en ne faisant qu'incrémenter le numéro de l'annuaire. Et par la magie des puissances de deux, nous allumons un bit dans %comptes pour la présence d'un enregistrement dans les annuaires. Pour allumer ce bit, nous utilisons un ou logique, de façon à conserver la valeur précédente, et à y ajouter la valeur courante. Si la valeur pour la clé n'existe pas, ce qui est le cas lors de la lecture du premier annuaire, l'auto-vivification de Perl la crée.

Une fois que les annuaires sont lus, il suffit ensuite de relire le hachage, en regardant les valeurs pour chaque clé. Si la valeur est à 1, l'enregistrement n'est que dans le premier annuaire, si elle est à 2, il n'est que dans le second, et si elle est à 3 (en fait 1|2 qui a le bon goût de valoir 1+2 en arithmétique booléenne), l'enregistrement dont l'uid est la clé considérée est présent dans les deux annuaires.

Le résultat à l'exécution donne ceci :

  $ ./ds.pl
      grinder dans les deux annuaires
      nicholas dans les deux annuaires
  1   sniper uniquement dans l'annuaire source
      leon dans les deux annuaires
      ymmv dans les deux annuaires
   2  book uniquement dans l'annuaire cible

Libre à vous d'étendre ensuite le script avec éventuellement une troisième source, du malaxage sur les données, etc. La technique employée permet de gagner en espace mémoire, et donc en performance, en stockant pour une clé donnée une seule valeur : l'addition des annuaires dans lequel il est présent.

  check(
      name   => 'userPassword de grinder visible par manager',
      ldap   => $ldap{manager},
      base   => 'ou=People, dc=example, dc=com',
      scope  => 'sub',
      filter => '(&(objectclass=posixAccount)(uid=grinder))',
      has    => { userPassword => [ '{crypt}$1$BsSFeKPv$9SMR3ck.AA71EPG6vvA3N0' ] },
      code   => 0
  );

  #!/usr/bin/perl -w
  # vim: et ai tw=100 sw=4 ts=4

  use strict;
  use Net::LDAP;
  use Data::Dumper;

  my %comptes;
  my $debug = 1;

  sub check(@) {
      my @args = @_;
      my %parms;
      my $i = 0;

      # liste des paramètres nommés autorisés
      my $re = join "|", qw( name ldap base scope filter has code );
      $re = qr/^(?:$re)$/;
      while ( $i < @args ) {
          if ( $args[$i] =~ $re ) {
              my ( $k, $v ) = splice( @args, $i, 2 );
              $parms{$k} = $v;
          }
          else {
              $i++;
          }
      }

      # Il ne devrait plus rien rester dans @args
      die "Paramètre(s) inconnu(s): " . join( ", ", @args ) if @args;

      # Il n'y a pas de façon directe de savoir si on est connecté ou non
      die "Authentification non réalisée"
        if !defined $parms{ldap}->{net_ldap_mesg};

      # construction de la requête, profitant de la dualité
      # liste / paire (clé => valeur)
      my $mesg = $parms{ldap}->search(
          ( $parms{base}   ? ( base   => $parms{base} )   : () ),
          ( $parms{scope}  ? ( scope  => $parms{scope} )  : () ),
          ( $parms{filter} ? ( filter => $parms{filter} ) : () ),
          ( $parms{has}    ? ( attrs  => keys %{$parms{has}} )  : () ),
      );

      my $rc=0;
      $rc++ if ( $parms{code} != $mesg->code() );

      foreach my $entry ( $mesg->all_entries ) {
          foreach my $attr ( keys %{$parms{has}} ) {
              my %tab = map { $_ => 1 } $entry->get_value($attr);   
              $tab{$_}++ foreach (@{ $parms{has}->{$attr} } );
              foreach (keys %tab) {
                  $rc++ if $tab{$_} != 2
              }
          }
      }
      print ((($rc == 0) ? 'ok' : 'not ok'), (defined($parms{name})?" - $parms{name}":''),"\n");
      $rc;
  }

  my %ldap;
  my $mesg;

  $ldap{anonymous} = Net::LDAP->new( 'localhost', port => 389, version => 3 );
  $mesg = $ldap{anonymous}->bind();
  $mesg->code && die $mesg->error;

  check(
      name   => 'userPassword de grinder visible par anonymous bind',
      ldap   => $ldap{anonymous},
      base   => 'ou=People, dc=example, dc=com',
      scope  => 'sub',
      filter => '(&(objectclass=posixAccount)(uid=grinder))',
      has    => { userPassword => [ ] },
      code   => 0
  );

  $ldap{anonymous}->unbind;

  $ldap{ymmv} = Net::LDAP->new( 'localhost', port => 389, version => 3 );
  $mesg = $ldap{ymmv}->bind('uid=ymmv,ou=Paris,ou=People,dc=example,dc=com', password => 'topsecret') ;
  $mesg->code && die $mesg->error;

  check(
      name   => 'userPassword de grinder visible par ymmv',
      ldap   => $ldap{ymmv},
      base   => 'ou=People, dc=example, dc=com',
      scope  => 'sub',
      filter => '(&(objectclass=posixAccount)(uid=grinder))',
      has    => { userPassword => [ ] },
      code   => 0
  );

  $ldap{ymmv}->unbind;

  $ldap{manager} = Net::LDAP->new( 'localhost', port => 389, version => 3 );
  $mesg =
    $ldap{manager}->bind( 'cn=Manager,dc=example,dc=com', password => 'secret' );
  $mesg->code && die $mesg->error;

  check(
      name   => 'userPassword de grinder visible par manager',
      ldap   => $ldap{manager},
      base   => 'ou=People, dc=example, dc=com',
      scope  => 'sub',
      filter => '(&(objectclass=posixAccount)(uid=grinder))',
      has    => { userPassword => [ '{crypt}$1$BsSFeKPv$9SMR3ck.AA71EPG6vvA3N0' ] },
      code   => 0
  );

  check(
      name   => 'membres du groupe posix tea',
      ldap   => $ldap{manager},
      base   => 'ou=Group, dc=example, dc=com',
      scope  => 'sub',
      filter => '(&(objectclass=posixGroup)(cn=tea))',
      has    => { memberUid => [ qw(nicholas leon book ymmv) ] },
      code   => 0
  );

  $ldap{manager}->unbind;

La première partie de la fonction check s'occupe de vérifier les paramètres nommés qui sont passés, et de les récupérer dans le hachage %parms. Ensuite, la requête LDAP est construite en fonction de l'existence d'un paramètre ou d'un autre. Un point : aucune précaution n'est prise pour vérifier que des paramètres obligatoires ont bien été passés. Un simple return if not defined($parms() fera l'affaire si vous en avez besoin.

Ensuite, un mouchard, $rc, est positionné à 0 et sera incrémenté en cas de problème. Viennent enfin les boucles imbriquées de vérification du contenu des hachages attributs vers listes de valeurs. Les listes de valeurs d'attributs multivalués sont vérifiés quel que soit l'ordre retourné par la méthode get_values ou par ce qui se trouve dans $parms{has}. Cette vérification passe par la création d'un hachage temporaire %tab, dans lequel on ajoute 1 à chaque fois qu'on rencontre une valeur d'attribut. Chaque valeur étant censée avoir été rencontrée deux fois (une fois dans $parms{has}, la seconde dans get_values), il suffit de tester que toutes les valeurs du hachage %tab sont bien à 2.

À la fin de ces boucles, on affiche ok ou not ok suivi d'un éventuel nom de test, et l'on retourne $rc. Le code retour de check n'est pas testé dans notre cas, car l'affichage (?:not\s)?ok permet par la suite d'intégrer la séquence de tests avec les modules Test::* de Perl. Mais ceci est une autre histoire.

Afin d'être complet, je vous précise avoir utilisé un hachage (%ldap) pour stocker les accesseurs Net::LDAP afin d'être sûr que le test de vérification de la connexion à l'annuaire qui est fait dans la fonction check se passe bien. Ça permet en plus d'être expressif via la clé de hachage sans pour autant consommer des variables globales (et tous les my qui vont avec, il n'y a pas de petite économie ^_^).

La sortie du script ressemble à ça, ce qui permet déjà de voir d'un rapide coup d'œil ce qui passe ou non :

  ok - userPassword de grinder visible par anonymous bind
  ok - userPassword de grinder visible par ymmv
  not ok - userPassword de grinder visible par manager
  ok - membres du groupe posix tea

Pour la petite histoire, le troisème test échoue sur un des deux annuaires utilisés pour écrire cet article, mais passe sur l'autre (test écrit sur l'un, pour un mot de passe, qui est différent de l'autre annuaire, car créé aléatoirement).

• Net::LDAP::LDIF :

  Création et manipulation de LDIF à partir d'objets de type Net::LDAP::Entry. Cela peut être intéressant à utiliser en complément ou en remplacement de Data::Dumper. Le module permet de générer du LDIF sous diverses formes, comme par exemple avec un encodage base 64, ce qui autorise la sortie de chaînes de caractères UTF-8 sur un système iso-8859-1, mais aussi les photos et autres attributs binaires.

• Net::LDAP::Schema :

  Récupération et manipulation d'un schéma LDAP depuis le serveur ou un fichier LDIF (qui est un format différent de ce que demande OpenLDAP dans ses fichiers de configuration). Ce module permet d'écrire facilement sur disque un schéma OpenLDAP au format LDIF, tout en sélectionnant les classes d'objets que l'on désire. En effet, il fournit au sein de la même structure de données (un hachage) le vidage du schéma au format Net::LDAP::Entry (qui se transforme aisément en format LDIF, cf. point ci-dessus), ainsi que le découpage des objets, attributs, syntaxes, OID et règles de correspondances en hachages. Ce qui permet de retrouver rapidement ses petits.

• Net::LDAP::DSML :

  Pour ceux qui font des annuaires leur métier, ce qui comprend l'écriture de schéma. DSML (Directory Service Markup Language) est la vision XML des schémas et des données LDAP.

• Net::LDAP::RootDSE :

  Permet d'interroger la racine de l'annuaire, là où sont présentées certaines données intéressantes comme le schéma (si on veut le faire soi-même) ou les versions de protocoles supportées par le serveur.

Copyright © Les Mongueurs de Perl, 2001-2011 pour le site.
Les auteurs conservent le copyright de leurs articles.