From f5325f5e3e1c825e8b5415d2e17ab703ec5fab40 Mon Sep 17 00:00:00 2001 From: Aurélien Aptel Date: Wed, 26 Jun 2013 20:41:22 +0200 Subject: initial commit of the new tarmode test script. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 Reviewed-by: David Disseldorp Reviewed-by: Jim McDonough --- source3/script/tests/test_smbclient_tarmode.pl | 367 +++++++++++++++++++++++++ 1 file changed, 367 insertions(+) create mode 100755 source3/script/tests/test_smbclient_tarmode.pl (limited to 'source3/script') diff --git a/source3/script/tests/test_smbclient_tarmode.pl b/source3/script/tests/test_smbclient_tarmode.pl new file mode 100755 index 00000000000..f40bcc8bc77 --- /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)); +} -- cgit