File RPC-XML-0.53-ext-daemon-and-header-cb.dif of Package perl-RPC-XML

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__