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 => 114;
  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 {
  99     my ($a, $b) = Amanda::Util::skip_quoted_string("foobar");
 100     is($a, "foobar",
 101        "skip_quoted_string with one quoted string (first argument)");
 102     is($b, undef,
 103        "skip_quoted_string with one quoted string (second argument)");
 104 }
 105
 106 my @try_bracing = (
 107     [ 'abc' ],
 108     [ 'abc', 'def' ],
 109     [ 'abc', 'def', 'ghi' ],
 110     [ 'a,b', 'c' ],
 111     [ 'a', 'b,c' ],
 112     [ 'a', 'b,c', 'd' ],
 113     [ 'a{b', 'c' ],
 114     [ 'a', 'b{c' ],
 115     [ 'a', 'b{c', 'd' ],
 116     [ 'a}b', 'c' ],
 117     [ 'a', 'b}c' ],
 118     [ 'a', 'b}c', 'd' ],
 119     [ 'a\\,b', 'c\\{d', 'e\\}f' ],
 120 );
 121
 122 for my $strs (@try_bracing) {
 123     my $rt = [ Amanda::Util::expand_braced_alternates(
 124                     Amanda::Util::collapse_braced_alternates($strs)) ];
 125     is_deeply($rt, $strs,
 126               "round-trip of " . Dumper($strs));
 127 }
 128
 129 my @try_sanitise = (
 130     [ '', '' ],
 131     [ 'foo', 'foo' ],
 132     [ '/', '_' ],
 133     [ ':', '_' ],
 134     [ '\\', '_' ],
 135     [ 'foo/bar:baz', 'foo_bar_baz' ],
 136 );
 137
 138 for my $strs (@try_sanitise) {
 139     my ($in, $exp) = @{$strs};
 140     is(Amanda::Util::sanitise_filename($in), $exp, "sanitise " . $in);
 141 }
 142
 143 ## test full_read and full_write
 144
 145 my $testfile = "$Installcheck::TMP/Amanda_Util";
 146 my $fd;
 147 my $buf;
 148
 149 # set up a 1K test file
 150 {
 151     open (my $fh, ">", $testfile) or die("Opening $testfile: $!");
 152     print $fh 'abcd' x 256;
 153     close($fh);
 154 }
 155
 156 $! = 0;
 157 my $rv = Amanda::Util::full_read(-1, 13);
 158 isnt($!, '', "bad full_read gives a nonzero errno ($!)");
 159
 160 $! = 0;
 161 $rv = Amanda::Util::full_write(-1, "hello", 5);
 162 isnt($!, '', "bad full_write gives a nonzero errno ($!)");
 163
 164 $fd = POSIX::open($testfile, POSIX::O_RDONLY);
 165 die "Could not open '$testfile'" unless defined $fd;
 166
 167 $! = 0;
 168 $buf = Amanda::Util::full_read($fd, 1000);
 169 is(length($buf), 1000, "a valid read gets the right number of bytes");
 170 is(substr($buf, 0, 8), "abcdabcd", "..and what looks like the right data");
 171 is($!, '', "..and no error");
 172
 173 $! = 0;
 174 $buf = Amanda::Util::full_read($fd, 1000);
 175 is(length($buf), 24, "a second read, to EOF, gets the right number of bytes");
 176 is(substr($buf, 0, 8), "abcdabcd", "..and what looks like the right data");
 177 is($!, '', "..and no error");
 178
 179 POSIX::close($fd);
 180
 181 $fd = POSIX::open($testfile, POSIX::O_WRONLY);
 182 die "Could not open '$testfile'" unless defined $fd;
 183
 184 $! = 0;
 185 $rv = Amanda::Util::full_write($fd, "swank!", 6);
 186 is($rv, 6, "full_write returns number of bytes written");
 187 is($!, '', "..and no error");
 188
 189 POSIX::close($fd);
 190
 191 unlink($testfile);
 192
 193 # just a quick check for split_quoted_strings - thorough checks are done in
 194 # common-src/quoting-test.c.
 195 is_deeply([ Amanda::Util::split_quoted_strings('one "T W O" thr\ ee'), ],
 196           [ "one", "T W O", "thr ee" ],
 197           "split_quoted_strings seems to work");
 198
 199 ## tests for slurp and burp
 200
 201 my $corpus = <<EOF;
 202
 203 Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean id
 204 neque interdum ligula euismod cursus at vel tortor. Praesent interdum
 205 molestie felis, nec vehicula lorem luctus quis. Suspendisse in laoreet
 206 diam. Maecenas fringilla lectus vel libero vehicula
 207 condimentum. Aenean ac luctus nulla. Nullam sagittis lacinia orci, et
 208 consectetur nunc malesuada sed. Nulla eu felis ipsum. Duis feugiat
 209 risus a lectus blandit lobortis. Fusce quis neque neque. Class aptent
 210 taciti sociosqu ad litora torquent per conubia nostra, per inceptos
 211 himenaeos.
 212
 213 Nulla at auctor mi. Mauris vestibulum ante vel metus auctor at iaculis
 214 neque semper. Nullam ipsum lorem, convallis ullamcorper ornare in,
 215 lacinia eu magna. Vivamus vulputate fermentum quam, quis pulvinar eros
 216 varius at. Phasellus ac diam nec erat elementum facilisis et ac
 217 est. Nunc nec nulla nec quam tristique dignissim at ut arcu. Integer
 218 accumsan tincidunt nisi non consectetur. Donec nec massa sed dui
 219 auctor sodales eget ac elit. Aliquam luctus sollicitudin nibh, eu
 220 volutpat augue tempor sed. Mauris ac est et neque mollis iaculis vel
 221 in libero. Duis molestie felis ultrices elit fringilla varius. In eget
 222 turpis dignissim sem varius sagittis eget vel neque.
 223
 224 EOF
 225
 226 my $burp_corpus_fname = "$Installcheck::TMP/burp_corpus";
 227
 228 ok( burp( $burp_corpus_fname, $corpus ), "burp round-trip test" );
 229 is( slurp($burp_corpus_fname), $corpus, "slurp round-trip test" );
 230
 231 # test safe_overwrite_file
 232
 233 my $sof_data = <<EOF;
 234 DISK planner somebox /lib
 235 START planner date 20080111
 236 START driver date 20080111
 237 STATS driver hostname somebox
 238 STATS driver startup time 0.051
 239 FINISH planner date 20080111 time 82.721
 240 START taper datestamp 20080111 label Conf-001 tape 1
 241 SUCCESS dumper somebox /lib 20080111 0 [sec 0.209 kb 1970 kps 9382.2 orig-kb 1970]
 242 SUCCESS chunker somebox /lib 20080111 0 [sec 0.305 kb 420 kps 1478.7]
 243 STATS driver estimate somebox /lib 20080111 0 [sec 1 nkb 2002 ckb 480 kps 385]
 244 PART taper Conf-001 1 somebox /lib 20080111 1/1 0 [sec 4.813543 kb 419 kps 87.133307]
 245 DONE taper somebox /lib 20080111 1 0 [sec 4.813543 kb 419 kps 87.133307]
 246 FINISH driver date 20080111 time 2167.581
 247 EOF
 248
 249 ok(safe_overwrite_file($burp_corpus_fname, $sof_data));
 250 is(slurp($burp_corpus_fname), $sof_data,
 251     "safe_overwrite_file round-trip check");
 252
 253 # check out get_fs_usage
 254 my $fs_usage = Amanda::Util::get_fs_usage(POSIX::getcwd);
 255 if ($fs_usage) {
 256     ok($fs_usage->{'blocks'}, "get_fs_usage returns something");
 257 } else {
 258     fail("get_fs_usage fails: $!");
 259 }
 260
 261 # check file_lock -- again, full checks are in common-src/amflock-test.c
 262 my $filename = "$Installcheck::TMP/testlock";
 263 unlink($filename);
 264 my $fl = Amanda::Util::file_lock->new($filename);
 265 is($fl->data, undef, "data is initially undefined");
 266 $fl->lock();
 267 is($fl->data, undef, "data is undefined even after lock");
 268 $fl->write("THIS IS MY DATA");
 269 is($fl->data, "THIS IS MY DATA", "data is set correctly after write()");
 270 $fl->unlock();
 271
 272 # new lock object
 273 $fl = Amanda::Util::file_lock->new($filename);
 274 is($fl->data, undef, "data is initially undefined");
 275 $fl->lock();
 276 is($fl->data, "THIS IS MY DATA", "data is set correctly after lock");
 277
 278 ## check (un)marshal_tapespec
 279
 280 my @tapespecs = (
 281     "FOO:1,2;BAR:3" => [ FOO => [ 1, 2 ], BAR => [ 3 ] ],
 282     "SE\\;MI:0;COL\\:ON:3" => [ 'SE;MI' => [0], 'COL:ON' => [3] ],
 283     "CO\\,MMA:88,99;BACK\\\\SLASH:3" => [ 'CO,MMA' => [88,99], 'BACK\\SLASH' => [3] ],
 284     "FUNNY\\;:1;CHARS\\::2;AT\\,:3;END\\\\:4" =>
 285         [ 'FUNNY;' => [ 1 ], 'CHARS:' => [ 2 ], 'AT,' => [ 3 ], 'END\\' => [ 4 ], ],
 286     "\\;FUNNY:1;\\:CHARS:2;\\,AT:3;\\\\BEG:4" =>
 287         [ ';FUNNY' => [ 1 ], ':CHARS' => [ 2 ], ',AT' => [ 3 ], '\\BEG' => [ 4 ], ],
 288 );
 289
 290 while (@tapespecs) {
 291     my $tapespec = shift @tapespecs;
 292     my $filelist = shift @tapespecs;
 293     is(Amanda::Util::marshal_tapespec($filelist), $tapespec,
 294             "marshal '$tapespec'");
 295     is_deeply(Amanda::Util::unmarshal_tapespec($tapespec), $filelist,
 296             "unmarshal '$tapespec'");
 297 }
 298
 299 is_deeply(Amanda::Util::unmarshal_tapespec("x:100,99"), [ x => [99,100] ],
 300     "filenums are sorted when unmarshalled");
 301
 302 is_deeply(Amanda::Util::marshal_tapespec([ x => [100, 99] ]), "x:100,99",
 303     "un-sorted filenums are NOT sorted when marshalled");
 304
 305 is_deeply(Amanda::Util::unmarshal_tapespec("x:34,34"), [ x => [34, 34] ],
 306     "duplicate filenums are NOT collapsed when unmarshalled");
 307
 308 is_deeply(Amanda::Util::marshal_tapespec([ x => [34, 34] ]), "x:34,34",
 309     "duplicate filenums are NOT collapsed when marshalled");
 310
 311 is_deeply(Amanda::Util::unmarshal_tapespec("sim\\\\ple\\:quoted\\;file\\,name"),
 312     [ "sim\\ple:quoted;file,name" => [0] ],
 313     "simple non-tapespec string translated like string:0");
 314
 315 is_deeply(Amanda::Util::unmarshal_tapespec("tricky\\,tricky\\:1,2,3"),
 316     [ "tricky,tricky:1,2,3" => [0] ],
 317     "tricky non-tapespec string also translated to string:0");
 318
 319 is_deeply(Amanda::Util::unmarshal_tapespec("\\:3"), # one slash
 320     [ ":3" => [0] ],
 321     "one slash escapes the colon");
 322
 323 is_deeply(Amanda::Util::unmarshal_tapespec("\\\\:3"), # two slashes
 324     [ "\\" => [3] ],
 325     "two slashes escape to one");
 326
 327 is_deeply(Amanda::Util::unmarshal_tapespec("\\\\\\:3"), # three slashes
 328     [ "\\:3" => [0] ],
 329     "three slashes escape to a slash and a colon");
 330
 331 is_deeply(Amanda::Util::unmarshal_tapespec("\\\\\\\\:3"), # four slashes
 332     [ "\\\\" => [3] ],
 333     "four slashes escape to two");