1#!/usr/bin/env perl 2 3# Test the usage of RPC::XML::base64 with filehandles 4 5## no critic(RequireBriefOpen) 6## no critic(RequireCheckedClose) 7## no critic(RequireInterpolationOfMetachars) 8 9use strict; 10use warnings; 11 12use Carp qw(croak carp); 13use Test::More; 14use File::Spec; 15use IO::Handle; # Allow "$fh->autoflush(1)" for setting $| 16use Digest::MD5; 17use MIME::Base64; 18 19# This is what we're testing 20use RPC::XML; 21 22my ($dir, $vol, $file, $b64file, $tmpfile, $value, $enc_value, $obj, $fh, $pos, 23 $md5_able, $md5, $size, $ofh); 24 25plan tests => 35; 26 27($vol, $dir, undef) = File::Spec->splitpath(File::Spec->rel2abs($0)); 28$dir = File::Spec->catpath($vol, $dir, q{}); 29$file = File::Spec->catfile($dir, 'svsm_text.gif'); 30$b64file = File::Spec->catfile($dir, 'svsm_text.b64'); 31$tmpfile = File::Spec->catfile($dir, "__tmp__${$}__"); 32 33END 34{ 35 if (-f $tmpfile) 36 { 37 unlink $tmpfile; 38 } 39} 40 41$value = 'Short string for easy tests'; 42$enc_value = encode_base64($value, q{}); 43 44if (! (open $fh, '+>', $tmpfile)) 45{ 46 croak "Error opening $tmpfile: $!"; 47} 48 49$fh->autoflush(1); 50 51print {$fh} $value; 52$pos = tell $fh; 53 54# We now have a ready-to-use FH, and we know the seek-pos on it 55$obj = RPC::XML::base64->new($fh); 56isa_ok($obj, 'RPC::XML::base64', '$obj'); 57is(tell $fh, $pos, 'object construction leaves pos() unchanged'); 58is($obj->value(), $value, 'object value is correct'); 59is(tell $fh, $pos, 'call to value() leaves pos() unchanged'); 60is($obj->as_string(), "<base64>$enc_value</base64>", 61 'object stringification is correct'); 62is(tell $fh, $pos, 'call to as_string leaves pos() unchanged'); 63 64# Done with this for now 65close $fh; 66unlink $tmpfile; 67 68# Same tests, but init the FH with the encoded data rather than the cleartext 69if (! (open $fh, '+>', $tmpfile)) 70{ 71 croak "Error opening $tmpfile: $!"; 72} 73 74$fh->autoflush(1); 75 76print {$fh} $enc_value; 77$pos = tell $fh; 78 79# We now have a ready-to-use FH, and we know the seek-pos on it 80$obj = RPC::XML::base64->new($fh, 'encoded'); 81isa_ok($obj, 'RPC::XML::base64', '$obj(encoded)'); 82is(tell $fh, $pos, 'object(encoded) construction leaves pos() unchanged'); 83is($obj->value(), $value, 'object(encoded) value is correct'); 84is(tell $fh, $pos, 'call to value() leaves pos() unchanged'); 85is($obj->as_string(), "<base64>$enc_value</base64>", 86 'object(encoded) stringification is correct'); 87is(tell $fh, $pos, 'call to as_string leaves pos() unchanged'); 88 89# Done with this for now 90close $fh; 91unlink $tmpfile; 92 93# Test old-style glob filehandles 94{ 95 ## no critic(ProhibitBarewordFilehandles) 96 ## no critic(RequireBracedFileHandleWithPrint) 97 98 if (! (open F, '+>', $tmpfile)) 99 { 100 croak "Error opening $tmpfile: $!"; 101 } 102 103 F->autoflush(1); 104 105 print F $enc_value; 106 $pos = tell F; 107 108 # We now have a ready-to-use FH, and we know the seek-pos on it 109 $obj = RPC::XML::base64->new(\*F, 'encoded'); 110 isa_ok($obj, 'RPC::XML::base64', '$obj(glob)'); 111 is(tell F, $pos, 'object(glob) construction leaves pos() unchanged'); 112 is($obj->value(), $value, 'object(glob) value is correct'); 113 is(tell F, $pos, 'call to value() leaves pos() unchanged'); 114 is($obj->as_string(), "<base64>$enc_value</base64>", 115 'object(glob) stringification is correct'); 116 is(tell F, $pos, 'call to as_string leaves pos() unchanged'); 117 118 # Done with this for now 119 close F; 120 unlink $tmpfile; 121} 122 123# Test with a larger file 124if (! (open $fh, '<', $file)) 125{ 126 croak "Error opening $file: $!"; 127} 128 129$obj = RPC::XML::base64->new($fh); 130isa_ok($obj, 'RPC::XML::base64', '$obj'); 131$enc_value = q{}; $value = q{}; 132 133while (read $fh, $value, 60*57) 134{ 135 $enc_value .= encode_base64($value, q{}); 136} 137is($obj->as_string(), "<base64>$enc_value</base64>", 138 'from file, stringification'); 139is(length($obj->as_string), $obj->length, 'from file, length'); 140seek $fh, 0, 0; 141 142$md5 = Digest::MD5->new; 143$md5->addfile($fh); 144$value = $md5->hexdigest; 145$md5->new; # Clear the digest 146$md5->add($obj->value); 147is($value, $md5->hexdigest, 'MD5 checksum matches'); 148 149close $fh; 150 151# Test the to_file method 152if (! (open $fh, '<', $file)) 153{ 154 croak "Error opening $file: $!"; 155} 156$obj = RPC::XML::base64->new($fh); 157 158# Start by trying to write the new file 159$size = $obj->to_file($tmpfile); 160is($size, -s $file, 'to_file call returned correct number of bytes'); 161is(-s $tmpfile, -s $file, 'temp-file size matches file size'); 162 163$md5 = Digest::MD5->new; 164$md5->addfile($fh); 165$value = $md5->hexdigest; 166$md5->new; # Clear the digest 167 168# Now get an MD5 on the new file 169if (! (open $ofh, '<', $tmpfile)) 170{ 171 croak "Error opening $tmpfile for reading: $!"; 172} 173$md5->addfile($ofh); 174is($value, $md5->hexdigest, 'MD5 hexdigest matches'); 175close $ofh; 176unlink $tmpfile; 177close $fh; 178 179# Try with in-memory data 180$value = 'a simple in-memory string'; 181$obj = RPC::XML::base64->new($value); 182# Try to write it 183$size = $obj->to_file($tmpfile); 184is($size, length $value, 'to_file call returned correct number of bytes'); 185is(length $value, -s $tmpfile, 'temp-file size matches string'); 186unlink $tmpfile; 187 188# Try with a file-handle instead of a file name 189if (! (open $ofh, '>', $tmpfile)) 190{ 191 croak "Error opening $tmpfile for writing: $!"; 192} 193$ofh->autoflush(1); 194$size = $obj->to_file($ofh); 195is($size, length $value, 'to_file call on file-handle, correct size'); 196is(length $value, -s $ofh, 'temp-file size matches string'); 197close $ofh; 198unlink $tmpfile; 199 200# Try an unusable reference 201$size = $obj->to_file([]); 202is($size, -1, 'to_file call failed on unusable reference type'); 203like($RPC::XML::ERROR, qr/Unusable reference/, 'Correct error message'); 204 205SKIP: { 206 # Test the failure to open a file. Cannot run this on Windows because 207 # it doesn't have the concept of chmod... 208 if ($^O eq 'MSWin32' || $^O eq 'cygwin') 209 { 210 skip 'Tests involving directory permissions skipped on Windows', 2; 211 } 212 # ...nor can we run it as root, because root. 213 if ($< == 0) 214 { 215 skip 'Tests involving directory permissions skipped under root', 2; 216 } 217 218 my $baddir = File::Spec->catdir(File::Spec->tmpdir(), "baddir_$$"); 219 if (! mkdir $baddir) 220 { 221 skip "Skipping, failed to create dir $baddir: $!", 2; 222 } 223 if (! chmod oct(600), $baddir) 224 { 225 skip "Skipping, failed to chmod dir $baddir: $!", 2; 226 } 227 my $badfile = File::Spec->catfile($baddir, 'file'); 228 229 $size = $obj->to_file($badfile); 230 is($size, -1, 'to_file call failed on un-openable file'); 231 like($RPC::XML::ERROR, qr/Error opening/, 'Correct error message'); 232 233 if (! rmdir $baddir) 234 { 235 carp "Failed to remove temp-dir $baddir: $!"; 236 } 237} 238 239# Test to_file() with an encoded file in the file-handle 240if (! (open $fh, '<', $b64file)) 241{ 242 croak "Error opening $b64file for reading: $!"; 243} 244$obj = RPC::XML::base64->new($fh, 'encoded'); 245$size = $obj->to_file($tmpfile); 246is($size, -s $file, 'to_file() written size matches decoded file size'); 247if (! (open $fh, '<', $file)) 248{ 249 croak "Error opening $file: $!"; 250} 251$md5 = Digest::MD5->new; 252$md5->addfile($fh); 253$value = $md5->hexdigest; 254$md5->new; # Clear the digest 255 256# Now get an MD5 on the new file 257if (! (open $ofh, '<', $tmpfile)) 258{ 259 croak "Error opening $tmpfile for reading: $!"; 260} 261$md5->addfile($ofh); 262is($value, $md5->hexdigest, 'MD5 hexdigest matches'); 263close $ofh; 264unlink $tmpfile; 265close $fh; 266 267exit; 268