Bug 475151: Refactor the XML-RPC server stuff out of Bugzilla::WebService

Patch By Max Kanat-Alexander <mkanat@bugzilla.org> r=dkl, a=mkanat

5 files changed, 244 insertions, 198 deletions

diff --git a/Bugzilla/WebService.pm b/Bugzilla/WebService.pm
index 3152ef04f..735291fc3 100755
--- a/Bugzilla/WebService.pm
+++ b/Bugzilla/WebService.pm
@@ -15,22 +15,13 @@
 # Contributor(s): Marc Schumann <wurblzap@gmail.com>
 #                 Max Kanat-Alexander <mkanat@bugzilla.org>
 
+# This is the base class for $self in WebService method calls. For the 
+# actual RPC server, see Bugzilla::WebService::Server and its subclasses.
 package Bugzilla::WebService;
-
 use strict;
-use Bugzilla::WebService::Constants;
-use Bugzilla::Util;
 use Date::Parse;
 use XMLRPC::Lite;
 
-sub fail_unimplemented {
-    my $this = shift;
-
-    die SOAP::Fault
-        ->faultcode(ERROR_UNIMPLEMENTED)
-        ->faultstring('Service Unimplemented');
-}
-
 sub datetime_format {
     my ($self, $date_string) = @_;
 
@@ -43,38 +34,11 @@ sub datetime_format {
     return $iso_datetime;
 }
 
-sub handle_login {
-    my ($classes, $action, $uri, $method) = @_;
-
-    my $class = $classes->{$uri};
-    eval "require $class";
-
-    return if $class->login_exempt($method);
-    Bugzilla->login();
-
-    # Even though we check for the need to redirect in
-    # Bugzilla->login() we check here again since Bugzilla->login()
-    # does not know what the current XMLRPC method is. Therefore
-    # ssl_require_redirect in Bugzilla->login() will have returned 
-    # false if system was configured to redirect for authenticated 
-    # sessions and the user was not yet logged in.
-    # So here we pass in the method name to ssl_require_redirect so
-    # it can then check for the extra case where the method equals
-    # User.login, which we would then need to redirect if not
-    # over a secure connection. 
-    my $full_method = $uri . "." . $method;
-    Bugzilla->cgi->require_https(Bugzilla->params->{'sslbase'})
-        if ssl_require_redirect($full_method);
-
-    return;
-}
-
 # For some methods, we shouldn't call Bugzilla->login before we call them
 use constant LOGIN_EXEMPT => { };
 
 sub login_exempt {
     my ($class, $method) = @_;
-
     return $class->LOGIN_EXEMPT->{$method};
 }
 
@@ -88,135 +52,6 @@ sub type {
 
 1;
 
-package Bugzilla::WebService::XMLRPC::Transport::HTTP::CGI;
-use strict;
-eval { require XMLRPC::Transport::HTTP; };
-our @ISA = qw(XMLRPC::Transport::HTTP::CGI);
-
-sub initialize {
-    my $self = shift;
-    my %retval = $self->SUPER::initialize(@_);
-    $retval{'serializer'} = Bugzilla::WebService::XMLRPC::Serializer->new;
-    $retval{'deserializer'} = Bugzilla::WebService::XMLRPC::Deserializer->new;
-    return %retval;
-}
-
-sub make_response {
-    my $self = shift;
-
-    $self->SUPER::make_response(@_);
-
-    # XMLRPC::Transport::HTTP::CGI doesn't know about Bugzilla carrying around
-    # its cookies in Bugzilla::CGI, so we need to copy them over.
-    foreach (@{Bugzilla->cgi->{'Bugzilla_cookie_list'}}) {
-        $self->response->headers->push_header('Set-Cookie', $_);
-    }
-}
-
-1;
-
-# This exists to validate input parameters (which XMLRPC::Lite doesn't do)
-# and also, in some cases, to more-usefully decode them.
-package Bugzilla::WebService::XMLRPC::Deserializer;
-use strict;
-# We can't use "use base" because XMLRPC::Serializer doesn't return
-# a true value.
-eval { require XMLRPC::Lite; };
-our @ISA = qw(XMLRPC::Deserializer);
-
-use Bugzilla::Error;
-
-# Some method arguments need to be converted in some way, when they are input.
-sub decode_value {
-    my $self = shift;
-    my ($type) = @{ $_[0] };
-    my $value = $self->SUPER::decode_value(@_);
-    
-    # We only validate/convert certain types here.
-    return $value if $type !~ /^(?:int|i4|boolean|double|dateTime\.iso8601)$/;
-    
-    # Though the XML-RPC standard doesn't allow an empty <int>,
-    # <double>,or <dateTime.iso8601>,  we do, and we just say
-    # "that's undef".
-    if (grep($type eq $_, qw(int double dateTime))) {
-        return undef if $value eq '';
-    }
-    
-    my $validator = $self->_validation_subs->{$type};
-    if (!$validator->($value)) {
-        ThrowUserError('xmlrpc_invalid_value',
-                       { type => $type, value => $value });
-    }
-    
-    # We convert dateTimes to a DB-friendly date format.
-    if ($type eq 'dateTime.iso8601') {
-        # We leave off the $ from the end of this regex to allow for possible
-        # extensions to the XML-RPC date standard.
-        $value =~ /^(\d{4})(\d{2})(\d{2})T(\d{2}):(\d{2}):(\d{2})/;
-        $value = "$1-$2-$3 $4:$5:$6";
-    }
-
-    return $value;
-}
-
-sub _validation_subs {
-    my $self = shift;
-    return $self->{_validation_subs} if $self->{_validation_subs};
-    # The only place that XMLRPC::Lite stores any sort of validation
-    # regex is in XMLRPC::Serializer. We want to re-use those regexes here.
-    my $lookup = Bugzilla::WebService::XMLRPC::Serializer->new->typelookup;
-    
-    # $lookup is a hash whose values are arrayrefs, and whose keys are the
-    # names of types. The second item of each arrayref is a subroutine
-    # that will do our validation for us.
-    my %validators = map { $_ => $lookup->{$_}->[1] } (keys %$lookup);
-    # Add a boolean validator
-    $validators{'boolean'} = sub {$_[0] =~ /^[01]$/};
-    # Some types have multiple names, or have a different name in
-    # XMLRPC::Serializer than their standard XML-RPC name.
-    $validators{'dateTime.iso8601'} = $validators{'dateTime'};
-    $validators{'i4'} = $validators{'int'};
-    
-    $self->{_validation_subs} = \%validators;
-    return \%validators;
-}
-
-1;
-
-# This package exists to fix a UTF-8 bug in SOAP::Lite.
-# See http://rt.cpan.org/Public/Bug/Display.html?id=32952.
-package Bugzilla::WebService::XMLRPC::Serializer;
-use strict;
-# We can't use "use base" because XMLRPC::Serializer doesn't return
-# a true value.
-eval { require XMLRPC::Lite; };
-our @ISA = qw(XMLRPC::Serializer);
-
-sub new {
-    my $class = shift;
-    my $self = $class->SUPER::new(@_);
-    # This fixes UTF-8.
-    $self->{'_typelookup'}->{'base64'} =
-        [10, sub { !utf8::is_utf8($_[0]) && $_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/},
-        'as_base64'];
-    # This makes arrays work right even though we're a subclass.
-    # (See http://rt.cpan.org//Ticket/Display.html?id=34514)
-    $self->{'_encodingStyle'} = '';
-    return $self;
-}
-
-sub as_string {
-    my $self = shift;
-    my ($value) = @_;
-    # Something weird happens with XML::Parser when we have upper-ASCII 
-    # characters encoded as UTF-8, and this fixes it.
-    utf8::encode($value) if utf8::is_utf8($value) 
-                            && $value =~ /^[\x00-\xff]+$/;
-    return $self->SUPER::as_string($value);
-}
-
-1;
-
 __END__
 
 =head1 NAME
diff --git a/Bugzilla/WebService/Constants.pm b/Bugzilla/WebService/Constants.pm
index 2ccca5ae9..172d757ef 100755
--- a/Bugzilla/WebService/Constants.pm
+++ b/Bugzilla/WebService/Constants.pm
@@ -20,13 +20,13 @@ package Bugzilla::WebService::Constants;
 use strict;
 use base qw(Exporter);
 
-@Bugzilla::WebService::Constants::EXPORT = qw(
+our @EXPORT = qw(
     WS_ERROR_CODE
     ERROR_UNKNOWN_FATAL
     ERROR_UNKNOWN_TRANSIENT
-
     ERROR_AUTH_NODATA
-    ERROR_UNIMPLEMENTED
+
+    WS_DISPATCH
 );
 
 # This maps the error names in global/*-error.html.tmpl to numbers.
@@ -115,7 +115,23 @@ use constant ERROR_UNKNOWN_FATAL     => -32000;
 use constant ERROR_UNKNOWN_TRANSIENT => 32000;
 
 use constant ERROR_AUTH_NODATA   => 410;
-use constant ERROR_UNIMPLEMENTED => 910;
 use constant ERROR_GENERAL       => 999;
 
+sub WS_DISPATCH {
+    # We "require" here instead of "use" above to avoid a dependency loop.
+    require Bugzilla::Hook;
+    my %hook_dispatch;
+    Bugzilla::Hook::process('webservice', { dispatch => \%hook_dispatch });
+
+    my $dispatch = {
+        'Bugzilla' => 'Bugzilla::WebService::Bugzilla',
+        'Bug'      => 'Bugzilla::WebService::Bug',
+        'User'     => 'Bugzilla::WebService::User',
+        'Product'  => 'Bugzilla::WebService::Product',
+        %hook_dispatch
+    };
+    return $dispatch;
+};
+
+
 1;
diff --git a/Bugzilla/WebService/Server.pm b/Bugzilla/WebService/Server.pm
new file mode 100644
index 000000000..dfb9f559a
--- /dev/null
+++ b/Bugzilla/WebService/Server.pm
@@ -0,0 +1,42 @@
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+# The contents of this file are subject to the Mozilla Public
+# License Version 1.1 (the "License"); you may not use this file
+# except in compliance with the License. You may obtain a copy of
+# the License at http://www.mozilla.org/MPL/
+#
+# Software distributed under the License is distributed on an "AS
+# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
+# implied. See the License for the specific language governing
+# rights and limitations under the License.
+#
+# The Original Code is the Bugzilla Bug Tracking System.
+#
+# Contributor(s): Marc Schumann <wurblzap@gmail.com>
+#                 Max Kanat-Alexander <mkanat@bugzilla.org>
+
+package Bugzilla::WebService::Server;
+use strict;
+use Bugzilla::Util qw(ssl_require_redirect);
+
+sub handle_login {
+    my ($self, $class, $method, $full_method) = @_;
+    eval "require $class";
+    return if $class->login_exempt($method);
+    Bugzilla->login();
+
+    # Even though we check for the need to redirect in
+    # Bugzilla->login() we check here again since Bugzilla->login()
+    # does not know what the current XMLRPC method is. Therefore
+    # ssl_require_redirect in Bugzilla->login() will have returned 
+    # false if system was configured to redirect for authenticated 
+    # sessions and the user was not yet logged in.
+    # So here we pass in the method name to ssl_require_redirect so
+    # it can then check for the extra case where the method equals
+    # User.login, which we would then need to redirect if not
+    # over a secure connection. 
+    Bugzilla->cgi->require_https(Bugzilla->params->{'sslbase'})
+        if ssl_require_redirect($full_method);
+}
+
+1;
diff --git a/Bugzilla/WebService/Server/XMLRPC.pm b/Bugzilla/WebService/Server/XMLRPC.pm
new file mode 100644
index 000000000..36b4e01fd
--- /dev/null
+++ b/Bugzilla/WebService/Server/XMLRPC.pm
@@ -0,0 +1,170 @@
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+# The contents of this file are subject to the Mozilla Public
+# License Version 1.1 (the "License"); you may not use this file
+# except in compliance with the License. You may obtain a copy of
+# the License at http://www.mozilla.org/MPL/
+#
+# Software distributed under the License is distributed on an "AS
+# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
+# implied. See the License for the specific language governing
+# rights and limitations under the License.
+#
+# The Original Code is the Bugzilla Bug Tracking System.
+#
+# Contributor(s): Marc Schumann <wurblzap@gmail.com>
+#                 Max Kanat-Alexander <mkanat@bugzilla.org>
+
+package Bugzilla::WebService::Server::XMLRPC;
+
+use strict;
+use XMLRPC::Transport::HTTP;
+use Bugzilla::WebService::Server;
+our @ISA = qw(XMLRPC::Transport::HTTP::CGI Bugzilla::WebService::Server);
+
+use Bugzilla::WebService::Constants;
+
+sub initialize {
+    my $self = shift;
+    my %retval = $self->SUPER::initialize(@_);
+    $retval{'serializer'}   = Bugzilla::XMLRPC::Serializer->new;
+    $retval{'deserializer'} = Bugzilla::XMLRPC::Deserializer->new;
+    $retval{'dispatch_with'} = WS_DISPATCH;
+    return %retval;
+}
+
+sub make_response {
+    my $self = shift;
+
+    $self->SUPER::make_response(@_);
+
+    # XMLRPC::Transport::HTTP::CGI doesn't know about Bugzilla carrying around
+    # its cookies in Bugzilla::CGI, so we need to copy them over.
+    foreach (@{Bugzilla->cgi->{'Bugzilla_cookie_list'}}) {
+        $self->response->headers->push_header('Set-Cookie', $_);
+    }
+}
+
+sub datetime_format {
+    my ($self, $date_string) = @_;
+
+    my $time = str2time($date_string);
+    my ($sec, $min, $hour, $mday, $mon, $year) = localtime $time;
+    # This format string was stolen from SOAP::Utils->format_datetime,
+    # which doesn't work but which has almost the right format string.
+    my $iso_datetime = sprintf('%d%02d%02dT%02d:%02d:%02d',
+        $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
+    return $iso_datetime;
+}
+
+sub handle_login {
+    my ($self, $classes, $action, $uri, $method) = @_;
+    my $class = $classes->{$uri};
+    my $full_method = $uri . "." . $method;
+    $self->SUPER::handle_login($class, $method, $full_method);
+    return;
+}
+
+1;
+
+# This exists to validate input parameters (which XMLRPC::Lite doesn't do)
+# and also, in some cases, to more-usefully decode them.
+package Bugzilla::XMLRPC::Deserializer;
+use strict;
+# We can't use "use base" because XMLRPC::Serializer doesn't return
+# a true value.
+eval { require XMLRPC::Lite; };
+our @ISA = qw(XMLRPC::Deserializer);
+
+use Bugzilla::Error;
+
+# Some method arguments need to be converted in some way, when they are input.
+sub decode_value {
+    my $self = shift;
+    my ($type) = @{ $_[0] };
+    my $value = $self->SUPER::decode_value(@_);
+    
+    # We only validate/convert certain types here.
+    return $value if $type !~ /^(?:int|i4|boolean|double|dateTime\.iso8601)$/;
+    
+    # Though the XML-RPC standard doesn't allow an empty <int>,
+    # <double>,or <dateTime.iso8601>,  we do, and we just say
+    # "that's undef".
+    if (grep($type eq $_, qw(int double dateTime))) {
+        return undef if $value eq '';
+    }
+    
+    my $validator = $self->_validation_subs->{$type};
+    if (!$validator->($value)) {
+        ThrowUserError('xmlrpc_invalid_value',
+                       { type => $type, value => $value });
+    }
+    
+    # We convert dateTimes to a DB-friendly date format.
+    if ($type eq 'dateTime.iso8601') {
+        # We leave off the $ from the end of this regex to allow for possible
+        # extensions to the XML-RPC date standard.
+        $value =~ /^(\d{4})(\d{2})(\d{2})T(\d{2}):(\d{2}):(\d{2})/;
+        $value = "$1-$2-$3 $4:$5:$6";
+    }
+
+    return $value;
+}
+
+sub _validation_subs {
+    my $self = shift;
+    return $self->{_validation_subs} if $self->{_validation_subs};
+    # The only place that XMLRPC::Lite stores any sort of validation
+    # regex is in XMLRPC::Serializer. We want to re-use those regexes here.
+    my $lookup = Bugzilla::XMLRPC::Serializer->new->typelookup;
+    
+    # $lookup is a hash whose values are arrayrefs, and whose keys are the
+    # names of types. The second item of each arrayref is a subroutine
+    # that will do our validation for us.
+    my %validators = map { $_ => $lookup->{$_}->[1] } (keys %$lookup);
+    # Add a boolean validator
+    $validators{'boolean'} = sub {$_[0] =~ /^[01]$/};
+    # Some types have multiple names, or have a different name in
+    # XMLRPC::Serializer than their standard XML-RPC name.
+    $validators{'dateTime.iso8601'} = $validators{'dateTime'};
+    $validators{'i4'} = $validators{'int'};
+    
+    $self->{_validation_subs} = \%validators;
+    return \%validators;
+}
+
+1;
+
+# This package exists to fix a UTF-8 bug in SOAP::Lite.
+# See http://rt.cpan.org/Public/Bug/Display.html?id=32952.
+package Bugzilla::XMLRPC::Serializer;
+use strict;
+# We can't use "use base" because XMLRPC::Serializer doesn't return
+# a true value.
+eval { require XMLRPC::Lite; };
+our @ISA = qw(XMLRPC::Serializer);
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new(@_);
+    # This fixes UTF-8.
+    $self->{'_typelookup'}->{'base64'} =
+        [10, sub { !utf8::is_utf8($_[0]) && $_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/},
+        'as_base64'];
+    # This makes arrays work right even though we're a subclass.
+    # (See http://rt.cpan.org//Ticket/Display.html?id=34514)
+    $self->{'_encodingStyle'} = '';
+    return $self;
+}
+
+sub as_string {
+    my $self = shift;
+    my ($value) = @_;
+    # Something weird happens with XML::Parser when we have upper-ASCII 
+    # characters encoded as UTF-8, and this fixes it.
+    utf8::encode($value) if utf8::is_utf8($value) 
+                            && $value =~ /^[\x00-\xff]+$/;
+    return $self->SUPER::as_string($value);
+}
+
+1;
diff --git a/xmlrpc.cgi b/xmlrpc.cgi
index d5042eb8b..10c245ef6 100755
--- a/xmlrpc.cgi
+++ b/xmlrpc.cgi
@@ -21,16 +21,16 @@ use lib qw(. lib);
 use Bugzilla;
 use Bugzilla::Constants;
 use Bugzilla::Error;
-use Bugzilla::Hook;
 use Bugzilla::WebService::Constants;
 
 # Use an eval here so that runtests.pl accepts this script even if SOAP-Lite
 # is not installed.
-eval 'use XMLRPC::Transport::HTTP;
-      use Bugzilla::WebService;';
+eval { require Bugzilla::WebService::Server::XMLRPC; };
 $@ && ThrowCodeError('soap_not_installed');
 
-Bugzilla->usage_mode(Bugzilla::Constants::USAGE_MODE_WEBSERVICE);
+Bugzilla->usage_mode(USAGE_MODE_WEBSERVICE);
+
+# Fix the error code that SOAP::Lite uses for Perl errors.
 local $SOAP::Constants::FAULT_SERVER;
 $SOAP::Constants::FAULT_SERVER = ERROR_UNKNOWN_FATAL;
 # The line above is used, this one is ignored, but SOAP::Lite
@@ -38,27 +38,10 @@ $SOAP::Constants::FAULT_SERVER = ERROR_UNKNOWN_FATAL;
 local $XMLRPC::Constants::FAULT_SERVER;
 $XMLRPC::Constants::FAULT_SERVER = ERROR_UNKNOWN_FATAL;
 
-my %hook_dispatch;
-Bugzilla::Hook::process('webservice', { dispatch => \%hook_dispatch });
 local @INC = (bz_locations()->{extensionsdir}, @INC);
-
-my $dispatch = {
-    'Bugzilla' => 'Bugzilla::WebService::Bugzilla',
-    'Bug'      => 'Bugzilla::WebService::Bug',
-    'User'     => 'Bugzilla::WebService::User',
-    'Product'  => 'Bugzilla::WebService::Product',
-    %hook_dispatch
-};
-
-# The on_action sub needs to be wrapped so that we can work out which
-# class to use; when the XMLRPC module calls it theres no indication
-# of which dispatch class will be handling it.
-# Note that using this to get code thats called before the actual routine
-# is a bit of a hack; its meant to be for modifying the SOAPAction
-# headers, which XMLRPC doesn't use; it relies on the XMLRPC modules
-# using SOAP::Lite internally....
-
-my $response = Bugzilla::WebService::XMLRPC::Transport::HTTP::CGI
-    ->dispatch_with($dispatch)
-    ->on_action(sub { Bugzilla::WebService::handle_login($dispatch, @_) } )
-    ->handle;
+my $server = new Bugzilla::WebService::Server::XMLRPC;
+# We use a sub for on_action because that gets us the info about what 
+# class is being called. Note that this is a hack--this is technically 
+# for setting SOAPAction, which isn't used by XML-RPC.
+$server->on_action(sub { $server->handle_login(WS_DISPATCH, @_) })
+       ->handle();