1 # Copyright (c) 2008, 2009, 2010 Zmanda, Inc. All Rights Reserved.
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.
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
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
16 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
19 use Test::More tests => 114;
21 use lib "@amperldir@";
25 use Amanda::Util qw(slurp burp safe_overwrite_file);
29 # Data::Dumper is used to output strings with control characters
31 $Data::Dumper::Useqq = 1; # quote strings
32 $Data::Dumper::Terse = 1; # no $VAR1 = ..
33 $Data::Dumper::Indent = 0; # no newlines
35 # most of Amanda::Util is tested via running applications that use it
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");
43 # Tests for quote_string and unquote string. First, some fuzzing of the
44 # quote + unquote round-trip.
51 "\t", "\r", "\n", "\f",
52 '\\\\\\\\', # memory overflow?
56 "line\nanother", # real newline
63 for my $fuzzstr (@fuzzstrs) {
64 is(Amanda::Util::unquote_string(Amanda::Util::quote_string($fuzzstr)), $fuzzstr,
65 "fuzz " . Dumper($fuzzstr));
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 = (
80 '"\\\\n"' => '\n', # literal \
85 while (my ($qstr, $uqstr) = each %unquote_checks) {
86 is(Amanda::Util::unquote_string($qstr), $uqstr,
87 "unquote " . Dumper($qstr));
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"));
99 my ($a, $b) = Amanda::Util::skip_quoted_string("foobar");
101 "skip_quoted_string with one quoted string (first argument)");
103 "skip_quoted_string with one quoted string (second argument)");
109 [ 'abc', 'def', 'ghi' ],
119 [ 'a\\,b', 'c\\{d', 'e\\}f' ],
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));
135 [ 'foo/bar:baz', 'foo_bar_baz' ],
138 for my $strs (@try_sanitise) {
139 my ($in, $exp) = @{$strs};
140 is(Amanda::Util::sanitise_filename($in), $exp, "sanitise " . $in);
143 ## test full_read and full_write
145 my $testfile = "$Installcheck::TMP/Amanda_Util";
149 # set up a 1K test file
151 open (my $fh, ">", $testfile) or die("Opening $testfile: $!");
152 print $fh 'abcd' x 256;
157 my $rv = Amanda::Util::full_read(-1, 13);
158 isnt($!, '', "bad full_read gives a nonzero errno ($!)");
161 $rv = Amanda::Util::full_write(-1, "hello", 5);
162 isnt($!, '', "bad full_write gives a nonzero errno ($!)");
164 $fd = POSIX::open($testfile, POSIX::O_RDONLY);
165 die "Could not open '$testfile'" unless defined $fd;
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");
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");
181 $fd = POSIX::open($testfile, POSIX::O_WRONLY);
182 die "Could not open '$testfile'" unless defined $fd;
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");
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");
199 ## tests for slurp and burp
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
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.
226 my $burp_corpus_fname = "$Installcheck::TMP/burp_corpus";
228 ok( burp( $burp_corpus_fname, $corpus ), "burp round-trip test" );
229 is( slurp($burp_corpus_fname), $corpus, "slurp round-trip test" );
231 # test safe_overwrite_file
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
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");
253 # check out get_fs_usage
254 my $fs_usage = Amanda::Util::get_fs_usage(POSIX::getcwd);
256 ok($fs_usage->{'blocks'}, "get_fs_usage returns something");
258 fail("get_fs_usage fails: $!");
261 # check file_lock -- again, full checks are in common-src/amflock-test.c
262 my $filename = "$Installcheck::TMP/testlock";
264 my $fl = Amanda::Util::file_lock->new($filename);
265 is($fl->data, undef, "data is initially undefined");
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()");
273 $fl = Amanda::Util::file_lock->new($filename);
274 is($fl->data, undef, "data is initially undefined");
276 is($fl->data, "THIS IS MY DATA", "data is set correctly after lock");
278 ## check (un)marshal_tapespec
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 ], ],
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'");
299 is_deeply(Amanda::Util::unmarshal_tapespec("x:100,99"), [ x => [99,100] ],
300 "filenums are sorted when unmarshalled");
302 is_deeply(Amanda::Util::marshal_tapespec([ x => [100, 99] ]), "x:100,99",
303 "un-sorted filenums are NOT sorted when marshalled");
305 is_deeply(Amanda::Util::unmarshal_tapespec("x:34,34"), [ x => [34, 34] ],
306 "duplicate filenums are NOT collapsed when unmarshalled");
308 is_deeply(Amanda::Util::marshal_tapespec([ x => [34, 34] ]), "x:34,34",
309 "duplicate filenums are NOT collapsed when marshalled");
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");
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");
319 is_deeply(Amanda::Util::unmarshal_tapespec("\\:3"), # one slash
321 "one slash escapes the colon");
323 is_deeply(Amanda::Util::unmarshal_tapespec("\\\\:3"), # two slashes
325 "two slashes escape to one");
327 is_deeply(Amanda::Util::unmarshal_tapespec("\\\\\\:3"), # three slashes
329 "three slashes escape to a slash and a colon");
331 is_deeply(Amanda::Util::unmarshal_tapespec("\\\\\\\\:3"), # four slashes
333 "four slashes escape to two");