1#!/usr/bin/env perl
2
3# Test the RPC::XML::Parser::XMLParser class
4
5## no critic(RequireInterpolationOfMetachars)
6## no critic(RequireBriefOpen)
7## no critic(RequireCheckedClose)
8
9use strict;
10use warnings;
11
12use Carp qw(carp croak);
13use Test::More;
14use File::Spec;
15
16use RPC::XML ':all';
17use RPC::XML::Parser::XMLParser;
18
19my ($p, $req, $res, $ret, $dir, $vol, $file, $fh, $str, $badstr);
20
21plan tests => 137;
22
23($vol, $dir, undef) = File::Spec->splitpath(File::Spec->rel2abs($0));
24$dir = File::Spec->catpath($vol, $dir, q{});
25$file = File::Spec->catfile($dir, 'svsm_text.gif');
26
27# The organization of the test suites is such that we assume anything that
28# runs before the current suite is 100%. Thus, no consistency checks on
29# RPC::XML::* classes are done, only on the data and return values of this
30# class under consideration, RPC::XML::Parser::XMLParser.
31
32$p = RPC::XML::Parser::XMLParser->new();
33isa_ok($p, 'RPC::XML::Parser::XMLParser', '$p');
34isa_ok($p, 'RPC::XML::Parser', '$p');
35
36# Make sure you can't call parse_more() or parse_done() on a vanilla
37# RPC::XML::Parser::XMLParser instance:
38$ret = eval { $p->parse_more(); 1; };
39ok(! $ret, 'Calling parse_more on $p failed');
40like($@, qr/Must be called on a push-parser instance/,
41     'Correct error message');
42$ret = eval { $p->parse_done(); 1; };
43ok(! $ret, 'Calling parse_done on $p failed');
44like($@, qr/Must be called on a push-parser instance/,
45     'Correct error message');
46
47$req = RPC::XML::request->new('test.method');
48$ret = $p->parse($req->as_string);
49isa_ok($ret, 'RPC::XML::request', '$ret');
50is($ret->name, 'test.method', 'Correct request method name');
51# Try a request with no <params> block at all:
52$str = <<'EO_STR';
53<?xml version="1.0" encoding="us-ascii"?>
54<methodCall>
55  <methodName>test.method</methodName>
56</methodCall>
57EO_STR
58$ret = $p->parse($str);
59isa_ok($ret, 'RPC::XML::request', '$ret');
60is($ret->name, 'test.method', 'Correct request method name');
61ok(ref($ret->args) eq 'ARRAY' && @{$ret->args} == 0,
62   'No <params> block yields correct args list');
63
64$res = RPC::XML::response->new(RPC::XML::string->new('test response'));
65$ret = $p->parse($res->as_string);
66isa_ok($ret, 'RPC::XML::response', '$ret');
67is($ret->value->value, 'test response', 'Response value');
68
69# Test some badly-formed data
70my $tmp = $res->as_string; $tmp =~ s/methodResponse/mR/g;
71$ret = $p->parse($tmp);
72ok(! ref($ret), 'Bad XML did not parse');
73like($ret, qr/Unknown tag/, 'Parse failure returned error');
74
75# Make sure that the parser can handle all of the core data-types. Easiest way
76# to do this is to create a fake request with a parameter of each type (except
77# base64, which is getting exercised later on).
78$req = RPC::XML::request->new(
79    'parserTest',
80    RPC::XML::i4->new(1),
81    RPC::XML::int->new(2),
82    RPC::XML::i8->new(3),
83    RPC::XML::double->new(4.5),
84    RPC::XML::string->new('string'),
85    RPC::XML::boolean->new('true'),
86    RPC::XML::datetime_iso8601->new('2008-09-29T12:00:00-07:00'),
87    [ 0, 1 ], # Array, auto-encoded
88    { a => 1, b => 2 }, # Hash/struct, also auto-encoded
89);
90$ret = $p->parse($req->as_string);
91isa_ok($ret, 'RPC::XML::request', 'Parse of RPC::XML::request block');
92SKIP: {
93    if (ref($ret) ne 'RPC::XML::request') {
94        skip 'RPC::XML::request object not properly parsed, cannot test.', 20;
95    }
96
97    is($ret->name, 'parserTest', 'Properly parsed /methodCall/methodName');
98    my $args = $ret->args;
99    is(scalar @{$args}, 9, 'Parser created correct-length args list');
100    # I could (and should) probably turn this into a loop with a table of
101    # data, but I'm lazy right this moment.
102    isa_ok($args->[0], 'RPC::XML::i4', 'Parse of <i4> argument');
103    is($args->[0]->value, 1, 'RPC::XML::i4 value parsed OK');
104    isa_ok($args->[1], 'RPC::XML::int', 'Parse of <int> argument');
105    is($args->[1]->value, 2, 'RPC::XML::int value parsed OK');
106    isa_ok($args->[2], 'RPC::XML::i8', 'Parse of <i8> argument');
107    is($args->[2]->value, 3, 'RPC::XML::i8 value parsed OK');
108    isa_ok($args->[3], 'RPC::XML::double', 'Parse of <double> argument');
109    is($args->[3]->value, 4.5, 'RPC::XML::double value parsed OK');
110    isa_ok($args->[4], 'RPC::XML::string', 'Parse of <string> argument');
111    is($args->[4]->value, 'string', 'RPC::XML::string value parsed OK');
112    isa_ok($args->[5], 'RPC::XML::boolean', 'Parse of <boolean> argument');
113    ok($args->[5]->value, 'RPC::XML::boolean value parsed OK');
114    isa_ok($args->[6], 'RPC::XML::datetime_iso8601',
115           'Parse of <dateTime.iso8601> argument');
116    is($args->[6]->value, '20080929T12:00:00-07:00',
117       'RPC::XML::dateTime.iso8601 value parsed OK');
118    isa_ok($args->[7], 'RPC::XML::array', 'Parse of <array> argument');
119    is(scalar(@{$args->[7]->value}), 2, 'RPC::XML::array value parsed OK');
120    isa_ok($args->[8], 'RPC::XML::struct', 'Parse of <struct> argument');
121    is(scalar(keys %{$args->[8]->value}), 2,
122       'RPC::XML::struct value parsed OK');
123}
124
125# Prior to this, we've confirmed that spooling base64 data to files works.
126# Here, we test whether the parser (when configured to do so) can create
127# filehandles as well.
128$p = RPC::XML::Parser::XMLParser->new(base64_to_fh => 1);
129if (! open $fh, '<', $file)
130{
131    croak "Error opening $file: $!";
132}
133my $base64 = RPC::XML::base64->new($fh);
134$req = RPC::XML::request->new('method', $base64);
135
136# Start testing
137my $spool_ret = $p->parse($req->as_string);
138isa_ok($spool_ret, 'RPC::XML::request', '$spool_ret');
139is($spool_ret->name, 'method', 'Request, base64 spooling, method name test');
140ok(ref($spool_ret->args), 'Request, base64 spooling, return arg test');
141
142my $new_base64 = $spool_ret->args->[0];
143isa_ok($new_base64, 'RPC::XML::base64', '$new_base64');
144is($base64->as_string(), $new_base64->as_string,
145   'Parse base64 spooling, value comparison');
146isa_ok($new_base64->{value_fh}, 'GLOB', '$new_base64->{value_fh}');
147
148# Per problem reported by Bill Moseley, check that messages parsed by the
149# parser class handle the core entities.
150$tmp = q{Entity test: & < > ' "};
151$res = RPC::XML::response->new($tmp);
152$ret = $p->parse($res->as_string);
153is($ret->value->value, $tmp, 'RPC::XML::Parser handles core entities');
154
155my $bad_entities = <<'EOX';
156<?xml version="1.0" encoding="us-ascii"?>
157<!DOCTYPE foo [
158    <!ENTITY foo SYSTEM "file:///etc/passwd">
159]>
160<methodCall>
161  <methodName>metaWeblog.newPost</methodName>
162  <params>
163    <param>
164      <value><string>Entity test: &foo;</string></value>
165    </param>
166  </params>
167</methodCall>
168EOX
169$p = RPC::XML::Parser::XMLParser->new();
170$ret = $p->parse($bad_entities);
171SKIP: {
172    if (! ref $ret) {
173        skip 'Weird entities parsing error in XML::Parser encountered', 1;
174    }
175
176    my $args = $ret->args;
177    is($args->[0]->value, 'Entity test: ', 'Bad entities ignored');
178}
179
180# Now test passing of various references to the parser
181$p = RPC::XML::Parser::XMLParser->new();
182$str = RPC::XML::request->new('test.method')->as_string;
183$ret = $p->parse(\$str);
184isa_ok($ret, 'RPC::XML::request', '$ret from scalar reference');
185ok(ref($ret) && ($ret->name eq 'test.method'), 'Correct request method name');
186my $tmpfile = File::Spec->catfile($dir, "tmp_$$.xml");
187SKIP: {
188    if (! open $fh, '+>', $tmpfile)
189    {
190        skip "Open of $tmpfile failed, cannot test on it ($!)", 2;
191    }
192
193    print {$fh} $str;
194    seek $fh, 0, 0;
195
196    $ret = $p->parse($fh);
197    isa_ok($ret, 'RPC::XML::request', '$ret from glob reference');
198    ok((ref $ret and ($ret->name eq 'test.method')),
199       'Correct request method name');
200
201    close $fh;
202    unlink $tmpfile;
203}
204# Tweak the XML to test the error cases
205$str =~ s{</methodCall>}{};
206$ret = $p->parse(\$str);
207ok(! ref $ret, '$ret error from scalar reference');
208like($ret, qr/no element found/, 'Correct error message');
209SKIP: {
210    if (! open $fh, '+>', $tmpfile)
211    {
212        skip "Open of $tmpfile failed, cannot test on it ($!)", 2;
213    }
214
215    print {$fh} $str;
216    seek $fh, 0, 0;
217
218    $ret = $p->parse($fh);
219    ok(! ref $ret, '$ret error from glob reference');
220    like($ret, qr/no element found/, 'Correct error message');
221
222    close $fh;
223    unlink $tmpfile;
224}
225# Try an unusable reference
226$ret = $p->parse([]);
227ok(! ref $ret, 'Unusable reference did not parse to anything');
228like($ret, qr/Unusable reference type/, 'Correct error message');
229
230# Negative testing-- try to break the parser
231my $bad_counter = 1;
232sub test_bad_xml
233{
234    my ($badstring, $message) = @_;
235
236    $ret = $p->parse($badstring);
237    ok(! ref $ret, "Bad XML <$bad_counter>");
238    like($ret, qr/$message/, 'Correct error message');
239
240    $bad_counter++;
241
242    return;
243}
244
245$str = RPC::XML::request->new('name', 'foo')->as_string;
246($badstr = $str) =~ s/>name</>bad^name</;
247test_bad_xml($badstr, 'Invalid method name specified');
248($badstr = $str) =~ s{<methodName>.*</methodName>}{};
249test_bad_xml($badstr, 'No methodName tag detected');
250($badstr = $str) =~ s{<params>}{<params></params><params>};
251test_bad_xml($badstr, 'Extra content in "methodCall"');
252($badstr = $str) =~ s{params>}{paramss>}g;
253test_bad_xml($badstr, 'Unknown tag encountered: paramss');
254
255$str = RPC::XML::response->new(1)->as_string;
256($badstr = $str) =~ s{<params>}{<params></params><params>};
257test_bad_xml($badstr, 'Stack corruption detected');
258($badstr = $str) =~ s{<param>}{<param></param><param>};
259test_bad_xml($badstr, 'No <value> found within <param> container');
260($badstr = $str) =~ s{param>}{paramm>}g;
261test_bad_xml($badstr, 'Unknown tag encountered: paramm');
262($badstr = $str) =~ s{<value>}{<value></value><value>};
263test_bad_xml($badstr, 'Illegal content in param tag');
264($badstr = $str) =~ s{value>}{valuee>}g;
265test_bad_xml($badstr, 'Unknown tag encountered: valuee');
266($badstr = $str) =~ s{>1<}{>foo<};
267test_bad_xml($badstr, 'Bad integer');
268($badstr = $str) =~ s{params}{paramss}g;
269test_bad_xml($badstr, 'Unknown tag encountered: paramss');
270
271$str = RPC::XML::response->new(RPC::XML::fault->new(1, 'foo'))->as_string;
272($badstr = $str) =~ s{<fault>}{<fault><value></value>};
273test_bad_xml($badstr, 'Stack corruption detected');
274($badstr = $str) =~ s{<fault><value>}{<fault><valuee>};
275$badstr =~ s{</value></fault>}{</valuee></fault>};
276test_bad_xml($badstr, 'Unknown tag encountered: valuee');
277
278# These are a little more hairy, trying to pass an invalid fault structure.
279# Gonna hard-code the strings rather than trying to transform $str.
280$badstr = <<'EO_BADSTR';
281<?xml version="1.0" encoding="us-ascii"?>
282<methodResponse>
283  <fault>
284    <value>
285      <struct>
286        <value>str</value>
287        <member>
288          <name>faultString</name>
289          <value><string>foo</string></value>
290        </member>
291        <member>
292          <name>faultCode</name>
293          <value><int>1</int></value>
294        </member>
295      </struct>
296    </value>
297  </fault>
298</methodResponse>
299EO_BADSTR
300test_bad_xml($badstr, 'Bad content inside struct block');
301$badstr = <<'EO_BADSTR';
302<?xml version="1.0" encoding="us-ascii"?>
303<methodResponse>
304  <fault>
305    <value>
306      <struct>
307        <member>
308          <name>faultString</name>
309          <value><string>foo</string></value>
310        </member>
311        <member>
312          <name>faultCode</name>
313          <value><int>1</int></value>
314        </member>
315        <member>
316          <name>extraMember</name>
317          <value><int>1</int></value>
318        </member>
319      </struct>
320    </value>
321  </fault>
322</methodResponse>
323EO_BADSTR
324test_bad_xml($badstr, 'Extra struct fields not allowed');
325$badstr = <<'EO_BADSTR';
326<?xml version="1.0" encoding="us-ascii"?>
327<methodResponse>
328  <fault></fault>
329</methodResponse>
330EO_BADSTR
331test_bad_xml($badstr, 'Stack corruption detected');
332$badstr = <<'EO_BADSTR';
333<?xml version="1.0" encoding="us-ascii"?>
334<methodResponse>
335  <fault>
336    <value><string>foo</string></value>
337  </fault>
338</methodResponse>
339EO_BADSTR
340test_bad_xml($badstr, 'Only a <struct> value may be within a <fault>');
341
342$RPC::XML::ALLOW_NIL = 1;
343$str = RPC::XML::response->new(undef)->as_string;
344($badstr = $str) =~ s{<nil/>}{<nil>undef</nil>};
345test_bad_xml($badstr, '<nil /> element must be empty');
346
347$str = RPC::XML::request->new('foo', 1)->as_string;
348($badstr = $str) =~ s{<params>}{<params><value></value>};
349test_bad_xml($badstr, 'Illegal content in params tag');
350($badstr = $str) =~ s{<params>.*</params>}{<params><value></value></params>};
351test_bad_xml($badstr, 'Illegal content in params tag');
352($badstr = $str) =~ s{<param><value>}{<param><valuee>};
353$badstr =~ s{</value></param>}{</valuee></param>};
354test_bad_xml($badstr, 'Unknown tag encountered: valuee');
355($badstr = $str) =~ s{<value>}{<value><int>1</int>};
356test_bad_xml($badstr, 'Stack corruption detected');
357($badstr = $str) =~ s{<int>1</int>}{<double>foo</double>};
358test_bad_xml($badstr, 'Bad floating-point data read');
359
360# Parser errors specific to arrays:
361$str = RPC::XML::response->new([ 1 ])->as_string;
362($badstr = $str) =~ s{<array>}{<array><value></value>};
363test_bad_xml($badstr, 'Illegal content in array tag');
364($badstr = $str) =~ s{<data><value>}{<data><valuee>};
365$badstr =~ s{</value></data>}{</valuee></data>};
366test_bad_xml($badstr, 'Unknown tag encountered: valuee');
367($badstr = $str) =~ s{<int>1</int>}{<int>foo</int>};
368test_bad_xml($badstr, 'Bad integer data read');
369$badstr = <<'EO_BADSTR';
370<?xml version="1.0" encoding="us-ascii"?>
371<methodResponse>
372  <params>
373    <param>
374      <value>
375        <array>
376          <data>
377            <value><int>1</int></value>
378            <name>foo</name>
379          </data>
380        </array>
381      </value>
382    </param>
383  </params>
384</methodResponse>
385EO_BADSTR
386test_bad_xml($badstr, 'Bad content inside data block');
387$badstr = <<'EO_BADSTR';
388<?xml version="1.0" encoding="us-ascii"?>
389<methodResponse>
390  <params>
391    <param>
392      <value>
393        <array>
394          <data>
395            <name>foo</name>
396            <value><int>1</int></value>
397          </data>
398        </array>
399      </value>
400    </param>
401  </params>
402</methodResponse>
403EO_BADSTR
404test_bad_xml($badstr, 'Illegal content in data tag');
405
406# Parser errors specific to structs:
407$str = RPC::XML::response->new({ foo => 1 })->as_string;
408($badstr = $str) =~ s{<member>}{<member><foo />};
409test_bad_xml($badstr, 'Unknown tag encountered: foo');
410($badstr = $str) =~ s{name>}{namee>}g;
411test_bad_xml($badstr, 'Unknown tag encountered: namee');
412($badstr = $str) =~ s{<int>1</int>}{<int>foo</int>};
413test_bad_xml($badstr, 'Bad integer data');
414$badstr = <<'EO_BADSTR';
415<?xml version="1.0" encoding="us-ascii"?>
416<methodResponse>
417  <params>
418    <param>
419      <value>
420        <struct>
421          <member>
422            <name>foo</name>
423            <value><int>1</int></value>
424            <value><int>1</int></value>
425          </member>
426        </struct>
427      </value>
428    </param>
429  </params>
430</methodResponse>
431EO_BADSTR
432test_bad_xml($badstr, 'Element mismatch, expected to see name');
433$badstr = <<'EO_BADSTR';
434<?xml version="1.0" encoding="us-ascii"?>
435<methodResponse>
436  <params>
437    <param>
438      <value>
439        <struct>
440          <member>
441            <value><int>1</int></value>
442            <name>foo</name>
443          </member>
444        </struct>
445      </value>
446    </param>
447  </params>
448</methodResponse>
449EO_BADSTR
450test_bad_xml($badstr, 'Element mismatch, expected to see value');
451$badstr = <<'EO_BADSTR';
452<?xml version="1.0" encoding="us-ascii"?>
453<methodResponse>
454  <params>
455    <param>
456      <value>
457        <struct>
458          <member>
459            <name>foo</name>
460            <value><int>1</int></value>
461          </member>
462          <value><int>1</int></value>
463        </struct>
464      </value>
465    </param>
466  </params>
467</methodResponse>
468EO_BADSTR
469test_bad_xml($badstr, 'Element mismatch, expected to see member');
470$badstr = <<'EO_BADSTR';
471<?xml version="1.0" encoding="us-ascii"?>
472<methodResponse>
473  <params>
474    <param>
475      <value>
476        <struct>
477          <value><int>1</int></value>
478          <member>
479            <name>foo</name>
480            <value><int>1</int></value>
481          </member>
482        </struct>
483      </value>
484    </param>
485  </params>
486</methodResponse>
487EO_BADSTR
488test_bad_xml($badstr, 'Bad content inside struct block');
489
490# Some corner-cases in responses
491$badstr = <<'EO_BADSTR';
492<?xml version="1.0" encoding="us-ascii"?>
493<methodResponse>
494  <params>
495    <param>
496      <value><int>1</int></value>
497    </param>
498    <param>
499      <value><int>1</int></value>
500    </param>
501  </params>
502</methodResponse>
503EO_BADSTR
504test_bad_xml($badstr, 'invalid: too many params');
505$badstr = <<'EO_BADSTR';
506<?xml version="1.0" encoding="us-ascii"?>
507<methodResponse>
508  <params>
509  </params>
510</methodResponse>
511EO_BADSTR
512test_bad_xml($badstr, 'invalid: no params');
513$badstr = <<'EO_BADSTR';
514<?xml version="1.0" encoding="us-ascii"?>
515<methodResponse>
516</methodResponse>
517EO_BADSTR
518test_bad_xml($badstr, 'No parameter was declared');
519
520# Corner case(s) in requests
521$badstr = <<'EO_BADSTR';
522<?xml version="1.0" encoding="us-ascii"?>
523<methodCall>
524  <name>foo</name>
525  <methodName>foo</methodName>
526  <params></params>
527</methodCall>
528EO_BADSTR
529test_bad_xml($badstr, 'methodName tag must immediately follow a methodCall');
530
531# Test the "none of the above" error case
532($badstr = $str) =~ s/struct/structt/g;
533test_bad_xml($badstr, 'Unknown tag encountered: structt');
534
535# Test parse-end errors
536$badstr = <<'EO_BADSTR';
537<?xml version="1.0" encoding="us-ascii"?>
538<params>
539  <param>
540    <value><int>1</int></value>
541  </param>
542</params>
543EO_BADSTR
544test_bad_xml($badstr, 'End-of-parse error');
545
546# Test some of the failures related to Base64-spooling. This can only be tested
547# on non-Windows systems, as to cause some of the failures we'll need to create
548# an un-writable directory (and Windows doesn't have the same chmod concept we
549# have in other places).
550SKIP: {
551    if ($^O eq 'MSWin32' || $^O eq 'cygwin')
552    {
553        skip 'Tests involving directory permissions skipped on Windows', 1;
554    }
555    # Also cannot be reliably tested if running as root:
556    if ($< == 0)
557    {
558        skip 'Tests involving directory permissions skipped under root', 1;
559    }
560
561    my $baddir = File::Spec->catdir(File::Spec->tmpdir(), "baddir_$$");
562    if (! mkdir $baddir)
563    {
564        skip "Skipping, failed to create dir $baddir: $!", 1;
565    }
566    if (! chmod oct(600), $baddir)
567    {
568        skip "Skipping, failed to chmod dir $baddir: $!", 1;
569    }
570
571    $p = RPC::XML::Parser::XMLParser->new(
572        base64_to_fh    => 1,
573        base64_temp_dir => $baddir
574    );
575    if (! open $fh, '<', $file)
576    {
577        croak "Error opening $file: $!";
578    }
579    my $base64fail = RPC::XML::base64->new($fh);
580    $req = RPC::XML::request->new('method', $base64fail);
581    $ret = $p->parse($req->as_string);
582
583    like($ret, qr/Error opening temp file for base64/,
584         'Opening Base64 spoolfile correctly failed');
585
586    if (! rmdir $baddir)
587    {
588        carp "Failed to remove temp-dir $baddir: $!";
589    }
590}
591
592exit 0;
593