78 lines
2.7 KiB
Plaintext
78 lines
2.7 KiB
Plaintext
Index: lib/RPC/XML/Server.pm
|
|
===================================================================
|
|
--- lib/RPC/XML/Server.pm.orig
|
|
+++ lib/RPC/XML/Server.pm
|
|
@@ -136,6 +136,11 @@ sub new
|
|
$self->{__host} = $args{host} || '';
|
|
$self->{__port} = $args{port} || '';
|
|
delete @args{qw(host port)};
|
|
+ } elsif( ref($args{http_daemon}) ) {
|
|
+ $self->{__daemon} = $args{http_daemon};
|
|
+ $self->{__http_header_parsing_cb} = $args{http_header_parsing_cb};
|
|
+ delete $args{http_daemon};
|
|
+ delete $args{http_header_parsing_cb};
|
|
}
|
|
else
|
|
{
|
|
@@ -154,9 +159,10 @@ sub new
|
|
$self->{__host} = $URI->host;
|
|
$self->{__port} = $URI->port;
|
|
$self->{__daemon} = $http;
|
|
+ $self->{__http_header_parsing_cb} = $args{http_header_parsing_cb};
|
|
|
|
# Remove those we've processed
|
|
- delete @args{qw(host port queue)};
|
|
+ delete @args{qw(host port queue http_header_parsing_cb)};
|
|
}
|
|
$resp = HTTP::Response->new();
|
|
return "${class}::new: Unable to create HTTP::Response object"
|
|
@@ -533,6 +539,23 @@ If a message is to be spooled to a tempo
|
|
specific directory in which to open those files. If this is not given, then
|
|
the C<tmpdir> method from the B<File::Spec> package is used, instead.
|
|
|
|
+=item daemon
|
|
+
|
|
+you can provide a daemon object here, so RPC::XML::Server will not use
|
|
+it's own HTTP::Daemon but your provided daemon object.
|
|
+This parameter is optional.
|
|
+
|
|
+=item http_header_parsing_cb
|
|
+
|
|
+must be a code reference which will be called before anything else happens
|
|
+to the HTTP data stream. It can be used to parse the HTTP header for HTTP
|
|
+authentication checks and stuff like that.
|
|
+This callback function will get the request object (HTTP::Request)
|
|
+and the connection object (HTTP::Daemon::Clientconn) as parameters.
|
|
+If the callback function does not return a true value, no further processing
|
|
+of the request will be done.
|
|
+This parameter is optional.
|
|
+
|
|
=back
|
|
|
|
Any other keys in the options hash not explicitly used by the constructor are
|
|
@@ -1124,7 +1147,6 @@ Randy J. Ray <rjray@blackperl.com>
|
|
|
|
=cut
|
|
|
|
-__END__
|
|
|
|
###############################################################################
|
|
#
|
|
@@ -1445,6 +1467,11 @@ sub process_request
|
|
$peerhost = $conn->peerhost;
|
|
while ($req = $conn->get_request('headers only'))
|
|
{
|
|
+ if( ref($self->{__http_header_parsing_cb}) eq 'CODE' ) {
|
|
+ # we terminate connection unless header parsing
|
|
+ # returns a true value
|
|
+ next unless( $self->{__http_header_parsing_cb}->( $req, $conn ) );
|
|
+ }
|
|
if ($req->method eq 'HEAD')
|
|
{
|
|
# The HEAD method will be answered with our return headers,
|
|
@@ -2152,3 +2179,4 @@ sub timeout
|
|
}
|
|
return $old_timeout;
|
|
}
|
|
+__END__
|