Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

846 lines
26 KiB

  1. # ======================================================================
  2. #
  3. # Copyright (C) 2000-2001 Paul Kulchenko ([email protected])
  4. # SOAP::Lite is free software; you can redistribute it
  5. # and/or modify it under the same terms as Perl itself.
  6. #
  7. # $Id: SOAP::Transport::HTTP.pm,v 0.51 2001/07/18 15:15:14 $
  8. #
  9. # ======================================================================
  10. package SOAP::Transport::HTTP;
  11. use strict;
  12. use vars qw($VERSION);
  13. $VERSION = '0.51';
  14. use SOAP::Lite;
  15. # ======================================================================
  16. package SOAP::Transport::HTTP::Client;
  17. use vars qw(@ISA $COMPRESS);
  18. @ISA = qw(SOAP::Client LWP::UserAgent);
  19. $COMPRESS = 'deflate';
  20. my(%redirect, %mpost, %nocompress);
  21. # hack for HTTP conection that returns Keep-Alive
  22. # miscommunication (?) between LWP::Protocol and LWP::Protocol::http
  23. # dies after timeout, but seems like we could make it work
  24. sub patch {
  25. local $^W;
  26. { sub LWP::UserAgent::redirect_ok; *LWP::UserAgent::redirect_ok = sub {1} }
  27. { package LWP::Protocol;
  28. my $collect = \&collect; # store original
  29. *collect = sub {
  30. if (defined $_[2]->header('Connection') && $_[2]->header('Connection') eq 'Keep-Alive') {
  31. my $data = $_[3]->();
  32. my $next = length($$data) == $_[2]->header('Content-Length') ? sub { \'' } : $_[3];
  33. my $done = 0; $_[3] = sub { $done++ ? &$next : $data };
  34. }
  35. goto &$collect;
  36. };
  37. }
  38. *patch = sub {};
  39. };
  40. sub DESTROY { SOAP::Trace::objects('()') }
  41. sub new { require LWP::UserAgent; patch;
  42. my $self = shift;
  43. unless (ref $self) {
  44. my $class = ref($self) || $self;
  45. my(@params, @methods);
  46. while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
  47. $self = $class->SUPER::new(@params);
  48. $self->agent(join '/', 'SOAP::Lite', 'Perl', SOAP::Transport::HTTP->VERSION);
  49. $self->options({});
  50. while (@methods) { my($method, $params) = splice(@methods,0,2);
  51. $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
  52. }
  53. SOAP::Trace::objects('()');
  54. }
  55. return $self;
  56. }
  57. # no more warnings about "used only once"
  58. $SOAP::Constants::DO_NOT_USE_CHARSET if 0;
  59. sub send_receive {
  60. my($self, %parameters) = @_;
  61. my($envelope, $endpoint, $action, $encoding) =
  62. @parameters{qw(envelope endpoint action encoding)};
  63. $endpoint ||= $self->endpoint;
  64. my $method = 'POST';
  65. my $resp;
  66. $self->options->{is_compress} ||= exists $self->options->{compress_threshold} &&
  67. eval { require Compress::Zlib };
  68. COMPRESS: {
  69. my $compressed = !exists $nocompress{$endpoint} &&
  70. $self->options->{is_compress} &&
  71. ($self->options->{compress_threshold} || 0) < length $envelope;
  72. $envelope = Compress::Zlib::compress($envelope) if $compressed;
  73. while (1) {
  74. # check cache for redirect
  75. $endpoint = $redirect{$endpoint} if exists $redirect{$endpoint};
  76. # check cache for M-POST
  77. $method = 'M-POST' if exists $mpost{$endpoint};
  78. my $req = HTTP::Request->new($method => $endpoint, HTTP::Headers->new, $envelope);
  79. $req->proxy_authorization_basic($ENV{'HTTP_proxy_user'}, $ENV{'HTTP_proxy_pass'})
  80. if ($ENV{'HTTP_proxy_user'} && $ENV{'HTTP_proxy_pass'}); # by Murray Nesbitt
  81. if ($method eq 'M-POST') {
  82. my $prefix = sprintf '%04d', int(rand(1000));
  83. $req->header(Man => qq!"$SOAP::Constants::NS_ENV"; ns=$prefix!);
  84. $req->header("$prefix-SOAPAction" => $action) if defined $action;
  85. } else {
  86. $req->header(SOAPAction => $action) if defined $action;
  87. }
  88. # allow compress if present and let server know we could handle it
  89. $req->header(Accept => ['text/xml', 'multipart/*']);
  90. $req->header('Accept-Encoding' => [$COMPRESS]) if $self->options->{is_compress};
  91. $req->content_encoding($COMPRESS) if $compressed;
  92. $req->content_type(join '; ', 'text/xml',
  93. !$SOAP::Constants::DO_NOT_USE_CHARSET && $encoding ? 'charset=' . lc($encoding) : ());
  94. $req->content_length(length($envelope));
  95. SOAP::Trace::transport($req);
  96. SOAP::Trace::debug($req->as_string);
  97. $self->SUPER::env_proxy if $ENV{'HTTP_proxy'};
  98. $resp = $self->SUPER::request($req);
  99. SOAP::Trace::transport($resp);
  100. SOAP::Trace::debug($resp->as_string);
  101. # 100 OK, continue to read?
  102. if (($resp->code == 510 || $resp->code == 501) && $method ne 'M-POST') {
  103. $mpost{$endpoint} = 1;
  104. } elsif ($resp->code == 415 && $compressed) { # 415 Unsupported Media Type
  105. $nocompress{$endpoint} = 1;
  106. $envelope = Compress::Zlib::uncompress($envelope);
  107. redo COMPRESS; # try again without compression
  108. } else {
  109. last;
  110. }
  111. }
  112. }
  113. $redirect{$endpoint} = $resp->request->url
  114. if $resp->previous && $resp->previous->is_redirect;
  115. $self->code($resp->code);
  116. $self->message($resp->message);
  117. $self->is_success($resp->is_success);
  118. $self->status($resp->status_line);
  119. my $content = ($resp->content_encoding || '') =~ /\b$COMPRESS\b/o && $self->options->{is_compress}
  120. ? Compress::Zlib::uncompress($resp->content)
  121. : ($resp->content_encoding || '') =~ /\S/
  122. ? die "Can't understand returned Content-Encoding (@{[$resp->content_encoding]})\n"
  123. : $resp->content;
  124. $resp->content_type =~ m!^multipart/!
  125. ? join("\n", $resp->headers_as_string, $content) : $content;
  126. }
  127. # ======================================================================
  128. package SOAP::Transport::HTTP::Server;
  129. use vars qw(@ISA $COMPRESS);
  130. @ISA = qw(SOAP::Server);
  131. use URI;
  132. $COMPRESS = 'deflate';
  133. sub DESTROY { SOAP::Trace::objects('()') }
  134. sub new { require LWP::UserAgent;
  135. my $self = shift;
  136. unless (ref $self) {
  137. my $class = ref($self) || $self;
  138. $self = $class->SUPER::new(@_);
  139. $self->on_action(sub {
  140. (my $action = shift) =~ s/^("?)(.*)\1$/$2/;
  141. die "SOAPAction shall match 'uri#method' if present (got '$action', expected '@{[join('#', @_)]}'\n"
  142. if $action && $action ne join('#', @_)
  143. && $action ne join('/', @_)
  144. && (substr($_[0], -1, 1) ne '/' || $action ne join('', @_));
  145. });
  146. SOAP::Trace::objects('()');
  147. }
  148. return $self;
  149. }
  150. sub BEGIN {
  151. no strict 'refs';
  152. for my $method (qw(request response)) {
  153. my $field = '_' . $method;
  154. *$method = sub {
  155. my $self = shift->new;
  156. @_ ? ($self->{$field} = shift, return $self) : return $self->{$field};
  157. }
  158. }
  159. }
  160. sub handle {
  161. my $self = shift->new;
  162. if ($self->request->method eq 'POST') {
  163. $self->action($self->request->header('SOAPAction'));
  164. } elsif ($self->request->method eq 'M-POST') {
  165. return $self->response(HTTP::Response->new(510, # NOT EXTENDED
  166. "Expected Mandatory header with $SOAP::Constants::NS_ENV as unique URI"))
  167. if $self->request->header('Man') !~ /^"$SOAP::Constants::NS_ENV";\s*ns\s*=\s*(\d+)/;
  168. $self->action($self->request->header("$1-SOAPAction"));
  169. } else {
  170. return $self->response(HTTP::Response->new(405)) # METHOD NOT ALLOWED
  171. }
  172. my $compressed = ($self->request->content_encoding || '') =~ /\b$COMPRESS\b/;
  173. $self->options->{is_compress} ||= $compressed && eval { require Compress::Zlib };
  174. # signal error if content-encoding is 'deflate', but we don't want it OR
  175. # something else, so we don't understand it
  176. return $self->response(HTTP::Response->new(415)) # UNSUPPORTED MEDIA TYPE
  177. if $compressed && !$self->options->{is_compress} ||
  178. !$compressed && ($self->request->content_encoding || '') =~ /\S/;
  179. my $content_type = $self->request->content_type || '';
  180. # in some environments (PerlEx?) content_type could be empty, so allow it also
  181. # anyway it'll blow up inside ::Server::handle if something wrong with message
  182. # TBD: but what to do with MIME encoded messages in THOSE environments?
  183. return $self->make_fault($SOAP::Constants::FAULT_CLIENT, "Content-Type must be 'text/xml' instead of '$content_type'")
  184. if $content_type &&
  185. $content_type ne 'text/xml' &&
  186. $content_type !~ m!^multipart/!;
  187. my $content = $compressed ? Compress::Zlib::uncompress($self->request->content) : $self->request->content;
  188. my $response = $self->SUPER::handle(
  189. $self->request->content_type =~ m!^multipart/!
  190. ? join("\n", $self->request->headers_as_string, $content) : $content
  191. ) or return;
  192. $self->make_response($SOAP::Constants::HTTP_ON_SUCCESS_CODE, $response);
  193. }
  194. sub make_fault {
  195. my $self = shift;
  196. $self->make_response($SOAP::Constants::HTTP_ON_FAULT_CODE => $self->SUPER::make_fault(@_));
  197. return;
  198. }
  199. sub make_response {
  200. my $self = shift;
  201. my($code, $response) = @_;
  202. my $encoding = $1 if $response =~ /^<\?xml(?: version="1.0"| encoding="([^"]+)")+\?>/;
  203. $response =~ s!(\?>)!$1<?xml-stylesheet type="text/css"?>! if $self->request->content_type eq 'multipart/form-data';
  204. $self->options->{is_compress} ||=
  205. exists $self->options->{compress_threshold} && eval { require Compress::Zlib };
  206. my $compressed = $self->options->{is_compress} &&
  207. grep(/\b($COMPRESS|\*)\b/, $self->request->header('Accept-Encoding')) &&
  208. ($self->options->{compress_threshold} || 0) < length $response;
  209. $response = Compress::Zlib::compress($response) if $compressed;
  210. $self->response(HTTP::Response->new(
  211. $code => undef,
  212. HTTP::Headers->new(
  213. 'SOAPServer' => $self->product_tokens,
  214. $compressed ? ('Content-Encoding' => $COMPRESS) : (),
  215. 'Content-Type' => join('; ', 'text/xml',
  216. !$SOAP::Constants::DO_NOT_USE_CHARSET && $encoding ? 'charset=' . lc($encoding) : ()),
  217. 'Content-Length' => length $response),
  218. $response,
  219. ));
  220. }
  221. sub product_tokens { join '/', 'SOAP::Lite', 'Perl', SOAP::Transport::HTTP->VERSION }
  222. # ======================================================================
  223. package SOAP::Transport::HTTP::CGI;
  224. use vars qw(@ISA);
  225. @ISA = qw(SOAP::Transport::HTTP::Server);
  226. sub DESTROY { SOAP::Trace::objects('()') }
  227. sub new {
  228. my $self = shift;
  229. unless (ref $self) {
  230. my $class = ref($self) || $self;
  231. $self = $class->SUPER::new(@_);
  232. SOAP::Trace::objects('()');
  233. }
  234. return $self;
  235. }
  236. sub handle {
  237. my $self = shift->new;
  238. my $content; read(STDIN,$content,$ENV{'CONTENT_LENGTH'} || 0);
  239. $self->request(HTTP::Request->new(
  240. $ENV{'REQUEST_METHOD'} || '' => $ENV{'SCRIPT_NAME'},
  241. HTTP::Headers->new(map {(/^HTTP_(.+)/i ? $1 : $_) => $ENV{$_}} keys %ENV),
  242. $content,
  243. ));
  244. $self->SUPER::handle;
  245. # imitate nph- cgi for IIS (pointed by Murray Nesbitt)
  246. my $status = defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/
  247. ? $ENV{SERVER_PROTOCOL} || 'HTTP/1.0' : 'Status:';
  248. my $code = $self->response->code;
  249. binmode(STDOUT); print STDOUT
  250. "$status $code ", HTTP::Status::status_message($code),
  251. "\015\012", $self->response->headers_as_string,
  252. "\015\012", $self->response->content;
  253. }
  254. # ======================================================================
  255. package SOAP::Transport::HTTP::Daemon;
  256. use Carp ();
  257. use vars qw($AUTOLOAD @ISA);
  258. @ISA = qw(SOAP::Transport::HTTP::Server);
  259. sub DESTROY { SOAP::Trace::objects('()') }
  260. sub new { require HTTP::Daemon;
  261. my $self = shift;
  262. unless (ref $self) {
  263. my $class = ref($self) || $self;
  264. my(@params, @methods);
  265. while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
  266. $self = $class->SUPER::new;
  267. $self->{_daemon} = HTTP::Daemon->new(@params) or Carp::croak "Can't create daemon: $!";
  268. $self->myuri(URI->new($self->url)->canonical->as_string);
  269. while (@methods) { my($method, $params) = splice(@methods,0,2);
  270. $self->$method(ref $params eq 'ARRAY' ? @$params : $params)
  271. }
  272. SOAP::Trace::objects('()');
  273. }
  274. return $self;
  275. }
  276. sub AUTOLOAD {
  277. my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
  278. return if $method eq 'DESTROY';
  279. no strict 'refs';
  280. *$AUTOLOAD = sub { shift->{_daemon}->$method(@_) };
  281. goto &$AUTOLOAD;
  282. }
  283. sub handle {
  284. my $self = shift->new;
  285. while (my $c = $self->accept) {
  286. while (my $r = $c->get_request) {
  287. $self->request($r);
  288. $self->SUPER::handle;
  289. $c->send_response($self->response)
  290. }
  291. $c->close;
  292. undef $c;
  293. }
  294. }
  295. # ======================================================================
  296. package SOAP::Transport::HTTP::Apache;
  297. use vars qw(@ISA);
  298. @ISA = qw(SOAP::Transport::HTTP::Server);
  299. sub DESTROY { SOAP::Trace::objects('()') }
  300. sub new { require Apache;
  301. my $self = shift;
  302. unless (ref $self) {
  303. my $class = ref($self) || $self;
  304. $self = $class->SUPER::new(@_);
  305. SOAP::Trace::objects('()');
  306. }
  307. return $self;
  308. }
  309. sub handler {
  310. my $self = shift->new;
  311. my $r = shift || Apache->request;
  312. $self->request(HTTP::Request->new(
  313. $r->method => $r->uri,
  314. HTTP::Headers->new($r->headers_in),
  315. do { my $buf; $r->read($buf, $r->header_in('Content-length')); $buf; }
  316. ));
  317. $self->SUPER::handle;
  318. if ($self->response->is_success) {
  319. $self->response->headers->scan(sub { $r->header_out(@_) });
  320. $r->send_http_header(join '; ', $self->response->content_type);
  321. $r->print($self->response->content);
  322. } else {
  323. $self->response->headers->scan(sub { $r->err_header_out(@_) });
  324. $r->content_type(join '; ', $self->response->content_type);
  325. $r->custom_response($self->response->code, $self->response->content);
  326. }
  327. $self->response->code;
  328. }
  329. sub configure {
  330. my $self = shift->new;
  331. my $config = shift->dir_config;
  332. foreach (%$config) {
  333. $config->{$_} =~ /=>/
  334. ? $self->$_({split /\s*(?:=>|,)\s*/, $config->{$_}})
  335. : ref $self->$_() ? () # hm, nothing can be done here
  336. : $self->$_(split /\s+|\s*,\s*/, $config->{$_})
  337. if $self->can($_);
  338. }
  339. $self;
  340. }
  341. { sub handle; *handle = \&handler } # just create alias
  342. # ======================================================================
  343. #
  344. # Copyright (C) 2001 Single Source oy ([email protected])
  345. # a FastCGI transport class for SOAP::Lite.
  346. #
  347. # $Id: FCGI.pm,v 1.14 2001/07/11 07:08:00 aspa Exp $
  348. #
  349. # ======================================================================
  350. package SOAP::Transport::HTTP::FCGI;
  351. use vars qw(@ISA);
  352. @ISA = qw(SOAP::Transport::HTTP::CGI);
  353. sub DESTROY { SOAP::Trace::objects('()') }
  354. sub new { require FCGI; Exporter::require_version('FCGI' => 0.47); # requires thread-safe interface
  355. my $self = shift;
  356. if (!ref($self)) {
  357. my $class = ref($self) || $self;
  358. $self = $class->SUPER::new(@_);
  359. $self->{_fcgirq} = FCGI::Request(\*STDIN, \*STDOUT, \*STDERR);
  360. SOAP::Trace::objects('()');
  361. }
  362. return $self;
  363. }
  364. sub handle {
  365. my $self = shift->new;
  366. my ($r1, $r2);
  367. my $fcgirq = $self->{_fcgirq};
  368. while (($r1 = $fcgirq->Accept()) >= 0) {
  369. $r2 = $self->SUPER::handle;
  370. }
  371. return undef;
  372. }
  373. # ======================================================================
  374. 1;
  375. __END__
  376. =head1 NAME
  377. SOAP::Transport::HTTP - Server/Client side HTTP support for SOAP::Lite
  378. =head1 SYNOPSIS
  379. =over 4
  380. =item Client
  381. use SOAP::Lite
  382. uri => 'http://my.own.site.com/My/Examples',
  383. proxy => 'http://localhost/',
  384. # proxy => 'http://localhost/cgi-bin/soap.cgi', # local CGI server
  385. # proxy => 'http://localhost/', # local daemon server
  386. # proxy => 'http://localhost/soap', # local mod_perl server
  387. # proxy => 'https://localhost/soap', # local mod_perl SECURE server
  388. # proxy => 'http://login:password@localhost/cgi-bin/soap.cgi', # local CGI server with authentication
  389. ;
  390. print getStateName(1);
  391. =item CGI server
  392. use SOAP::Transport::HTTP;
  393. SOAP::Transport::HTTP::CGI
  394. # specify path to My/Examples.pm here
  395. -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
  396. -> handle
  397. ;
  398. =item Daemon server
  399. use SOAP::Transport::HTTP;
  400. # change LocalPort to 81 if you want to test it with soapmark.pl
  401. my $daemon = SOAP::Transport::HTTP::Daemon
  402. -> new (LocalAddr => 'localhost', LocalPort => 80)
  403. # specify list of objects-by-reference here
  404. -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
  405. # specify path to My/Examples.pm here
  406. -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
  407. ;
  408. print "Contact to SOAP server at ", $daemon->url, "\n";
  409. $daemon->handle;
  410. =item Apache mod_perl server
  411. See F<examples/server/Apache.pm> and L</"EXAMPLES"> section for more information.
  412. =item mod_soap server (.htaccess, directory-based access)
  413. SetHandler perl-script
  414. PerlHandler Apache::SOAP
  415. PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
  416. PerlSetVar options "compress_threshold => 10000"
  417. See L<Apache::SOAP> for more information.
  418. =back
  419. =head1 DESCRIPTION
  420. This class encapsulates all HTTP related logic for a SOAP server,
  421. independent of what web server it's attached to.
  422. If you want to use this class you should follow simple guideline
  423. mentioned above.
  424. Following methods are available:
  425. =over 4
  426. =item on_action()
  427. on_action method lets you specify SOAPAction understanding. It accepts
  428. reference to subroutine that takes three parameters:
  429. SOAPAction, method_uri and method_name.
  430. C<SOAPAction> is taken from HTTP header and method_uri and method_name are
  431. extracted from request's body. Default behavior is match C<SOAPAction> if
  432. present and ignore it otherwise. You can specify you own, for example
  433. die if C<SOAPAction> doesn't match with following code:
  434. $server->on_action(sub {
  435. (my $action = shift) =~ s/^("?)(.+)\1$/$2/;
  436. die "SOAPAction shall match 'uri#method'\n" if $action ne join '#', @_;
  437. });
  438. =item dispatch_to()
  439. dispatch_to lets you specify where you want to dispatch your services
  440. to. More precisely, you can specify C<PATH>, C<MODULE>, C<method> or
  441. combination C<MODULE::method>. Example:
  442. dispatch_to(
  443. 'PATH/', # dynamic: load anything from there, any module, any method
  444. 'MODULE', # static: any method from this module
  445. 'MODULE::method', # static: specified method from this module
  446. 'method', # static: specified method from main::
  447. );
  448. If you specify C<PATH/> name of module/classes will be taken from uri as
  449. path component and converted to Perl module name with substitution
  450. '::' for '/'. Example:
  451. urn:My/Examples => My::Examples
  452. urn://localhost/My/Examples => My::Examples
  453. http://localhost/My/Examples => My::Examples
  454. For consistency first '/' in the path will be ignored.
  455. According to this scheme to deploy new class you should put this
  456. class in one of the specified directories and enjoy its services.
  457. Easy, eh?
  458. =item handle()
  459. handle method will handle your request. You should provide parameters
  460. with request() method, call handle() and get it back with response() .
  461. =item request()
  462. request method gives you access to HTTP::Request object which you
  463. can provide for Server component to handle request.
  464. =item response()
  465. response method gives you access to HTTP::Response object which
  466. you can access to get results from Server component after request was
  467. handled.
  468. =back
  469. =head2 PROXY SETTINGS
  470. You can use any proxy setting you use with LWP::UserAgent modules:
  471. SOAP::Lite->proxy('http://endpoint.server/',
  472. proxy => ['http' => 'http://my.proxy.server']);
  473. or
  474. $soap->transport->proxy('http' => 'http://my.proxy.server');
  475. should specify proxy server for you. And if you use C<HTTP_proxy_user>
  476. and C<HTTP_proxy_pass> for proxy authorization SOAP::Lite should know
  477. how to handle it properly.
  478. =head2 COOKIE-BASED AUTHENTICATION
  479. use HTTP::Cookies;
  480. my $cookies = HTTP::Cookies->new(ignore_discard => 1);
  481. # you may also add 'file' if you want to keep them between sessions
  482. my $soap = SOAP::Lite->proxy('http://localhost/');
  483. $soap->transport->cookie_jar($cookies);
  484. Cookies will be taken from response and provided for request. You may
  485. always add another cookie (or extract what you need after response)
  486. with HTTP::Cookies interface.
  487. You may also do it in one line:
  488. $soap->proxy('http://localhost/',
  489. cookie_jar => HTTP::Cookies->new(ignore_discard => 1));
  490. =head2 COMPRESSION
  491. SOAP::Lite provides you with the option for enabling compression on the
  492. wire (for HTTP transport only). Both server and client should support
  493. this capability, but this should be absolutely transparent to your
  494. application. The Server will respond with an encoded message only if
  495. the client can accept it (indicated by client sending an Accept-Encoding
  496. header with 'deflate' or '*' values) and client has fallback logic,
  497. so if server doesn't understand specified encoding
  498. (Content-Encoding: deflate) and returns proper error code
  499. (415 NOT ACCEPTABLE) client will repeat the same request without encoding
  500. and will store this server in a per-session cache, so all other requests
  501. will go there without encoding.
  502. Having options on client and server side that let you specify threshold
  503. for compression you can safely enable this feature on both client and
  504. server side.
  505. =over 4
  506. =item Client
  507. print SOAP::Lite
  508. -> uri('http://localhost/My/Parameters')
  509. -> proxy('http://localhost/', options => {compress_threshold => 10000})
  510. -> echo(1 x 10000)
  511. -> result
  512. ;
  513. =item Server
  514. my $server = SOAP::Transport::HTTP::CGI
  515. -> dispatch_to('My::Parameters')
  516. -> options({compress_threshold => 10000})
  517. -> handle;
  518. =back
  519. Compression will be enabled on the client side
  520. B<if> the threshold is specified
  521. B<and> the size of current message is bigger than the threshold
  522. B<and> the module Compress::Zlib is available.
  523. The Client will send the header 'Accept-Encoding' with value 'deflate'
  524. B<if> the threshold is specified
  525. B<and> the module Compress::Zlib is available.
  526. Server will accept the compressed message if the module Compress::Zlib
  527. is available, and will respond with the compressed message
  528. B<only if> the threshold is specified
  529. B<and> the size of the current message is bigger than the threshold
  530. B<and> the module Compress::Zlib is available
  531. B<and> the header 'Accept-Encoding' is presented in the request.
  532. =head1 EXAMPLES
  533. Consider following examples of SOAP servers:
  534. =over 4
  535. =item CGI:
  536. use SOAP::Transport::HTTP;
  537. SOAP::Transport::HTTP::CGI
  538. -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
  539. -> handle
  540. ;
  541. =item daemon:
  542. use SOAP::Transport::HTTP;
  543. my $daemon = SOAP::Transport::HTTP::Daemon
  544. -> new (LocalAddr => 'localhost', LocalPort => 80)
  545. -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
  546. ;
  547. print "Contact to SOAP server at ", $daemon->url, "\n";
  548. $daemon->handle;
  549. =item mod_perl:
  550. httpd.conf:
  551. <Location /soap>
  552. SetHandler perl-script
  553. PerlHandler SOAP::Apache
  554. </Location>
  555. Apache.pm:
  556. package SOAP::Apache;
  557. use SOAP::Transport::HTTP;
  558. my $server = SOAP::Transport::HTTP::Apache
  559. -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method');
  560. sub handler { $server->handler(@_) }
  561. 1;
  562. =item Apache::Registry:
  563. httpd.conf:
  564. Alias /mod_perl/ "/Apache/mod_perl/"
  565. <Location /mod_perl>
  566. SetHandler perl-script
  567. PerlHandler Apache::Registry
  568. PerlSendHeader On
  569. Options +ExecCGI
  570. </Location>
  571. soap.mod_cgi (put it in /Apache/mod_perl/ directory mentioned above)
  572. use SOAP::Transport::HTTP;
  573. SOAP::Transport::HTTP::CGI
  574. -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method')
  575. -> handle
  576. ;
  577. =back
  578. WARNING: dynamic deployment with Apache::Registry will fail, because
  579. module will be loaded dynamically only for the first time. After that
  580. it is already in the memory, that will bypass dynamic deployment and
  581. produces error about denied access. Specify both PATH/ and MODULE name
  582. in dispatch_to() and module will be loaded dynamically and then will work
  583. as under static deployment. See examples/server/soap.mod_cgi for example.
  584. =head1 TROUBLESHOOTING
  585. =over 4
  586. =item Dynamic libraries are not found
  587. If you see in webserver's log file something like this:
  588. Can't load '/usr/local/lib/perl5/site_perl/.../XML/Parser/Expat/Expat.so'
  589. for module XML::Parser::Expat: dynamic linker: /usr/local/bin/perl:
  590. libexpat.so.0 is NEEDED, but object does not exist at
  591. /usr/local/lib/perl5/.../DynaLoader.pm line 200.
  592. and you are using Apache web server, try to put into your httpd.conf
  593. <IfModule mod_env.c>
  594. PassEnv LD_LIBRARY_PATH
  595. </IfModule>
  596. =item Apache is crashing with segfaults
  597. If using SOAP::Lite (or XML::Parser::Expat) in combination with mod_perl
  598. causes random segmentation faults in httpd processes try to configure
  599. Apache with:
  600. RULE_EXPAT=no
  601. -- OR (for Apache 1.3.20 and later) --
  602. ./configure --disable-rule=EXPAT
  603. See http://archive.covalent.net/modperl/2000/04/0185.xml for more
  604. details and lot of thanks to Robert Barta (rho@bigpond.net.au) for
  605. explaining this weird behavior.
  606. =item CGI scripts are not running under Microsoft Internet Information Server (IIS)
  607. CGI scripts may not work under IIS unless scripts are .pl, not .cgi.
  608. =back
  609. =head1 DEPENDENCIES
  610. Crypt::SSLeay for HTTPS/SSL
  611. SOAP::Lite, URI for SOAP::Transport::HTTP::Server
  612. LWP::UserAgent, URI for SOAP::Transport::HTTP::Client
  613. HTTP::Daemon for SOAP::Transport::HTTP::Daemon
  614. Apache, Apache::Constants for SOAP::Transport::HTTP::Apache
  615. =head1 SEE ALSO
  616. See ::CGI, ::Daemon and ::Apache for implementation details.
  617. See examples/server/soap.cgi as SOAP::Transport::HTTP::CGI example.
  618. See examples/server/soap.daemon as SOAP::Transport::HTTP::Daemon example.
  619. See examples/My/Apache.pm as SOAP::Transport::HTTP::Apache example.
  620. =head1 COPYRIGHT
  621. Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
  622. This library is free software; you can redistribute it and/or modify
  623. it under the same terms as Perl itself.
  624. =head1 AUTHOR
  625. Paul Kulchenko (paulclinger@yahoo.com)
  626. =cut