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