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