git.gag.com Git - debian/amanda/blob - installcheck/Amanda_Util.pl

   1 # Copyright (c) 2008, 2009, 2010 Zmanda, Inc.  All Rights Reserved.
   2 #
   3 # This program is free software; you can redistribute it and/or modify it
   4 # under the terms of the GNU General Public License version 2 as published
   5 # by the Free Software Foundation.
   6 #
   7 # This program is distributed in the hope that it will be useful, but
   8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   9 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  10 # for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License along
  13 # with this program; if not, write to the Free Software Foundation, Inc.,
  14 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  15 #
  16 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
  17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  18
  19 use Test::More tests => 130;
  20
  21 use lib "@amperldir@";
  22 use warnings;
  23 use strict;
  24 use Data::Dumper;
  25 use Amanda::Util qw(slurp burp safe_overwrite_file);
  26 use Installcheck;
  27 use POSIX;
  28
  29 # Data::Dumper is used to output strings with control characters
  30 # in them, below
  31 $Data::Dumper::Useqq = 1;  # quote strings
  32 $Data::Dumper::Terse = 1;  # no $VAR1 = ..
  33 $Data::Dumper::Indent = 0; # no newlines
  34
  35 # most of Amanda::Util is tested via running applications that use it
  36
  37 # Test hexencode/hexdecode lightly (they have a "make check" test)
  38 is(Amanda::Util::hexencode("hi"), "hi", "no encoding needed");
  39 is(Amanda::Util::hexencode("hi!"), "hi%21", "encoding");
  40 is(Amanda::Util::hexdecode("hi%21"), "hi!", "decoding");
  41 ok(!eval {Amanda::Util::hexdecode("%"); 1}, "decoding error throws exception");
  42
  43 # Tests for quote_string and unquote string.  First, some fuzzing of the
  44 # quote + unquote round-trip.
  45 my @fuzzstrs = (
  46     '',
  47     'abcd',
  48     '"',
  49     '""',
  50     '\\',
  51     "\t", "\r", "\n", "\f",
  52     '\\\\\\\\', # memory overflow?
  53     'backslash\nletter',
  54     'backslash\tletter',
  55     '"quoted"',
  56     "line\nanother", # real newline
  57     "ends with slash\\",
  58     '"starts with quote',
  59     'ends with quote"',
  60     "single'quote",
  61 );
  62
  63 for my $fuzzstr (@fuzzstrs) {
  64     is(Amanda::Util::unquote_string(Amanda::Util::quote_string($fuzzstr)), $fuzzstr,
  65         "fuzz " . Dumper($fuzzstr));
  66 }
  67
  68 # since users often provide quoted strings (e.g., in config files), test that chosen
  69 # quoted strings are correctly unquoted.  The need to quote the quoted strings for perl
  70 # makes this a little hard to read..
  71 my %unquote_checks = (
  72     '""' => '',
  73     'abcd' => 'abcd',
  74     '"abcd"' => 'abcd',
  75     '"\t"' => "\t",
  76     '"\r"' => "\r",
  77     '"\n"' => "\n",
  78     '"\f"' => "\f",
  79     '"\t"' => "\t",
  80     '"\\\\n"' => '\n', # literal \
  81     '"\\\\"' => "\\",
  82     '"\""' => "\"",
  83 );
  84
  85 while (my ($qstr, $uqstr) = each %unquote_checks) {
  86     is(Amanda::Util::unquote_string($qstr), $uqstr,
  87         "unquote " . Dumper($qstr));
  88 }
  89
  90 for my $a (keys %unquote_checks) {
  91     for my $b ("unquoted", "\"quoted str\"") {
  92         my ($a_out, $b_out) = Amanda::Util::skip_quoted_string("$a $b");
  93         is_deeply([$a_out, $b_out], [$a, $b],
  94             "skip_quoted string over " . Dumper("$a $b"));
  95     }
  96 }
  97
  98 is_deeply([ Amanda::Util::skip_quoted_string("foobar") ],
  99           [ "foobar", undef ],
 100    "skip_quoted_string with one quoted string");
 101
 102 is_deeply([ Amanda::Util::skip_quoted_string("foo  bar") ],
 103           [ "foo", " bar" ],
 104    "skip_quoted_string with two spaces keeps second space");
 105
 106 is_deeply([ Amanda::Util::skip_quoted_string("foo\tbar") ],
 107           [ "foo", "bar" ],
 108    "skip_quoted_string with a tab still splits");
 109
 110 is_deeply([ Amanda::Util::split_quoted_string_friendly("a b c d") ],
 111           [ qw(a b c d) ],
 112           "split_quoted_string_friendly with a basic split");
 113
 114 is_deeply([ Amanda::Util::split_quoted_string_friendly("\ta   b\nc \t \td   ") ],
 115           [ qw(a b c d) ],
 116           "split_quoted_string_friendly with extra whitespace");
 117
 118 is_deeply([ Amanda::Util::split_quoted_string_friendly("") ],
 119           [ ],
 120           "split_quoted_string_friendly with empty string");
 121
 122 is_deeply([ Amanda::Util::split_quoted_string_friendly("\n\t ") ],
 123           [ ],
 124           "split_quoted_string_friendly with just whitespace");
 125
 126 is_deeply([ Amanda::Util::split_quoted_string_friendly("\n\"hi there\"\t ") ],
 127           [ 'hi there' ],
 128           "split_quoted_string_friendly with one string (containing whitespace)");
 129
 130 my @try_bracing = (
 131     [ 'abc' ],
 132     [ 'abc', 'def' ],
 133     [ 'abc', 'def', 'ghi' ],
 134     [ 'a,b', 'c' ],
 135     [ 'a', 'b,c' ],
 136     [ 'a', 'b,c', 'd' ],
 137     [ 'a{b', 'c' ],
 138     [ 'a', 'b{c' ],
 139     [ 'a', 'b{c', 'd' ],
 140     [ 'a}b', 'c' ],
 141     [ 'a', 'b}c' ],
 142     [ 'a', 'b}c', 'd' ],
 143     [ 'a\\,b', 'c\\{d', 'e\\}f' ],
 144 );
 145
 146 for my $strs (@try_bracing) {
 147     my $rt = [ Amanda::Util::expand_braced_alternates(
 148                     Amanda::Util::collapse_braced_alternates($strs)) ];
 149     is_deeply($rt, $strs,
 150               "round-trip of " . Dumper($strs));
 151 }
 152
 153 is_deeply(
 154     [ Amanda::Util::expand_braced_alternates("t{0..3,5}") ],
 155     [ qw(t0 t1 t2 t3 t5) ],
 156     "expand_braced_alternates('t{0..3,5}')");
 157
 158 is_deeply(
 159     [ Amanda::Util::expand_braced_alternates("t{13..12}") ],
 160     [ qw(t13..12) ],
 161     "expand_braced_alternates('t{13..12}') (sequence not parsed)");
 162
 163 is_deeply(
 164     [ Amanda::Util::expand_braced_alternates("t{999..999}") ],
 165     [ qw(t999) ],
 166     "expand_braced_alternates('t{999..999}')");
 167
 168 is_deeply(
 169     [ Amanda::Util::expand_braced_alternates("t{0..3}") ],
 170     [ qw(t0 t1 t2 t3) ],
 171     "expand_braced_alternates('t{0..3}')");
 172
 173 is_deeply(
 174     [ Amanda::Util::expand_braced_alternates("t{10..13}") ],
 175     [ qw(t10 t11 t12 t13) ],
 176     "expand_braced_alternates('t{10..13}')");
 177
 178 is_deeply(
 179     [ Amanda::Util::expand_braced_alternates("t{9..13}") ],
 180     [ qw(t9 t10 t11 t12 t13) ],
 181     "expand_braced_alternates('t{9..13}')");
 182
 183 is_deeply(
 184     [ Amanda::Util::expand_braced_alternates("t{09..13}") ],
 185     [ qw(t09 t10 t11 t12 t13) ],
 186     "expand_braced_alternates('t{09..13}')");
 187
 188 is_deeply(
 189     [ Amanda::Util::expand_braced_alternates("t{009..13}") ],
 190     [ qw(t009 t010 t011 t012 t013) ],
 191     "expand_braced_alternates('t{009..13}') (ldigits > rdigits)");
 192
 193 is_deeply(
 194     [ sort(+Amanda::Util::expand_braced_alternates("x{001..004}y{1..2}z")) ],
 195     [ sort(qw( x001y1z x002y1z x003y1z x004y1z x001y2z x002y2z x003y2z x004y2z )) ],
 196     "expand_braced_alternates('x{001..004}y{1..2}z')");
 197
 198 is_deeply(
 199     [ Amanda::Util::expand_braced_alternates("t{1..100}e") ],
 200     [ map { "t$_"."e" } (1 .. 100) ],
 201     "expand_braced_alternates('t{1..100}e')");
 202
 203 my @try_sanitise = (
 204     [ '', '' ],
 205     [ 'foo', 'foo' ],
 206     [ '/', '_' ],
 207     [ ':', '_' ],
 208     [ '\\', '_' ],
 209     [ 'foo/bar:baz', 'foo_bar_baz' ],
 210 );
 211
 212 for my $strs (@try_sanitise) {
 213     my ($in, $exp) = @{$strs};
 214     is(Amanda::Util::sanitise_filename($in), $exp, "sanitise " . $in);
 215 }
 216
 217 ## test full_read and full_write
 218
 219 my $testfile = "$Installcheck::TMP/Amanda_Util";
 220 my $fd;
 221 my $buf;
 222
 223 # set up a 1K test file
 224 {
 225     open (my $fh, ">", $testfile) or die("Opening $testfile: $!");
 226     print $fh 'abcd' x 256;
 227     close($fh);
 228 }
 229
 230 $! = 0;
 231 my $rv = Amanda::Util::full_read(-1, 13);
 232 isnt($!, '', "bad full_read gives a nonzero errno ($!)");
 233
 234 $! = 0;
 235 $rv = Amanda::Util::full_write(-1, "hello", 5);
 236 isnt($!, '', "bad full_write gives a nonzero errno ($!)");
 237
 238 $fd = POSIX::open($testfile, POSIX::O_RDONLY);
 239 die "Could not open '$testfile'" unless defined $fd;
 240
 241 $! = 0;
 242 $buf = Amanda::Util::full_read($fd, 1000);
 243 is(length($buf), 1000, "a valid read gets the right number of bytes");
 244 is(substr($buf, 0, 8), "abcdabcd", "..and what looks like the right data");
 245 is($!, '', "..and no error");
 246
 247 $! = 0;
 248 $buf = Amanda::Util::full_read($fd, 1000);
 249 is(length($buf), 24, "a second read, to EOF, gets the right number of bytes");
 250 is(substr($buf, 0, 8), "abcdabcd", "..and what looks like the right data");
 251 is($!, '', "..and no error");
 252
 253 POSIX::close($fd);
 254
 255 $fd = POSIX::open($testfile, POSIX::O_WRONLY);
 256 die "Could not open '$testfile'" unless defined $fd;
 257
 258 $! = 0;
 259 $rv = Amanda::Util::full_write($fd, "swank!", 6);
 260 is($rv, 6, "full_write returns number of bytes written");
 261 is($!, '', "..and no error");
 262
 263 POSIX::close($fd);
 264
 265 unlink($testfile);
 266
 267 # just a quick check for split_quoted_strings - thorough checks are done in
 268 # common-src/quoting-test.c.
 269 is_deeply([ Amanda::Util::split_quoted_strings('one "T W O" thr\ ee'), ],
 270           [ "one", "T W O", "thr ee" ],
 271           "split_quoted_strings seems to work");
 272
 273 ## tests for slurp and burp
 274
 275 my $corpus = <<EOF;
 276
 277 Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean id
 278 neque interdum ligula euismod cursus at vel tortor. Praesent interdum
 279 molestie felis, nec vehicula lorem luctus quis. Suspendisse in laoreet
 280 diam. Maecenas fringilla lectus vel libero vehicula
 281 condimentum. Aenean ac luctus nulla. Nullam sagittis lacinia orci, et
 282 consectetur nunc malesuada sed. Nulla eu felis ipsum. Duis feugiat
 283 risus a lectus blandit lobortis. Fusce quis neque neque. Class aptent
 284 taciti sociosqu ad litora torquent per conubia nostra, per inceptos
 285 himenaeos.
 286
 287 Nulla at auctor mi. Mauris vestibulum ante vel metus auctor at iaculis
 288 neque semper. Nullam ipsum lorem, convallis ullamcorper ornare in,
 289 lacinia eu magna. Vivamus vulputate fermentum quam, quis pulvinar eros
 290 varius at. Phasellus ac diam nec erat elementum facilisis et ac
 291 est. Nunc nec nulla nec quam tristique dignissim at ut arcu. Integer
 292 accumsan tincidunt nisi non consectetur. Donec nec massa sed dui
 293 auctor sodales eget ac elit. Aliquam luctus sollicitudin nibh, eu
 294 volutpat augue tempor sed. Mauris ac est et neque mollis iaculis vel
 295 in libero. Duis molestie felis ultrices elit fringilla varius. In eget
 296 turpis dignissim sem varius sagittis eget vel neque.
 297
 298 EOF
 299
 300 my $burp_corpus_fname = "$Installcheck::TMP/burp_corpus";
 301
 302 ok( burp( $burp_corpus_fname, $corpus ), "burp round-trip test" );
 303 is( slurp($burp_corpus_fname), $corpus, "slurp round-trip test" );
 304
 305 # test safe_overwrite_file
 306
 307 my $sof_data = <<EOF;
 308 DISK planner somebox /lib
 309 START planner date 20080111
 310 START driver date 20080111
 311 STATS driver hostname somebox
 312 STATS driver startup time 0.051
 313 FINISH planner date 20080111 time 82.721
 314 START taper datestamp 20080111 label Conf-001 tape 1
 315 SUCCESS dumper somebox /lib 20080111 0 [sec 0.209 kb 1970 kps 9382.2 orig-kb 1970]
 316 SUCCESS chunker somebox /lib 20080111 0 [sec 0.305 kb 420 kps 1478.7]
 317 STATS driver estimate somebox /lib 20080111 0 [sec 1 nkb 2002 ckb 480 kps 385]
 318 PART taper Conf-001 1 somebox /lib 20080111 1/1 0 [sec 4.813543 kb 419 kps 87.133307]
 319 DONE taper somebox /lib 20080111 1 0 [sec 4.813543 kb 419 kps 87.133307]
 320 FINISH driver date 20080111 time 2167.581
 321 EOF
 322
 323 ok(safe_overwrite_file($burp_corpus_fname, $sof_data),
 324     "safe_overwrite_file success");
 325 is(slurp($burp_corpus_fname), $sof_data,
 326     "safe_overwrite_file round-trip check");
 327
 328 # check out get_fs_usage
 329 my $fs_usage = Amanda::Util::get_fs_usage(POSIX::getcwd);
 330 if ($fs_usage) {
 331     ok($fs_usage->{'blocks'}, "get_fs_usage returns something");
 332 } else {
 333     fail("get_fs_usage fails: $!");
 334 }
 335
 336 # check file_lock -- again, full checks are in common-src/amflock-test.c
 337 my $filename = "$Installcheck::TMP/testlock";
 338 unlink($filename);
 339 my $fl = Amanda::Util::file_lock->new($filename);
 340 is($fl->data, undef, "data is initially undefined");
 341 $fl->lock();
 342 is($fl->data, undef, "data is undefined even after lock");
 343 $fl->write("THIS IS MY DATA");
 344 is($fl->data, "THIS IS MY DATA", "data is set correctly after write()");
 345 $fl->unlock();
 346
 347 # new lock object
 348 $fl = Amanda::Util::file_lock->new($filename);
 349 is($fl->data, undef, "data is initially undefined");
 350 $fl->lock();
 351 is($fl->data, "THIS IS MY DATA", "data is set correctly after lock");
 352
 353 ## check (un)marshal_tapespec
 354
 355 my @tapespecs = (
 356     "FOO:1,2;BAR:3" => [ FOO => [ 1, 2 ], BAR => [ 3 ] ],
 357     "SE\\;MI:0;COL\\:ON:3" => [ 'SE;MI' => [0], 'COL:ON' => [3] ],
 358     "CO\\,MMA:88,99;BACK\\\\SLASH:3" => [ 'CO,MMA' => [88,99], 'BACK\\SLASH' => [3] ],
 359     "FUNNY\\;:1;CHARS\\::2;AT\\,:3;END\\\\:4" =>
 360         [ 'FUNNY;' => [ 1 ], 'CHARS:' => [ 2 ], 'AT,' => [ 3 ], 'END\\' => [ 4 ], ],
 361     "\\;FUNNY:1;\\:CHARS:2;\\,AT:3;\\\\BEG:4" =>
 362         [ ';FUNNY' => [ 1 ], ':CHARS' => [ 2 ], ',AT' => [ 3 ], '\\BEG' => [ 4 ], ],
 363 );
 364
 365 while (@tapespecs) {
 366     my $tapespec = shift @tapespecs;
 367     my $filelist = shift @tapespecs;
 368     is(Amanda::Util::marshal_tapespec($filelist), $tapespec,
 369             "marshal '$tapespec'");
 370     is_deeply(Amanda::Util::unmarshal_tapespec($tapespec), $filelist,
 371             "unmarshal '$tapespec'");
 372 }
 373
 374 is_deeply(Amanda::Util::unmarshal_tapespec("x:100,99"), [ x => [99,100] ],
 375     "filenums are sorted when unmarshalled");
 376
 377 is_deeply(Amanda::Util::marshal_tapespec([ x => [100, 99] ]), "x:100,99",
 378     "un-sorted filenums are NOT sorted when marshalled");
 379
 380 is_deeply(Amanda::Util::unmarshal_tapespec("x:34,34"), [ x => [34, 34] ],
 381     "duplicate filenums are NOT collapsed when unmarshalled");
 382
 383 is_deeply(Amanda::Util::marshal_tapespec([ x => [34, 34] ]), "x:34,34",
 384     "duplicate filenums are NOT collapsed when marshalled");
 385
 386 is_deeply(Amanda::Util::unmarshal_tapespec("sim\\\\ple\\:quoted\\;file\\,name"),
 387     [ "sim\\ple:quoted;file,name" => [0] ],
 388     "simple non-tapespec string translated like string:0");
 389
 390 is_deeply(Amanda::Util::unmarshal_tapespec("tricky\\,tricky\\:1,2,3"),
 391     [ "tricky,tricky:1,2,3" => [0] ],
 392     "tricky non-tapespec string also translated to string:0");
 393
 394 is_deeply(Amanda::Util::unmarshal_tapespec("\\:3"), # one slash
 395     [ ":3" => [0] ],
 396     "one slash escapes the colon");
 397
 398 is_deeply(Amanda::Util::unmarshal_tapespec("\\\\:3"), # two slashes
 399     [ "\\" => [3] ],
 400     "two slashes escape to one");
 401
 402 is_deeply(Amanda::Util::unmarshal_tapespec("\\\\\\:3"), # three slashes
 403     [ "\\:3" => [0] ],
 404     "three slashes escape to a slash and a colon");
 405
 406 is_deeply(Amanda::Util::unmarshal_tapespec("\\\\\\\\:3"), # four slashes
 407     [ "\\\\" => [3] ],
 408     "four slashes escape to two");