1#! perl -w 2 3use strict; 4use warnings; 5 6use Test::More; 7 8plan tests => 208; 9 10require HTTP::Message; 11use Config qw(%Config); 12 13my($m, $m2, @parts); 14 15$m = HTTP::Message->new; 16ok($m); 17is(ref($m), "HTTP::Message"); 18is(ref($m->headers), "HTTP::Headers"); 19is($m->as_string, "\n"); 20is($m->headers->as_string, ""); 21is($m->headers_as_string, ""); 22is($m->content, ""); 23 24$m->header("Foo", 1); 25is($m->as_string, "Foo: 1\n\n"); 26 27{ 28 # A message with an undef set content 29 # will stay consistent and have empty string 30 # as a content 31 my $m = HTTP::Message->new(); 32 $m->content(undef); 33 is($m->as_string, "\n"); 34 is($m->content, ""); 35} 36 37 38$m2 = HTTP::Message->new($m->headers); 39$m2->header(bar => 2); 40is($m->as_string, "Foo: 1\n\n"); 41is($m2->as_string, "Bar: 2\nFoo: 1\n\n"); 42is($m2->dump, "Bar: 2\nFoo: 1\n\n(no content)\n"); 43is($m2->dump(no_content => ""), "Bar: 2\nFoo: 1\n\n\n"); 44is($m2->dump(no_content => "-"), "Bar: 2\nFoo: 1\n\n-\n"); 45$m2->content('0'); 46is($m2->dump(no_content => "-"), "Bar: 2\nFoo: 1\n\n0\n"); 47is($m2->dump(no_content => "0"), "Bar: 2\nFoo: 1\n\n\\x30\n"); 48 49$m2 = HTTP::Message->new($m->headers, "foo"); 50is($m2->as_string, "Foo: 1\n\nfoo\n"); 51is($m2->as_string("<<\n"), "Foo: 1<<\n<<\nfoo"); 52$m2 = HTTP::Message->new($m->headers, "foo\n"); 53is($m2->as_string, "Foo: 1\n\nfoo\n"); 54 55$m = HTTP::Message->new([a => 1, b => 2], "abc"); 56is($m->as_string, "A: 1\nB: 2\n\nabc\n"); 57 58$m = HTTP::Message->parse(""); 59is($m->as_string, "\n"); 60$m = HTTP::Message->parse("\n"); 61is($m->as_string, "\n"); 62$m = HTTP::Message->parse("\n\n"); 63is($m->as_string, "\n\n"); 64is($m->content, "\n"); 65 66$m = HTTP::Message->parse("foo"); 67is($m->as_string, "\nfoo\n"); 68$m = HTTP::Message->parse("foo: 1"); 69is($m->as_string, "Foo: 1\n\n"); 70$m = HTTP::Message->parse("foo_bar: 1"); 71is($m->as_string, "Foo_bar: 1\n\n"); 72$m = HTTP::Message->parse("foo: 1\n\nfoo"); 73is($m->as_string, "Foo: 1\n\nfoo\n"); 74$m = HTTP::Message->parse(<<EOT); 75FOO : 1 76 2 77 3 78 4 79bar: 80 1 81Baz: 1 82 83foobarbaz 84EOT 85is($m->as_string, <<EOT); 86Bar: 87 1 88Baz: 1 89FOO: 1 90 2 91 3 92 4 93 94foobarbaz 95EOT 96 97$m = HTTP::Message->parse(<<EOT); 98Date: Fri, 18 Feb 2005 18:33:46 GMT 99Connection: close 100Content-Type: text/plain 101 102foo:bar 103second line 104EOT 105is($m->content(""), <<EOT); 106foo:bar 107second line 108EOT 109is($m->as_string, <<EOT); 110Connection: close 111Date: Fri, 18 Feb 2005 18:33:46 GMT 112Content-Type: text/plain 113 114EOT 115 116$m = HTTP::Message->parse(" abc\nfoo: 1\n"); 117is($m->as_string, "\n abc\nfoo: 1\n"); 118$m = HTTP::Message->parse(" foo : 1\n"); 119is($m->as_string, "\n foo : 1\n"); 120$m = HTTP::Message->parse("\nfoo: bar\n"); 121is($m->as_string, "\nfoo: bar\n"); 122 123$m = HTTP::Message->new([a => 1, b => 2], "abc"); 124is($m->content("foo\n"), "abc"); 125is($m->content, "foo\n"); 126 127$m->add_content("bar"); 128is($m->content, "foo\nbar"); 129$m->add_content(\"\n"); 130is($m->content, "foo\nbar\n"); 131 132is(ref($m->content_ref), "SCALAR"); 133is(${$m->content_ref}, "foo\nbar\n"); 134${$m->content_ref} =~ s/[ao]/i/g; 135is($m->content, "fii\nbir\n"); 136 137$m->clear; 138is($m->headers->header_field_names, 0); 139is($m->content, ""); 140 141is($m->parts, undef); 142$m->parts(HTTP::Message->new, 143 HTTP::Message->new([a => 1], "foo"), 144 HTTP::Message->new(undef, "bar\n"), 145 ); 146is($m->parts->as_string, "\n"); 147 148my $str = $m->as_string; 149$str =~ s/\r/<CR>/g; 150is($str, <<EOT); 151Content-Type: multipart/mixed; boundary=xYzZY 152 153--xYzZY<CR> 154<CR> 155<CR> 156--xYzZY<CR> 157A: 1<CR> 158<CR> 159foo<CR> 160--xYzZY<CR> 161<CR> 162bar 163<CR> 164--xYzZY--<CR> 165EOT 166 167$m2 = HTTP::Message->new; 168$m2->parts($m); 169 170$str = $m2->as_string; 171$str =~ s/\r/<CR>/g; 172ok($str =~ /boundary=(\S+)/); 173 174 175is($str, <<EOT); 176Content-Type: multipart/mixed; boundary=$1 177 178--$1<CR> 179Content-Type: multipart/mixed; boundary=xYzZY<CR> 180<CR> 181--xYzZY<CR> 182<CR> 183<CR> 184--xYzZY<CR> 185A: 1<CR> 186<CR> 187foo<CR> 188--xYzZY<CR> 189<CR> 190bar 191<CR> 192--xYzZY--<CR> 193<CR> 194--$1--<CR> 195EOT 196 197@parts = $m2->parts; 198is(@parts, 1); 199 200@parts = $parts[0]->parts; 201is(@parts, 3); 202is($parts[1]->header("A"), 1); 203 204$m2->parts([HTTP::Message->new]); 205@parts = $m2->parts; 206is(@parts, 1); 207 208$m2->parts([]); 209@parts = $m2->parts; 210is(@parts, 0); 211 212$m->clear; 213$m2->clear; 214 215$m = HTTP::Message->new([content_type => "message/http; boundary=aaa", 216 ], 217 <<EOT); 218GET / HTTP/1.1 219Host: www.example.com:8008 220 221EOT 222 223@parts = $m->parts; 224is(@parts, 1); 225$m2 = $parts[0]; 226is(ref($m2), "HTTP::Request"); 227is($m2->method, "GET"); 228is($m2->uri, "/"); 229is($m2->protocol, "HTTP/1.1"); 230is($m2->header("Host"), "www.example.com:8008"); 231is($m2->content, ""); 232 233$m->content(<<EOT); 234HTTP/1.0 200 OK 235Content-Type: text/plain 236 237Hello 238EOT 239 240$m2 = $m->parts; 241is(ref($m2), "HTTP::Response"); 242is($m2->protocol, "HTTP/1.0"); 243is($m2->code, "200"); 244is($m2->message, "OK"); 245is($m2->content_type, "text/plain"); 246is($m2->content, "Hello\n"); 247 248eval { $m->parts(HTTP::Message->new, HTTP::Message->new) }; 249ok($@); 250 251$m->add_part(HTTP::Message->new([a=>[1..3]], "a")); 252$str = $m->as_string; 253$str =~ s/\r/<CR>/g; 254is($str, <<EOT); 255Content-Type: multipart/mixed; boundary=xYzZY 256 257--xYzZY<CR> 258Content-Type: message/http; boundary=aaa<CR> 259<CR> 260HTTP/1.0 200 OK 261Content-Type: text/plain 262 263Hello 264<CR> 265--xYzZY<CR> 266A: 1<CR> 267A: 2<CR> 268A: 3<CR> 269<CR> 270a<CR> 271--xYzZY--<CR> 272EOT 273 274$m->add_part(HTTP::Message->new([b=>[1..3]], "b")); 275 276$str = $m->as_string; 277$str =~ s/\r/<CR>/g; 278is($str, <<EOT); 279Content-Type: multipart/mixed; boundary=xYzZY 280 281--xYzZY<CR> 282Content-Type: message/http; boundary=aaa<CR> 283<CR> 284HTTP/1.0 200 OK 285Content-Type: text/plain 286 287Hello 288<CR> 289--xYzZY<CR> 290A: 1<CR> 291A: 2<CR> 292A: 3<CR> 293<CR> 294a<CR> 295--xYzZY<CR> 296B: 1<CR> 297B: 2<CR> 298B: 3<CR> 299<CR> 300b<CR> 301--xYzZY--<CR> 302EOT 303 304$m = HTTP::Message->new; 305$m->add_part(HTTP::Message->new([a=>[1..3]], "a")); 306is($m->header("Content-Type"), "multipart/mixed; boundary=xYzZY"); 307$str = $m->as_string; 308$str =~ s/\r/<CR>/g; 309is($str, <<EOT); 310Content-Type: multipart/mixed; boundary=xYzZY 311 312--xYzZY<CR> 313A: 1<CR> 314A: 2<CR> 315A: 3<CR> 316<CR> 317a<CR> 318--xYzZY--<CR> 319EOT 320 321$m = HTTP::Message->new(['Content-Type' => 'multipart/mixed']); 322$m->add_part(HTTP::Message->new([], 'foo and a lot more content')); 323is($m->header("Content-Type"), "multipart/mixed; boundary=xYzZY"); 324@parts = $m->parts; 325is($parts[0]->content, 'foo and a lot more content'); 326like($parts[0]->dump(maxlength => 4), qr/foo \.\.\./); 327like($parts[0]->dump(maxlength => 0), qr/foo and a lot/); 328eval { $m->encode; }; 329like($@, qr/Can't encode multipart/); 330$m->content_type('message/http'); 331eval { $m->encode; }; 332like($@, qr/Can't encode message/); 333 334$m = HTTP::Message->new; 335$m->content_ref(\my $foo); 336is($m->content_ref, \$foo); 337$foo = "foo"; 338is($m->content, "foo"); 339$m->add_content("bar"); 340is($foo, "foobar"); 341is($m->as_string, "\nfoobar\n"); 342$m->content_type("message/foo"); 343$m->parts(HTTP::Message->new(["h", "v"], "C")); 344is($foo, "H: v\r\n\r\nC"); 345$foo =~ s/C/c/; 346$m2 = $m->parts; 347is($m2->content, "c"); 348 349$m = HTTP::Message->new; 350$foo = []; 351$m->content($foo); 352is($m->content, $foo); 353is(${$m->content_ref}, $foo); 354is(${$m->content_ref([])}, $foo); 355isnt($m->content_ref, $foo); 356eval {$m->add_content("x")}; 357like($@, qr/^Can't append to ARRAY content/); 358 359$foo = sub { "foo" }; 360$m->content($foo); 361is($m->content, $foo); 362is(${$m->content_ref}, $foo); 363 364$m->content_ref($foo); 365is($m->content, $foo); 366is($m->content_ref, $foo); 367 368eval {$m->content_ref("foo")}; 369like($@, qr/^Setting content_ref to a non-ref/); 370 371$m->content_ref(\"foo"); 372eval {$m->content("bar")}; 373like($@, qr/^Modification of a read-only value/); 374 375$foo = "foo"; 376$m->content_ref(\$foo); 377is($m->content("bar"), "foo"); 378is($foo, "bar"); 379is($m->content, "bar"); 380is($m->content_ref, \$foo); 381 382$m = HTTP::Message->new; 383$m->content("fo=6F"); 384is($m->decoded_content, "fo=6F"); 385$m->header("Content-Encoding", "quoted-printable"); 386is($m->decoded_content, "foo"); 387 388for my $encoding (qw/gzip x-gzip/) { 389 $m = HTTP::Message->new; 390 $m->header("Content-Encoding", "$encoding, base64"); 391 $m->content_type("text/plain; charset=UTF-8"); 392 $m->content("H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n"); 393 394 $@ = ""; 395 is(eval { $m->decoded_content }, "\x{FEFF}Hi there \x{263A}\n"); 396 is($@ || "", ""); 397 is($m->content, "H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n"); 398 399 $m2 = $m->clone; 400 ok($m2->decode); 401 is($m2->header("Content-Encoding"), undef); 402 like($m2->content, qr/Hi there/); 403 404 ok(grep { $_ eq "$encoding" } $m->decodable); 405 406 my $tmp = MIME::Base64::decode($m->content); 407 $m->content($tmp); 408 $m->header("Content-Encoding", "$encoding"); 409 $@ = ""; 410 is(eval { $m->decoded_content }, "\x{FEFF}Hi there \x{263A}\n"); 411 is($@ || "", ""); 412 is($m->content, $tmp); 413 414 my $m2 = HTTP::Message->new([ 415 "Content-Type" => "text/plain", 416 ], 417 "Hi there\n" 418 ); 419 ok($m2->encode($encoding)); 420 is($m2->header("Content-Encoding"), $encoding); 421 unlike($m2->content, qr/Hi there/); 422 is($m2->decoded_content, "Hi there\n"); 423 ok($m2->decode); 424 is($m2->content, "Hi there\n"); 425} 426 427$m->remove_header("Content-Encoding"); 428$m->content("a\xFF"); 429 430is($m->decoded_content, "a\x{FFFD}"); 431is($m->decoded_content(charset_strict => 1), undef); 432 433$m->header("Content-Encoding", "foobar"); 434is($m->decoded_content, undef); 435like($@, qr/^Don't know how to decode Content-Encoding 'foobar'/); 436 437my $err = 0; 438eval { 439 $m->decoded_content(raise_error => 1); 440 $err++; 441}; 442like($@, qr/Don't know how to decode Content-Encoding 'foobar'/); 443is($err, 0); 444 445eval { 446 HTTP::Message->new([], "\x{263A}"); 447}; 448like($@, qr/bytes/); 449$m = HTTP::Message->new; 450eval { 451 $m->add_content("\x{263A}"); 452}; 453like($@, qr/bytes/); 454eval { 455 $m->content("\x{263A}"); 456}; 457like($@, qr/bytes/); 458 459# test the add_content_utf8 method 460$m = HTTP::Message->new(["Content-Type", "text/plain; charset=UTF-8"]); 461$m->add_content_utf8("\x{263A}"); 462$m->add_content_utf8("-\xC5"); 463is($m->content, "\xE2\x98\xBA-\xC3\x85"); 464is($m->decoded_content, "\x{263A}-\x{00C5}"); 465 466$m = HTTP::Message->new([ 467 "Content-Type", "text/plain", 468 ], 469 "Hello world!" 470); 471$m->content_length(length $m->content); 472$m->encode("deflate"); 473$m->dump(prefix => "# "); 474is($m->dump(prefix => "| "), <<'EOT'); 475| Content-Encoding: deflate 476| Content-Type: text/plain 477| 478| x\x9C\xF3H\xCD\xC9\xC9W(\xCF/\xCAIQ\4\0\35\t\4^ 479EOT 480for my $encoding (qw/identity none/) { 481 my $m2 = $m->clone; 482 $m2->encode("base64", $encoding); 483 is($m2->as_string, <<"EOT"); 484Content-Encoding: deflate, base64, $encoding 485Content-Type: text/plain 486 487eJzzSM3JyVcozy/KSVEEAB0JBF4= 488EOT 489 is($m2->decoded_content, "Hello world!"); 490} 491 492# Raw RFC 1951 deflate 493$m = HTTP::Message->new([ 494 "Content-Type" => "text/plain", 495 "Content-Encoding" => "deflate, base64", 496 ], 497 "80jNyclXCM8vyklRBAA=" 498 ); 499is($m->decoded_content, "Hello World!"); 500ok(!$m->header("Client-Warning")); 501 502 503if (eval "require IO::Uncompress::Bunzip2") { 504 for my $encoding (qw/x-bzip2 bzip2/) { 505 $m = HTTP::Message->new([ 506 "Content-Type" => "text/plain", 507 "Content-Encoding" => "$encoding, base64", 508 ], 509 "QlpoOTFBWSZTWcvLx0QAAAHVgAAQYAAAQAYEkIAgADEAMCBoYlnQeSEMvxdyRThQkMvLx0Q=\n" 510 ); 511 is($m->decoded_content, "Hello world!\n"); 512 ok($m->decode); 513 is($m->content, "Hello world!\n"); 514 515 if (eval "require IO::Compress::Bzip2") { 516 $m = HTTP::Message->new([ 517 "Content-Type" => "text/plain", 518 ], 519 "Hello world!" 520 ); 521 ok($m->encode($encoding)); 522 is($m->header("Content-Encoding"), $encoding); 523 like($m->content, qr/^BZh.*\0/); 524 is($m->decoded_content, "Hello world!"); 525 ok($m->decode); 526 is($m->content, "Hello world!"); 527 } 528 else { 529 skip("Need IO::Compress::Bzip2", undef) for 1..6; 530 } 531 } 532} 533else { 534 skip("Need IO::Uncompress::Bunzip2", undef) for 1..18; 535} 536 537# test decoding of XML content 538$m = HTTP::Message->new(["Content-Type", "application/xml"], "\xFF\xFE<\0?\0x\0m\0l\0 \0v\0e\0r\0s\0i\0o\0n\0=\0\"\x001\0.\x000\0\"\0 \0e\0n\0c\0o\0d\0i\0n\0g\0=\0\"\0U\0T\0F\0-\x001\x006\0l\0e\0\"\0?\0>\0\n\0<\0r\0o\0o\0t\0>\0\xC9\0r\0i\0c\0<\0/\0r\0o\0o\0t\0>\0\n\0"); 539is($m->decoded_content, "<?xml version=\"1.0\"?>\n<root>\xC9ric</root>\n"); 540 541# DESTROY is a no-op 542$m->DESTROY; 543is($m->decoded_content, "<?xml version=\"1.0\"?>\n<root>\xC9ric</root>\n"); 544 545$m = HTTP::Message->new([ 546 "Content-Type" => "text/plain", 547 ], 548 "Hello World!\n" 549); 550is($m->content, "Hello World!\n"); 551ok($m->encode()); 552is($m->content, "Hello World!\n"); 553is($m->encode("not-an-encoding"), 0); 554is($m->content, "Hello World!\n"); 555ok($m->encode("rot13")); 556is($m->header("Content-Encoding"), "rot13"); 557is($m->content, "Uryyb Jbeyq!\n"); 558 559for my $encoding (qw/compress x-compress/) { 560 $m = HTTP::Message->new([ 561 "Content-Type" => "text/plain", 562 "Content-Encoding" => $encoding, 563 ], "foo"); 564 eval { $m->decoded_content(raise_error => 1); }; 565 like($@, qr/Can't uncompress content/); 566} 567 568eval { $m = HTTP::Message->new('bad-header'); }; 569like($@, qr/Bad header argument/); 570$m = HTTP::Message->new(['Content-Encoding' => 'zog']); 571is($m->decode, 0); 572$m = HTTP::Message->new; 573ok($m->decode); 574{ 575 my @warn; 576 local $SIG{__WARN__} = sub { push @warn, @_ }; 577 local $^W = 0; 578 $m->content; 579 is($#warn, -1); 580 local $^W = 1; 581 $m->content; 582 is($#warn, 0); 583 like($warn[0], qr/Useless content call in void context/); 584} 585is($m->content(undef), ''); 586eval { $m->content(\'foo'); }; 587like($@, qr/Can't set content to be a scalar reference/); 588 589$m = HTTP::Message->new (["Content-Type" => "text/plain",], "\xEF\xBB\xBFaa/"); 590is($m->content_charset, "UTF-8"); 591$m->content("\xFF\xFE\x00\x00aa/"); 592is($m->content_charset, "UTF-32LE"); 593$m->content("\x00\x00\xFE\xFFaa/"); 594is($m->content_charset, "UTF-32BE"); 595$m->content("\xFF\xFEaa/"); 596is($m->content_charset, "UTF-16LE"); 597$m->content("\xFE\xFFaa/"); 598is($m->content_charset, "UTF-16BE"); 599 600{ 601 $m = HTTP::Message->new; 602 local $@ = 'pre-existing error'; 603 $m->decodable; 604 is($@, 'pre-existing error', 'decodable() does not overwrite $@'); 605} 606 607$m = HTTP::Message->new(["User-Agent" => "Mozilla/5.0", "Referer" => "https://example.com/"]); 608ok($m->can('content')); 609my $method = $m->can('user_agent'); 610is(ref($method), 'CODE'); 611is(HTTP::Message->can('user_agent'), $method); 612is($m->$method, "Mozilla/5.0"); 613 614ok(HTTP::Message->can('content')); 615$method = HTTP::Message->can('referrer'); 616is(ref($method), 'CODE'); 617is($m->can('referrer'), $method); 618is($m->$method, "https://example.com/"); 619 620eval { $m->unknown_method; }; 621like $@, qr/Can't locate object method "unknown_method" via package "HTTP::Message"/; 622is($m->can('unknown_method'), undef); 623eval { HTTP::Message->unknown_method; }; 624like $@, qr/Can't locate object method "unknown_method" via package "HTTP::Message"/; 625is(HTTP::Message->can('unknown_method'), undef); 626eval { my $empty = ""; $m->$empty; }; 627like $@, qr/Can't locate object method "" via package "HTTP::Message"/; 628