initial commit of the new tarmode test script.

This script will hopefully replace and improve test_smbclient_tarmode.sh.
Right now it only does normal and incremental tests.

Signed-off-by: Aurélien Aptel <aurelien.aptel@gmail.com>
Reviewed-by: David Disseldorp <ddiss@samba.org>
Reviewed-by: Jim McDonough <jmcd@samba.org>

diff --git a/source3/script/tests/test_smbclient_tarmode.pl b/source3/script/tests/test_smbclient_tarmode.pl
new file mode 100755 (executable)
index 0000000..f40bcc8
--- /dev/null
+++ b/source3/script/tests/test_smbclient_tarmode.pl
@@ -0,0 +1,367 @@
+#!/usr/bin/perl
+#
+# The plan is to make a script which will test the behaviour of
+# smbclient tar creation/restoration including its handling of:
+# - the include/exclude list (resp. I and X)
+# - the file list (F)
+# - the regex switch (r) which change the behaviour of F, I and X
+# - "newer than" (N)
+# - tar modes (full, incremental, nosystem, nohidden)
+# - archive bit removal (a)
+
+# The script will work with samba itself since there's already code
+# doing that (the "selftest" suite) but it could also work on an
+# actual windows box if there's a way or some kind of framework to do
+# some things remotely on it.
+
+# For each creation (c) test:
+# - setup the environnement (files and their attributes on the server)
+# - fetch according to the test parameters
+# - compare what the tarball contains vs. what's expected
+
+# For each restoration (x) test:
+# - setup empty environement
+# - restore
+
+# -aaptel
+
+use v5.16;
+use strict;
+use warnings;
+
+use Archive::Tar;
+use Data::Dumper;
+use Digest::MD5 qw/md5_hex/;
+use File::Basename;
+use File::Path qw/make_path remove_tree/;
+use Getopt::Std;
+use Term::ANSIColor;
+
+sub d {print Dumper @_;}
+
+my $SERVER    = $ARGV[0]; # XXX: ignored
+my $IP        = $ARGV[1]; # XXX: ignored
+my $USER      = $ARGV[2]; # XXX: ignored
+my $PW        = $ARGV[3]; # XXX: ignored
+my $LOCALPATH = $ARGV[4];
+my $TMP       = $ARGV[5];
+my $BIN       = $ARGV[6]; # XXX: valgrind?
+
+# machine + share to test
+my $SHARE = '//localhost/public';
+
+# where the share is locally stored
+$LOCALPATH //= '/media/data/smb-test';
+
+# flags to pass to every smbclient calls
+my @FLAGS = qw/-N/;
+
+# smbclient binary to use (also look in PATH)
+$BIN //= 'smbclient';
+
+# temp dir to extract tar files
+$TMP //= '/tmp/smb-tmp';
+my $TAR = "$TMP/tarmode.tar";
+my $DIR = 'tarmode';
+
+#####
+
+# RUN TESTS
+
+run_test(
+    [\&test_creation_normal],
+    [\&test_creation_incremental, '-g'],
+    [\&test_creation_incremental, 'tarmode inc'],
+);
+
+#####
+
+# TEST DEFINITIONS
+# each test must return the number of error
+
+sub test_creation_normal {
+
+    say "TEST: creation -- normal files (no attributes)";
+
+    my %files;
+    my $n = 5;
+    for(1..$n) {
+        my $f = "file-$_";
+        my $md5 = create_file(localpath($f));
+        $files{"./$DIR/$f"} = $md5;
+        set_attr(remotepath($f));
+    }
+
+    smb_tar('tarmode full', '-Tc', $TAR, $DIR);
+    return check_tar($TAR, \%files);
+}
+
+
+sub test_creation_incremental {
+    my ($mode) = @_;
+
+    say "TEST: creation -- incremental w/ $mode (backup only archived files)";
+
+    my %files;
+    my $n = 5;
+    for(1..$n) {
+        my $f = "file-$_";
+        my $md5 = create_file(localpath($f));
+
+        # set achive bit on ~half of them
+        if($_ < $n/2) {
+            $files{"./$DIR/$f"} = $md5;
+            set_attr(remotepath($f), 'a');
+        }
+    }
+
+    if($mode =~ /inc/) {
+        smb_tar('tarmode inc', '-Tc', $TAR, $DIR);
+    } else {
+        smb_tar('', '-Tcg', $TAR, $DIR);
+    }
+    return check_tar($TAR, \%files);
+}
+
+#####
+
+# IMPLEMENTATION
+
+sub run_test {
+    for(@_) {
+        my ($f, @args) = @$_;
+        reset_env();
+        my $err = $f->(@args);
+        print_res($err);
+        print "\n";
+    }
+}
+
+sub print_res {
+    my $err = shift;
+    if($err) {
+        printf " RES: %s%d ERR%s\n", color('bold red'), $err, color 'reset';
+    } else {
+        printf " RES: %sOK%s\n", color('bold green'), color 'reset';
+    }
+}
+
+sub reset_env {
+    remove_tree($TMP);
+    make_path($TMP, {mode => 0777});
+
+    remove_tree($LOCALPATH . '/'. $DIR);
+    make_path($LOCALPATH . '/'. $DIR, {mode => 0777});
+}
+
+sub check_tar {
+    my ($fn, $files) = @_;
+    my %done;
+    my (@less, @more, @diff);
+
+    for(keys %$files) {
+        $done{$_} = 0;
+    }
+
+    my $i = Archive::Tar->iter($fn, 1, {md5 => 1});
+    while(my $f = $i->()) {
+        if($f->has_content) {
+            my $p = $f->full_path;
+
+            # file that shouldn't be there
+            if(!exists $done{$p}) {
+                push @more, $p;
+                say " +    $p";
+                next;
+            }
+
+            # same file multiple times
+            if($done{$p} > 0) {
+                $done{$p}++;
+                push @more, $p;
+                printf " +%3d %s\n", $done{$p}, $p;
+                next;
+            }
+
+            $done{$p}++;
+
+            # different file
+            my $md5 = $f->data;
+            if($md5 ne $$files{$p}) {
+                say " !    $p ($md5)";
+                push @diff, $p;
+            }
+        }
+    }
+
+    # file that should have been in tar
+    @less = grep { $done{$_} == 0 } keys %done;
+    for(@less) {
+        say " -    $_";
+    }
+
+    # summary
+    printf("\t%d files, +%d, -%d, !%d\n",
+           scalar keys %done,
+           scalar @more,
+           scalar @less,
+           scalar @diff);
+    return (@more + @less + @diff); # nb of errors
+}
+
+sub localpath {
+    my $path = shift;
+    $path = '/'.$path if $path !~ m~^/~;
+    $LOCALPATH . '/' . $DIR . $path;
+}
+
+sub remotepath {
+    my $path = shift;
+    $path = '/'.$path if $path !~ m~^/~;
+    $DIR . $path;
+}
+
+
+# call smbclient and return output
+sub smb_client {
+    my $cmd = sprintf("%s %s %s",
+                      quotemeta($BIN),
+                      quotemeta($SHARE),
+                      join(' ', map {quotemeta} (@FLAGS, @_)));
+
+    my $out = `$cmd 2>&1`;
+    my $err = $?;
+    # handle abnormal exit
+    if ($err == -1) {
+        print STDERR "failed to execute $cmd: $!\n";
+    }
+    elsif ($err & 127) {
+        printf STDERR  "child died with signal %d (%s)\n", ($err & 127), $cmd;
+    }
+    elsif ($err >> 8) {
+        printf STDERR "child exited with value %d (%s)\n", ($err >> 8), $cmd;
+    }
+
+    if($err) {
+        d($out);
+        exit 1;
+    }
+    #say $cmd;
+    return $out;
+}
+
+sub smb_cmd {
+    return smb_client('-c', join(' ', @_));
+}
+
+sub smb_tar {
+    my ($cmd, @rest) = @_;
+    printf " CMD: %s\n ARG: %s\n", $cmd, join(' ', @rest);
+    smb_client((length($cmd) ? ('-c', $cmd) : ()), @rest);
+}
+
+# return a list of hash of a path on the share
+# TODO: use recurse mode to make less smbclient calls
+sub smb_ls {
+    my $path = shift;
+    my @files;
+    my $out = defined $path && length($path)
+        ? smb_client('-D', $path, '-c', 'ls')
+        : smb_cmd('ls');
+
+    for(split /\n/, $out) {
+        next if !/^  (.+?)\s+([AHSRDN]+)\s+(\d+)\s+(.+)/o;
+        my ($fn, $attr, $size, $date) = ($1, $2, $3, $4);
+        next if $fn =~ /^\.{1,2}$/;
+        push @files, {
+            'path' => $path,
+            'fn'   => $fn,
+            'size' => int($size),
+            'date' => $date,
+            'attr' => {
+                'A' => ($attr =~ /A/),
+                'H' => ($attr =~ /H/),
+                'S' => ($attr =~ /S/),
+                'R' => ($attr =~ /R/),
+                'D' => ($attr =~ /D/),
+                'N' => ($attr =~ /N/),
+            },
+        };
+    }
+    return @files;
+}
+
+# recursively list the share and return it
+sub smb_tree {
+    my ($d, $path) = @_;
+    my @files;
+
+    if(!defined $d) {
+        $d = {'fn' => '', 'attr' => {'D',1}};
+        $path = '';
+    }
+
+    @files = smb_ls($path);
+    $d->{dir} = [@files];
+
+    for my $f (@files) {
+        if($f->{attr}{D}) {
+            smb_tree($f, $path.'/'.$f->{fn});
+        }
+    }
+    return $d;
+}
+
+# print find(1)-like output of the share
+# ex: dump_tree(smb_tree())
+sub dump_tree {
+    my ($t, $path) = @_;
+    $path = '' if(!defined $path);
+
+    for my $f (@{$t->{dir}}) {
+        if($f->{attr}{D}) {
+            # print final slash on dir
+            print $path.'/'.$f->{fn},"/\n";
+            dump_tree($f, $path.'/'.$f->{fn});
+        } else {
+            print $path.'/'.$f->{fn},"\n";
+        }
+    }
+}
+
+# create file with random content, return md5 sum
+# ex: create_file('/path/on/disk')
+sub create_file {
+    my $fn = shift;
+    my $buf = '';
+    unlink $fn if -e $fn;
+    my $size = random(512, 1024);
+    open my $out, '>', $fn or die "can't open $fn: $!\n";
+    binmode $out;
+    for(1..$size) {
+        $buf .= pack('C', random(0, 256));
+    }
+    print $out $buf;
+    close $out;
+    chmod 0666;
+    return md5_hex($buf);
+}
+
+# set DOS attribute of a file
+# remove all attr and add the one provided
+# ex: set_attr('/path/on/share', 'r', 's')
+sub set_attr {
+    my ($fullpath, @flags) = @_;
+    my ($file, $dir) = fileparse($fullpath);
+
+    smb_client('-D', $dir, '-c', qq{setmode "$file" -rsha});
+    if(@flags) {
+        smb_client('-D', $dir, '-c', qq{setmode "$file" +}.join('', @flags));
+    }
+}
+
+sub random {
+    my ($min, $max) = @_;
+    ($min, $max) = ($max, $min) if($min > $max);
+     $min + int(rand($max - $min));
+}