1#!/usr/bin/env perl 2# Attempt to produce all errors when running Net::Server 3 4use warnings; 5use strict; 6 7use Test::More; 8use XML::Compile::WSDL11; 9use XML::Compile::SOAP11; 10use XML::Compile::SOAP::Util ':soap11'; 11 12use HTTP::Request; 13 14BEGIN 15{ eval "require Net::Server"; 16 my $has_net_server = $@ ? 0 : 1; 17 18 eval "require LWP"; 19 my $has_lwp = $@ ? 0 : 1; 20 21 $has_net_server && $has_lwp 22 or plan skip_all => "Net::Server and LWP are required for these tests"; 23 24 $^O ne 'MSWin32' 25 or plan skip_all => "Please contribute by porting tests to Windows"; 26} 27 28use constant 29 { SERVERHOST => 'localhost' 30 , SERVERPORT => 8876 31 }; 32 33plan tests => 18; 34 35require_ok('XML::Compile::SOAP::Daemon::NetServer'); 36require_ok('LWP::UserAgent'); 37 38my $daemon = XML::Compile::SOAP::Daemon::NetServer->new; 39 40my $pidfile = "soapdaemon-test.pid"; 41unlink $pidfile; 42 43my $soapenv = SOAP11ENV; 44 45unless(fork()) 46{ # Child 47 48# test-script debugging 49# use Log::Report mode => 3; 50 51 $daemon->run 52 ( name => 'Test server' 53 , host => SERVERHOST 54 , port => SERVERPORT 55 56 , pid_file => $pidfile 57 , min_servers => 1 58 , max_servers => 1 59 , min_spare_servers => 0 60 , max_spare_servers => 0 61 ); 62} 63 64my $daemon_pid; 65ATTEMPT: 66foreach my $attempt (1..10) 67{ if(open PID, '<', $pidfile) 68 { $daemon_pid = <PID>; 69 close PID; 70 chomp $daemon_pid; 71 last ATTEMPT; 72 } 73 sleep 1; 74} 75 76unless($daemon_pid) 77{ plan skip_all => "Unable to start daemon"; 78} 79 80sub stop_daemon() 81{ defined $daemon_pid or return; 82 ok(1, "Stopping daemon $daemon_pid"); 83 kill TERM => $daemon_pid; 84 sleep(1); 85} 86 87END { stop_daemon } 88 89sub compare_answer($$$) 90{ my ($answer, $expected, $text) = @_; 91 isa_ok($answer, 'HTTP::Response'); 92 UNIVERSAL::isa($answer, 'HTTP::Response') or return; 93 94 # error not always the same for various libxml versions 95 my $content = $answer->decoded_content; 96 $content =~ s/( error\:) .*\z/$1 LIBXML-ERROR\n/s; 97 98 my $h = $answer->headers; 99 my $a = join "\n" 100 , $answer->code 101 , $answer->message 102 , $answer->content_type, '' 103 , $content; 104 $a =~ s/\s*\z/\n/; 105 106 is($a, $expected, $text); 107} 108 109### 110### BEGIN 111### 112 113ok(1, "Started daemon $daemon_pid"); 114isa_ok($daemon, 'XML::Compile::SOAP::Daemon::NetServer'); 115 116my $ua = LWP::UserAgent->new; 117isa_ok($ua, 'LWP::UserAgent'); 118 119my $uri = "http://".SERVERHOST.":".SERVERPORT; 120 121### GET request 122 123my $req1 = HTTP::Request->new(GET => $uri); 124my $ans1 = $ua->request($req1); 125 126compare_answer($ans1, <<__EXPECTED, 'not POST'); 127405 128only POST or M-POST 129text/plain 130 131[405] attempt to connect via GET 132__EXPECTED 133 134### Non XML POST request 135 136my $req2 = HTTP::Request->new(POST => $uri); 137my $ans2 = $ua->request($req2); 138 139compare_answer($ans2, <<__EXPECTED, 'not XML'); 140406 141required is XML 142text/plain 143 144[406] content-type seems to be text/plain, must be some XML 145__EXPECTED 146 147### XML parsing fails 148 149my $req4 = HTTP::Request->new(POST => $uri); 150$req4->header(Content_Type => 'text/xml'); 151$req4->header(soapAction => ''); 152$req4->content("<bad-xml>"); 153my $ans4 = $ua->request($req4); 154 155compare_answer($ans4, <<__EXPECTED, 'parsing error'); 156422 157XML syntax error 158text/plain 159 160[422] The XML cannot be parsed: error: LIBXML-ERROR 161__EXPECTED 162 163### Not SOAP Envelope 164 165my $req5 = HTTP::Request->new(POST => $uri); 166$req5->header(Content_Type => 'text/xml'); 167$req5->header(soapAction => ''); 168$req5->content("<not-soap></not-soap>"); 169my $ans5 = $ua->request($req5); 170 171compare_answer($ans5, <<__EXPECTED, 'no soap envelope'); 172403 173message not SOAP 174text/plain 175 176[403] The message was XML, but not SOAP; not an Envelope but `not-soap' 177__EXPECTED 178 179### Unknown SOAP Envelope 180 181my $req6 = HTTP::Request->new(POST => $uri); 182$req6->header(Content_Type => 'text/xml'); 183$req6->header(soapAction => ''); 184$req6->content('<me:Envelope xmlns:me="xx"></me:Envelope>'); 185my $ans6 = $ua->request($req6); 186 187compare_answer($ans6, <<__EXPECTED, 'unknown soap envelope'); 188501 189SOAP version not supported 190text/plain 191 192[501] The soap version `xx' is not supported 193__EXPECTED 194 195 196### Message not found 197 198my $req7 = HTTP::Request->new(POST => $uri); 199$req7->header(Content_Type => 'text/xml'); 200$req7->header(soapAction => ''); 201$req7->content( <<_NO_SUCH); 202<me:Envelope xmlns:me="$soapenv"> 203 <me:Body> 204 <me:something /> 205 </me:Body> 206</me:Envelope> 207_NO_SUCH 208my $ans7 = $ua->request($req7); 209 210compare_answer($ans7, <<__EXPECTED, 'message not found'); 211404 212message not recognized 213text/xml 214charset=utf-8 215 216<?xml version="1.0" encoding="UTF-8"?> 217<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"> 218 <SOAP-ENV:Body> 219 <SOAP-ENV:Fault> 220 <faultcode>SOAP-ENV:Server.notRecognized</faultcode> 221 <faultstring>SOAP11 there are no handlers available, so also not for {http://schemas.xmlsoap.org/soap/envelope/}something</faultstring> 222 <faultactor>http://schemas.xmlsoap.org/soap/actor/next</faultactor> 223 </SOAP-ENV:Fault> 224 </SOAP-ENV:Body> 225</SOAP-ENV:Envelope> 226__EXPECTED 227