Skip Menu |

This queue is for tickets about the Frontier-RPC CPAN distribution.

Report information
The Basics
Id: 36220
Status: open
Priority: 0/
Queue: Frontier-RPC

People
Owner: Nobody in particular
Requestors: max [...] rfc2324.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



Subject: [patch] Add support for handling of arbitrary perl objects, logging to syslog and client IP filtering for Frontier::*
This patches for Clients.pm and RPC.pm as the rewrite of Daemon.pm add some new features, but should be 100% compatible to older versions. The new Frontier::* stuff is able to push any arbitrary perl object over the wire by using Data::Serializer to put it into an ASCII stream and including this in the XML data. The new Frontier::Daemon has the ability to filter client connections based on a list of given IPs which are able to make connections to the server. The daemon is also able to log requests including query path and method (if desired) to syslog. I would like this changes to be included in the Frontier distribution as I think they are interesting for others, too. Ciao Max
Subject: Client.pm.handle_perl_objects.patch
diff --git a/Client.pm b/Client.pm index 800acab..9ee5755 100644 --- a/Client.pm +++ b/Client.pm @@ -1,8 +1,12 @@ # # Copyright (C) 1998 Ken MacLeod +# Copyright (C) 2007-2008 Maximilian Wilhelm <max@rfc2324.org> +# # Frontier::Client is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. # +# Handling of arbitrary perl objects added by Maximilian Wilhelm. +# # $Id: Client.pm,v 1.8 2001/10/03 01:30:54 kmacleod Exp $ # @@ -47,6 +51,10 @@ sub new { push @options, 'use_objects' => $self->{'use_objects'}; } + if (defined $self->{'handle_perl_objects'} && $self->{'handle_perl_objects'}) { + push @options, 'handle_perl_objects' => $self->{'handle_perl_objects'}; + } + $self->{'enc'} = Frontier::RPC2->new(@options); return $self;
Subject: Daemon.pm
#!/usr/bin/perl -WT # # Frontier::Daemon (next generation) # # Frontier::Daemon is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. # # Copyright (C) 1998 Ken MacLeod # Copyright (C) 2007-2008 Maximilian Wilhelm <max@rfc2324.org> # # This is an extended version of the Frontier::Daemon HTTP XML-RPC server. # # This version of Frontier::Daemon basicly does the same as the normal # Frontier::Daemon but allows specifying a reference to a list of IPs # allowed to open connections to this server and can log request to syslog. # # It is also possible to push arbitrary perl objects over the wire. # # All this stuff was added by Maximilian Wilhelm. # package Frontier::Daemon; use strict; use Carp; use HTTP::Daemon; use HTTP::Status; use HTTP::Headers; use Frontier::RPC2; # # Little bit of magic to simplify debugging sub _options(@) { my %ret = @_; if ($ret{debug}) { foreach my $opt (keys %ret) { print STDERR __PACKAGE__ . "->_options: $opt => $ret{$opt}\n"; } } return \%ret; } sub log_msg ($) { my $self = shift; my $msg = shift; return if (ref ($self) ne __PACKAGE__); return if (! $self->{syslog}->{active}); syslog ($self->{syslog}->{log_level}, $self->{syslog}->{prefix} . $msg); } # # Create new Fronter HTTP RPC server sub new { # new (methods => \%, allowed_clients => \@, <HTTP::Daemon opts>) : \__PACKAGE__ my $self = shift; my $class = ref ($self) || $self; # # Get and check arguments # my $args = &_options (@_); my $syslog = $args->{syslog} || {}; if (defined $syslog) { if (ref ($syslog) ne 'HASH') { $syslog = {}; } # Only load syslog module when needed. (compatibility) use Sys::Syslog qw(:standard :macros);; # Default values if not there. $syslog->{name} = 'Frontier::Daemon' if (! defined $syslog->{name}); $syslog->{prefix} = "XML-RPC HTTP server: " if (! defined $syslog->{prefix}); $syslog->{facility} = "daemon" if (! defined $syslog->{facility}); $syslog->{log_level} = "info" if (! defined $syslog->{log_level}); openlog ($syslog->{name}, "ndelay,pid", $syslog->{facility}); $syslog->{active} = 1; END { closelog(); } } # Reference to methods hash my $methods = $args->{methods}; if (! defined $methods || ref ($methods) ne 'HASH') { confess __PACKAGE__ . "::new(): Missing or invalid 'methods' argument\n"; } # Check for list of allowed clients my $allowed_clients = $args->{allowed_clients}; if (defined $allowed_clients) { if (ref ($allowed_clients) ne 'ARRAY') { confess __PACKAGE__ . "::new(): Invalid 'allowed_clients' argument, must be list_ref\n"; } use Net::CIDR; } # # Prepare stuff # # Fire up XML-RPC decoder my $rpc2_use_objects = $args->{use_objects} || undef; my $rpc2_handle_perl_objects = $args->{handle_perl_objects} || undef; my $decoder = Frontier::RPC2->new (use_objects => $rpc2_use_objects, handle_perl_objects => $rpc2_handle_perl_objects); if (! $decoder) { confess __PACKAGE__ . "::new(): Failed to fire up XML-RPC decoder\n"; } # Prepare HTTP response my $http_header = HTTP::Headers->new ('Content-Type' => 'text/xml'); my $http_response = HTTP::Response->new (200, "", $http_header); if (! $http_header || ! $http_response) { confess __PACKAGE__ . "::new(): Failed to prepare HTTP stuff\n"; } my $http_daemon = HTTP::Daemon->new (%{$args}); if (! $http_daemon) { confess __PACKAGE__ . "::new(): Failed to start up HTTP daemon\n"; } # # Create instance object my $obj = bless { methods => $methods, allowed_clients => $allowed_clients, decoder => $decoder, http_header => $http_header, http_response => $http_response, http_daemon => $http_daemon, syslog => $syslog, }, $class; $obj->log_msg ("started."); if ($args->{no_autolisten}) { return $obj; } else { $obj->listen (); } } # # Start listeing for HTTP requests sub listen() { # listen() : my $self = shift; if (ref ($self) ne __PACKAGE__) { confess __PACKAGE__ . "::listen() has to be called on instanciated object.\n"; } while (my $conn = $self->{http_daemon}->accept ()) { my $request = $conn->get_request (); my $is_allowed = 1; if ($request) { my ($peer_port, $peer) = sockaddr_in ($conn->peername ()); my $peer_ip = inet_ntoa ($peer); # Check if client is allowed to talk to us if we were asked for it if (defined $self->{allowed_clients} && ! Net::CIDR::cidrlookup ($peer_ip, @{$self->{allowed_clients}})) { $is_allowed = 0; } # Get request method and path for logging my $method = $request->method (); my $path = $request->url()->path (); if ($is_allowed) { if (defined $self->{syslog}->{log_request_path}) { $self->log_msg ("Accepted request from $peer_ip for $path ($method)\n"); } else { $self->log_msg ("Accepted request from $peer_ip\n"); } # Check for valid request if ($method eq 'POST' && $path eq '/RPC2') { # Fill response $self->{http_response}->content ($self->{decoder}->serve ($request->content (), $self->{methods})); # Send answer $conn->send_response ($self->{http_response}); # Invalid request } else { $conn->send_error (RC_BAD_REQUEST); } # Client IP not listed in allowed_client list } else { if (defined $self->{syslog}->{log_request_path}) { $self->log_msg ("Denied request from $peer_ip for $path ($method)\n"); } else { $self->log_msg ("Denied request from $peer_ip\n"); } $conn->send_error (RC_FORBIDDEN, "You are not welcome from $peer_ip\n"); } } $conn->close (); # close connection $conn = undef; } } 1; =head1 NAME Frontier::Daemon - receive Frontier XML RPC requests =head1 SYNOPSIS use Frontier::Daemon; Frontier::Daemon->new(methods => { 'rpcName' => \&sub_name, ... # Optional things 'allowed_clients' => [' 127.0.0.1', '192.168.23.42' ], 'handle_perl_objects' => 1, 'syslog' => { name => "Frontier::Daemon", prefix => "[RPC]", facility => "daemon", log_level => "info", log_request_path => 1, }, }); my $daemon = Frontier::Daemon->new (methods => { ... }, no_autolisten => 1, ... }; $daemon->listen (); =head1 DESCRIPTION I<Frontier::Daemon> is an HTTP/1.1 server that listens on a socket for incoming requests containing Frontier XML RPC2 method calls. I<Frontier::Daemon> is a subclass of I<HTTP::Daemon>, which is a subclass of I<IO::Socket::INET>. I<Frontier::Daemon> takes a `C<methods>' parameter, a hash that maps an incoming RPC method name to reference to a subroutine. I<Frontier::Daemon> takes a `C<use_objects>' parameter that if set to a non-zero value will convert incoming E<lt>intE<gt>, E<lt>i4E<gt>, E<lt>floatE<gt>, and E<lt>stringE<gt> values to objects instead of scalars. See int(), float(), and string() in Frontier::RPC2 for more details. I<Frontier::Daemon> takes an `C<allowed_clients>' parameter that if set to a list reference containing IP addresses will make I<Frontier::Daemon> to allow only request from client with a listed address. I<Frontier::Daemon> takes a `C<handle_perl_objects>' parameter that if set will be pushed to I<Frontier::RPC2> to allow pushing arbitrary perl objects over the wire. I<Frontier::Daemon> takes a `C<syslog>' paramter that if set to a non-zero value or hash reference contains extra options enables syslog logging support for I<Frontier::Daemon>. The syslog options - and therefore hash keywords are: name, facility, log_level, prefix and log_request_path. The options name, facility and log_level are obvious syslog options, prefix may contain a string which will be prepended to any log entry written by I<Frontier::Daemon> and log_request_path set to a non-zero value enables logging of the request path. I<Frontier::Daemon> takes a `C<no_autolisten>' parameter for being able to just create a new instance, which does not start listning imediatly. This option was added for compatibility. =head1 SEE ALSO perl(1), HTTP::Daemon(3), IO::Socket::INET(3), Frontier::RPC2(3), Sys::Syslog(3) <http://www.scripting.com/frontier5/xml/code/rpc.html> =head1 AUTHOR Ken MacLeod <ken@bitsko.slc.ut.us> Arbitrary perl object handling and client ip flitering added by Maximilian Wilhelm <max@rfc2324.org> =cut 1;
Subject: RPC2.pm.handle_perl_objects.patch
diff --git a/RPC2.pm b/RPC2.pm index a42ec4d..fdf3257 100644 --- a/RPC2.pm +++ b/RPC2.pm @@ -1,8 +1,11 @@ # # Copyright (C) 1998, 1999 Ken MacLeod +# Copyright (C) 2007-2008 Maximilian Wilhelm <max@rfc2324.org> # Frontier::RPC is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. # +# Handling of arbitrary perl objects added by Maximilian Wilhelm. +# # $Id: RPC2.pm,v 1.18 2002/08/02 18:35:21 ivan420 Exp $ # @@ -45,6 +48,16 @@ sub new { $self->{'encoding_'} = ""; } + # + # This version of Frontier::RPC2 can push arbitrary perl objects across the wire... + # + # If you set 'handle_perl_objects' are parameter this feature is actived. + if ($self->{handle_perl_objects}) { + use Data::Serializer; + $self->{serializer} = Data::Serializer->new(); + $scalars{'perl_object'} = 1; + } + return $self; } @@ -183,7 +196,16 @@ sub _item { push @text, $self->_hash($item); } elsif ($ref =~ /=ARRAY\(/) { push @text, $self->_array($item); - } else { + } + + # If handle_perl_objects parameter was set, encode every object of any class in XML + elsif ($self->{handle_perl_objects} && + $item =~ /=HASH\(/ && + $ref =~ /[[:alnum:]]+/) { + push @text, "<value><perl_object>", $self->{serializer}->serialize ($item), "</perl_object></value>\n"; + } + + else { die "can't convert \`$item' to XML\n"; } @@ -439,6 +461,13 @@ sub end { $value = Frontier::RPC2::String->new($value); } } + + # Deserialize arbitrary perl objects. + elsif ($tag eq 'perl_object') { + my $ser = Data::Serializer->new (); + $value = $ser->deserialize ($value); + } + $expat->{'rpc_value'} = $value; } elsif ($state eq 'member_name') { $expat->{'rpc_member_name'}[-1] = $expat->{'rpc_text'};
From: ivan-pause [...] 420.am
Hi - just FYI - Frontier::RPC hasn't really been well maintained the past few years. You might want consider using (and submitting your changes to) one of the other modules such as RPC::XML, XML::RPC or XMLRPC::Lite (comes with SOAP::Lite). On Tue May 27 14:33:21 2008, max@rfc2324.org wrote: Show quoted text
> This patches for Clients.pm and RPC.pm as the rewrite of Daemon.pm
add Show quoted text
> some new features, but should be 100% compatible to older versions. > > The new Frontier::* stuff is able to push any arbitrary perl object
over Show quoted text
> the wire by using Data::Serializer to put it into an ASCII stream
and Show quoted text
> including this in the XML data. > > The new Frontier::Daemon has the ability to filter client
connections Show quoted text
> based on a list of given IPs which are able to make connections to
the Show quoted text
> server. > > The daemon is also able to log requests including query path and
method Show quoted text
> (if desired) to syslog. > > I would like this changes to be included in the Frontier
distribution as Show quoted text
> I think they are interesting for others, too. > > Ciao > Max