Contexte

Une personne m'a demandé s'il existe des moyens de sauvegarder les attributs des fichiers. Cette personne travaille dans le domaine du stockage et me faisait part d'une problématique de restauration particulière. Il lui arrive de restaurer des données et de réaliser que les attributs standards POSIX ne sont pas restaurés correctement. Il s'agit en réalité d'un sous-ensemble des attributs, et en particulier les modes, le couple propriétaire/groupe sous la forme UID/GID, puis les dates d'accès et de modification.

Une petite exploration sur le CPAN m'a orienté vers Chroniton, mais ce projet vise à fournir un système de sauvegarde complet, et la restauration des attributs sans les données semble hors de portée du système.

Comme ce travail semble tout indiqué pour Perl, voici une manière de sauvegarder des attributs.

La sauvegarde des attributs

L'utilisation de Find::File est incontournable, d'autant qu'il s'agit d'un module du noyau de Perl. Le but est de parcourir une liste de répertoires, ou, à défaut, le répertoire courant et de lister toutes les sous-arborescences.

La fonction wanted(), appelée pour chaque fichier trouvé effectue un lstat() sur le fichier, puis affiche sur la sortie standard les informations souhaitées que sont le mode, les UID et GID, les dates d'accès et de modification et enfin du nom.

L'emploi de lstat() à la place de stat() est nécessaire pour ne pas déréférencer les liens symboliques. Enfin, et comme le mode renvoyé donne aussi le type du fichier, on lui applique un masque binaire avant de l'afficher sur la sortie standard en format CSV.

   #!/usr/bin/perl
   
   use strict;
   use warnings;
   use File::Find;
   
   my @directories_to_search = (scalar @ARGV > 0) ? @ARGV : ('.');
   
   find( \&wanted, @directories_to_search );
   
   sub wanted {
   
       my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
           $atime,$mtime,$ctime,$blksize,$blocks)
           = lstat($_);
   
       printf "%04o;%i;%i;%i;%i;%s\n",
          $mode & 07777, $uid, $gid, $atime, $mtime, $File::Find::name;
   
   }

La restauration

Ici, le seul point délicat réside dans le placement du chmod() après le chown(). En effet, dans Perl, lors d'un changement de propriétaire, les setuid bits sont supprimés. Pour notre cas de figure, cela peut s'avérer très gênant.

   #!/usr/bin/perl
   
   use strict;
   use warnings;
   
   while (my $line = <>) {
       chomp $line;
       my ($mode,$uid,$gid,$atime,$mtime,$name) = split /;/, $line;
       print $name, ' ', $mode , ' ', oct($mode), "\n";
       chown $uid, $gid, $name
           or warn "Unable to set UID/GID '$uid/$gid' on '$name': $!\n";
       chmod (oct($mode), $name)
           or warn "Unable to set mode '$mode' on '$name': $!\n";
       utime $atime, $mtime, $name
           or warn "Unable to set atime/mtime '$atime/$mtime' on '$name': $!\n";
   }

La réunion des amours

Comme ces charmants scripts sont simples, et liés fonctionnelement l'un à l'autre, il est possible de les fusionner et d'exécuter les parties adéquates en fonction du nom utilisé lors de l'invocation.

    #!/usr/bin/perl
    
    use strict;
    use warnings;
    use File::Find;
    
    if ( $0 =~ m/attr2csv/ ) {
        my @directories_to_search = ( scalar @ARGV > 0 ) ? @ARGV : ('.');
        find( \&wanted, @directories_to_search );
    }
    elsif ( $0 =~ m/csv2attr/ ) {
        while ( my $line = <> ) {
            chomp $line;
            my ( $mode, $uid, $gid, $atime, $mtime, $name ) = split /;/, $line;
            print $name, ' ', $mode, ' ', oct($mode), "\n";
            chown $uid, $gid, $name
              or warn "Unable to set UID/GID '$uid/$gid' on '$name': $!\n";
            chmod( oct($mode), $name )
              or warn "Unable to set mode '$mode' on '$name': $!\n";
            utime $atime, $mtime, $name
              or warn "Unable to set atime/mtime '$atime/$mtime' on '$name':
    $!\n";
        }
    }
    else {
        warn "$0 should be [attr2csv|csv2attr]\n";
    }
    
    sub wanted {
        my (
            $dev,  $ino,   $mode,  $nlink, $uid,     $gid,   $rdev,
            $size, $atime, $mtime, $ctime, $blksize, $blocks
        ) = lstat($_);
        printf "%04o;%i;%i;%i;%i;%s\n", $mode & 07777, $uid, $gid, $atime, $mtime,
          $File::Find::name;
    }

Et en uniligne ?

La notation est compacte et il est certain que l'on ne gagne pas énormément en lisibilité. Néanmoins, dans la partie de sauvegarde, le seul rôle de File::Find est de rechercher des fichiers, sans aucun critère. Au final, la commande find(1) remplit tout aussi bien ce rôle.

    find /emplacement/particulier | perl -lane '($d,$i,$mode,$n,$uid,$gid,$r,$s,
    $atime,$mtime,$c,$bs,$b)=lstat($_); printf "%04o;%i;%i;%i;%i;%s\n",$mode &
    07777,$uid,$gid,$atime,$mtime,$_;'

La restauration part du même principe, on pourrait écrire un uniligne qui s'occupe de décortiquer les lignes pour réaliser cette opération.

    perl -lane 'my ( $mode, $uid, $gid, $atime, $mtime, $name ) = split /;/;
    chown $uid, $gid, $name;chmod( oct($mode), $name ); utime $atime, $mtime,
    $name;' < fichier.csv

Je reconnais que pour un uniligne, il est très verbeux, même s'il n'a plus les trois print() de diagnostic.

Conclusion

En quelques lignes il est possible d'écrire une procédure très simple et pourtant très puissante, qui s'applique aussi bien à des très petits répertoires qu'à des systèmes de fichiers avec quelques centaines de milliers d'inodes.

Références

À vous !

Envoyez vos perles à perles@mongueurs.net, elles seront peut-être publiées dans un prochain numéro de Linux Magazine.