summaryrefslogtreecommitdiffstats
path: root/Bugzilla/WebService/Server/XMLRPC.pm
blob: 36b4e01fd5c631414c2191bba7dad87d79d3fa11 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
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;