use WWW::Mechanize; use HTTP::Request; use HTTP::Response; my $randomtext = $ARGV[0]; my $host = "localhost:15840"; my $url = "http://${host}"; my $mech = WWW::Mechanize->new( autocheck => 1 ); my $noautomech = WWW::Mechanize->new( autocheck => 0 ); eval { sub urlexists { my($suburl) = @_; $mech->get($url . $suburl); } sub urlin { my($suburl,$regexp) = @_; $mech->get($url . $suburl); die "$regexp not in ${url}${suburl}. Contents:\n" . $mech->content . "\n" unless $mech->content =~ $regexp; die "Random text not found in ${url}${suburl}. Content: ". $mech->content unless $mech->content =~ qr/\|RANDOMID=$randomtext\|/; } sub urlnotexist { my($suburl) = @_; $noautomech->get($url . $suburl); die "URL ${url}${suburl} should not exist! It does. Content: " . $noautomech->content if $noautomech->success; } sub urlstatus { my($suburl,$status) = @_; $noautomech->get($url . $suburl); my $retstatus = $noautomech->status(); die "URL ${url}${suburl} returned status code $retstatus, when $status was expected." unless $status == $retstatus; } ############### TESTS GO HERE ######################### # Test a simple handler urlin "/handler", qr/simple handler/; # Test the matching system # Strict match should match itself, but not more urlin "/strict-match/", qr/strict matcher/; urlnotexist "/strict-match/more"; # Loose match should match itself and more urlin "/loose-match/", qr/loose matcher/; urlin "/loose-match/more", qr/loose matcher/; # HTML stream basics urlin "/html/html-stream", qr[\s* \s*

\s*testing\s*

\s*

\s*\s*foo\s*\s*

\s*

\s*\|RANDOMID=$randomtext\|\s*

\s*\s*]ix; # Now! With! HTML! Escaping! # -- araneida escapes using character codes - that's why these things are the way they are urlin "/html/html-escaped-stream", qr[\s* \s*

\s*testing\s&\#38;\swaiting\s*

\s*

\s*\s*foo\s&\#62;\sbar\s*\s*

\s*

\s*\|RANDOMID=$randomtext\|\s*

\s*\s*]ix; # link functionality urlin "/url/link", qr/\?slays=everything%20but%20squid&ow=yes/; urlin "/url/link?and=this", qr/\?slays=everything%20but%20squid&ow=yes&and=this/; # test the root-handler urlin "/root-handler/", qr/root-handler-tester/; urlin "/root-handler2/", qr/root-handler-tester2/; # test a dispatching handler's base response urlin "/dispatch-handler/", qr/dispatch handler/; urlin "/dispatch-handler/subhandler", qr/dispatch subhandler handler/; # test a dispatching dispatching handler urlin "/dispatch-dispatch/dispatch1/", qr/dispatch 1 handler/; urlin "/dispatch-dispatch/dispatch1/loose", qr/d1loose/; urlin "/dispatch-dispatch/dispatch1/loose/pass", qr/d1loose/; urlin "/dispatch-dispatch/dispatch1/strict", qr/d1strict/; urlin "/dispatch-dispatch/dispatch1/strict/fail", qr/dispatch 1 handler/; urlin "/dispatch-dispatch/dispatch1/dispatch2/", qr/dispatch 2 handler/; urlin "/dispatch-dispatch/dispatch1/dispatch2/loose", qr/d2loose/; urlin "/dispatch-dispatch/dispatch1/dispatch2/loose/pass", qr/d2loose/; urlin "/dispatch-dispatch/dispatch1/dispatch2/strict", qr/d2strict/; urlin "/dispatch-dispatch/dispatch1/dispatch2/strict/fail", qr/dispatch 2 handler/; urlin "/dispatch-dispatch-root/dispatch1/", qr/dispatch 1 handler/; urlin "/dispatch-dispatch-root/dispatch1/loose", qr/d1loose/; urlin "/dispatch-dispatch-root/dispatch1/loose/pass", qr/d1loose/; urlin "/dispatch-dispatch-root/dispatch1/strict", qr/d1strict/; urlin "/dispatch-dispatch-root/dispatch1/strict/fail", qr/dispatch 1 handler/; urlin "/dispatch-dispatch-root/dispatch1/dispatch2/", qr/dispatch 2 handler/; urlin "/dispatch-dispatch-root/dispatch1/dispatch2/loose", qr/d2loose/; urlin "/dispatch-dispatch-root/dispatch1/dispatch2/loose/pass", qr/d2loose/; urlin "/dispatch-dispatch-root/dispatch1/dispatch2/strict", qr/d2strict/; urlin "/dispatch-dispatch-root/dispatch1/dispatch2/strict/fail", qr/dispatch 2 handler/; urlin "/dispatch-dispatch-root2/dispatch1/", qr/dispatch 1 handler/; urlin "/dispatch-dispatch-root2/dispatch1/loose", qr/d1loose/; urlin "/dispatch-dispatch-root2/dispatch1/loose/pass", qr/d1loose/; urlin "/dispatch-dispatch-root2/dispatch1/strict", qr/d1strict/; urlin "/dispatch-dispatch-root2/dispatch1/strict/fail", qr/dispatch 1 handler/; urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/", qr/dispatch 2 handler/; urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/loose", qr/d2loose/; urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/loose/pass", qr/d2loose/; urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/strict", qr/d2strict/; urlin "/dispatch-dispatch-root2/dispatch1/dispatch2/strict/fail", qr/dispatch 2 handler/; # test error responses urlstatus "/error/bad-request", 400; urlstatus "/error/unauthorized", 401; urlstatus "/error/payment-required", 402; urlstatus "/error/forbidden", 403; urlstatus "/error/not-found", 404; urlstatus "/error/method-not-allowed", 405; urlstatus "/error/not-acceptable", 406; urlstatus "/error/proxy-authentication-required", 407; urlstatus "/error/request-time-out", 408; urlstatus "/error/conflict", 409; urlstatus "/error/gone", 410; urlstatus "/error/length-required", 411; urlstatus "/error/precondition-failed", 412; urlstatus "/error/request-entity-too-large", 413; urlstatus "/error/request-url-too-large", 414; urlstatus "/error/unsupported-media-type", 415; urlstatus "/error/internal-server-error", 500; urlstatus "/error/not-implemented", 501; urlstatus "/error/bad-gateway", 502; urlstatus "/error/service-unavailable", 503; urlstatus "/error/gateway-time-out", 504; urlstatus "/error/version-not-supported", 505; # Test request-redirect # explanation: we go to the first and are redirected to the second. We therefore should get the text # of the second. urlin "/redirect/first", qr/redirect second handler/; urlin "/redirect-handler/first", qr/redirect-handler second handler/; # Test cookie request # Cookies are tested twice: once to see if the client gets them correctly # and once again on the server side to make the server gets them correctly # there's a redirect from receive to send, so make sure of that then check cookies urlin "/cookie/send", qr/cookie receive handler/; my $tmp = sub { urlin "/cookie/receive", @_ }; $tmp->(qr/unsafecookie simplecookie=simple-value/); $tmp->(qr/safecookie simplecookie=simple-value/); $tmp->(qr/unsafecookie ladencookie=123ladenvalue123---/); $tmp->(qr/safecookie ladencookie=123ladenvalue123---/); sub cookie_check { # now check the local side my %cookies_found = {}; $mech->cookie_jar->scan(sub { my($ver,$key,$val,$path,$domain,$port) = @_; $cookies_found{$key} = $val; }); my($key,$val) = @_; if ($val = -1) { exists $cookies_found{$key} or die "No such cookie $key"; } else { exists $cookies_found{$key} && $cookies_found{$key} == $val or die "Cookie $key=$val not found" } } sub cookie_value_isnot { my %cookies_found = {}; $mech->cookie_jar->scan(sub { my($ver,$key,$val) = @_; $cookies_found{$key} = $val; }); my($key,$val) = @_; die "Cookie $key not found" unless exists $cookies_found{$key}; die "Cookie $key=$val but should not have!" unless $cookies_found{$key} ne $val; } sub get_cookie_info { my %cookies_found = {}; $mech->cookie_jar->scan(sub { $cookies_found{$_[1]} = \@_; }); my($key) = @_; @{$cookies_found{$key}}; } cookie_check "simplecookie", "simple-value"; cookie_check "ladencookie", "123ladenvalue123---"; # Test conditional get urlin "/conditional-get", qr/handler/; my $request = HTTP::Request->new('GET', $url . "/conditional-get"); $request->header('If-Modified-Since' => HTTP::Date::time2str()); my $response = $noautomech->request($request); die "Conditional get failed with ${url}/conditional-get . Returned code " . $response->code unless $response->code == 304; # Test parameters sub param_check { urlin "/paramtest?foo=bar", @_; } param_check qr/foo-alist bar/; param_check qr/foo untaint case bar/; param_check qr/foo untaint nocase bar/; param_check qr/foo taint case bar/; param_check qr/foo taint nocase bar/; param_check qr/foo type taint case TAINTED-VALUE/; param_check qr/foo type taint nocase TAINTED-VALUE/; # Test with-params functionality urlin "/with-paramtest?foo=bim;bar=baz", qr/foo: bim/; urlin "/with-paramtest?foo=bim;bar=baz", qr/bar: baz/; urlin "/with-paramtest?foo=bim", qr/foo: bim/; urlin "/with-paramtest?foo=bim", qr/bar: nil/; urlin "/with-paramtest?foo=bim", qr/bop: cat/; # test defaults urlin "/with-paramtest?bop=brop", qr/bop: brop/; # test setting the value urlin "/with-paramtest?foo=bim", qr/multi: nil/; # test multiple value default urlin "/with-paramtest?multi=1", qr/multi: 1/; # test multiple value single urlin "/with-paramtest?multi=1&multi=2", qr/multi: 12/; # test multiple value double # Test with-tainted-params functionality urlin "/with-tainted-paramtest?foo=bim;bar=baz", qr/taint-foo: bim/; urlin "/with-tainted-paramtest?foo=bim;bar=baz", qr/taint-bar: baz/; urlin "/with-tainted-paramtest?foo=bim", qr/taint-foo: bim/; urlin "/with-tainted-paramtest?foo=bim", qr/taint-bar: nil/; urlin "/with-paramtest?foo=bim", qr/bop: cat/; urlin "/with-paramtest?bop=brop", qr/bop: brop/; urlin "/with-paramtest?foo=bim", qr/multi: nil/; # test multiple value default urlin "/with-paramtest?multi=1", qr/multi: 1/; # test multiple value single urlin "/with-paramtest?multi=1&multi=2", qr/multi: 12/; # test multiple value double # Test detainting urlin "/with-detaint?number1=7&number2=7&nestring1=yes&nestring2=yes&symbol1=yes", qr/number1: 7 is a number T/; urlin "/with-detaint?number1=7&number2=7&nestring1=yes&nestring2=yes&symbol1=yes", qr/number2: 7 is a number T/; urlin "/with-detaint?number1=7&number2=7&nestring1=yes&nestring2=yes&symbol1=yes", qr/nestring1: yes is of length 3/; urlin "/with-detaint?number1=7&number2=7&nestring1=yes&nestring2=yes&symbol1=yes", qr/nestring2: yes is of length 3/; urlin "/with-detaint?number1=7&number2=7&nestring1=yes&nestring2=yes&symbol1=yes", qr/symbol1: YES is eql to YES true/; urlin "/with-detaint?number1=a&number2=a&nestring1=&nestring2=&symbol1=", qr/number1: NIL is a number NIL/; urlin "/with-detaint?number1=a&number2=a&nestring1=&nestring2=&symbol1=", qr/number2: 0 is a number T/; urlin "/with-detaint?number1=a&number2=a&nestring1=&nestring2=&symbol1=", qr/nestring1: NIL is of length 0/; urlin "/with-detaint?number1=a&number2=a&nestring1=&nestring2=&symbol1=", qr/nestring2: cat is of length 3/; urlin "/with-detaint?number1=a&number2=a&nestring1=&nestring2=&symbol1=", qr/symbol1: NIL is eql to YES false/; # Test alternate MIME types { my $response = $mech->get($url."/mime/text-plain"); die "Expected MIME type text/plain, got MIME type ${response->content_type} for ${url}/mime/text-plain" unless $response->content_type == "text/plain"; } # Test authentication urlstatus "/authenticated/test", 401; $mech->credentials($host,"testrealm","testuser","testpass"); urlin "/authenticated/test", qr/authenticated test handler/; # Test authorization urlstatus "/authorization/test", 401; $mech->add_header( Referer => "http://example.com/foobar"); urlin "/authorization/test", qr/authorization test handler/; # Test attach-hierarchy urlin "/hier/foo", qr/hier foo handler/; urlin "/hier/bar", qr!hier bar handler: \Q$url\E/hier/bar\.!; # Test advanced attach-hierarchy urlin "/hier-advanced/foo", qr/hier-advanced foo handler: mooofooo/; urlin "/hier-advanced/bar", qr/hier-advanced bar handler/; urlin "/hier-advanced/yes", qr!hieradv xbase mim = yes - \Q$url\E/hier-advanced/\.!; urlin "/hier-advanced/no", qr!hieradv xbase mim = no - \Q$url\E/hier-advanced/\.!; urlin "/hier-advanced/maybe", qr!hieradv xbase mim = maybe - \Q$url\E/hier-advanced/\.!; urlin "/hier-advanced/so", qr!hieradv xbase mim = so - \Q$url\E/hier-advanced/\.!; # Test basic parametermethods urlin "/parametermethod/basic", qr/Hello World!/; urlin "/parametermethod/basic?greeting=go+away", qr/go away/; # Test basic tainted parametermethods urlin "/parametermethod/taintedbasic", qr/Hello World!/; urlin "/parametermethod/taintedbasic?greeting=go+away", qr/go away/; # Test basic parametermethods with function parameters urlin "/parametermethod/funcparams1", qr/one Hello World!/; urlin "/parametermethod/funcparams1?greeting=go+away", qr/one go away/; urlin "/parametermethod/funcparams2", qr/two Hello World!/; urlin "/parametermethod/funcparams2?greeting=go+away", qr/two go away/; # Test basic specialized handlers urlin "/parametermethod/specialize", qr/Hello yourself!/; urlin "/parametermethod/specialize?message=go+away", qr/go away/; urlin "/parametermethod/specialize?message=goodbye", qr/The goodbye message!/; # Test no parameters urlin "/parametermethod/noparams?foo=foo", qr/noparam Foo provided/; urlin "/parametermethod/noparams", qr/noparam No parameters given/; # Test # key precendence urlin "/parametermethod/test1", qr/test1 You should see this. Foo: foo Bar: bar/; urlin "/parametermethod/test1?foo=bim&bar=baz", qr/test1 You should see this. Foo: bim Bar: baz/; # Test # specialized requires precedence urlin "/parametermethod/test2?foo=foo&bar=baz", qr/test2 You should see this. Foo: foo Bar: baz/; urlin "/parametermethod/test2?foo=bim&bar=baz", qr/test2 When foo is "foo" you should NOT see this. Foo: bim Bar: baz/; # Test # specialized requires precedence urlin "/parametermethod/test3?foo=foo&bar=baz", qr/test3 You should see this. Foo: foo Bar: baz/; urlin "/parametermethod/test3?foo=bim", qr/test3 When bar exists you should NOT see this. Foo: bim Bar: bozo/; # Test parameter order urlin "/parametermethod/paramorder", qr/paramorder a: thedefault-a b: thedefault-b c: thedefault-c/; urlin "/parametermethod/paramorder?a=1&b=2&c=3", qr/paramorder a: 1 b: 2 c: 3/; # Test tainted and untainted key value defaults urlin "/parametermethod/defaultkeyvalues?r=yes", qr/defaultkeyvalues r: yes a: thedefault-a b: thedefault-b c: thedefault-c/; urlin "/parametermethod/defaultkeyvalues-tainted?r=yes", qr/defaultkeyvalues-tainted r: yes a: thedefault-a b: thedefault-b c: thedefault-c/; # Test that conditions are thrown urlin "/parametermethod/conditioncheck", qr/all is well/; # Test template usage urlin "/template", qr{

contents\s*

}; # Test HTML macros urlin "/html/tag-basic", qr{Mug of joe\? c\|_\|}; urlin "/html/tag-advanced", qr{}i; # Test session variables urlin "/session/one", qr{s-one: foo yes bar no baz maybe}; cookie_check "X_SESSIONDEFAULT", -1; urlin "/session/two", qr{s-two: foo yes bar no baz maybe}; urlin "/session/three", qr{s-three: foo yes bar no baz maybe}; urlin "/session/four", qr{s-four: foo newfoo bar newbar baz newbaz}; urlin "/session/five", qr{s-five: foo NIL bar NIL baz NIL}; urlin "/session2/one", qr{
\s*s-one: foo foo1 bar bar1 baz baz1\s*s-one: foo foo2 bar bar2 baz baz2}; cookie_check "X_SESSIONDEFAULT", -1; cookie_check "X_SESSIONALT", -1; urlin "/session2/two", qr{
\s*s-two: foo foo1 bar bar1 baz baz1\s*s-two: foo foo2 bar bar2 baz baz2}; # Try to get a valid cookie to give to the server $mech->cookie_jar->clear(); urlin "/session/nonesuch", qr{NILxNIL}; my @sample_cookie = get_cookie_info "X_SESSIONDEFAULT"; $mech->cookie_jar->clear(); $sample_cookie[2] = "100000000000000000000000001"; $mech->cookie_jar->set_cookie(@sample_cookie); urlin "/session/nonesuch", qr{NILxNIL}; cookie_value_isnot "X_SESSIONDEFAULT", "100000000000000000000000001"; urlin "/session/nonesuch", qr{NILxquark}; # Quit urlin "/quit", qr/quitting/; }; if ($@) { print "Failure: $@\n"; print "Quitting.\n"; $noautomech->get($url."/quit"); exit 1; } ############################################# print "All tests passed\n"; exit 0;