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

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