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