mirror of
https://github.com/samba-team/samba.git
synced 2025-03-09 08:58:35 +03:00
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>
This commit is contained in:
Aurélien Aptel
Jim McDonough
parent
65882152cc
commit
f5325f5e3e
367
source3/script/tests/test_smbclient_tarmode.pl
Executable file
367
source3/script/tests/test_smbclient_tarmode.pl
Executable file
@ -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));
|
||||
}
|
||||
Loading…
x
Reference in New Issue
Block a user