From 5dc75560608d63c6ee8e4c918cace9882f8ddf3b Mon Sep 17 00:00:00 2001
From: "mkanat%bugzilla.org" <>
Date: Mon, 9 Nov 2009 18:27:52 +0000
Subject: Bug 513593: Make the WebService taint incoming parameters Patch by
 Max Kanat-Alexander <mkanat@bugzilla.org> r=dkl, a=mkanat

---
 Bugzilla/Install/Requirements.pm      |  6 ++++++
 Bugzilla/WebService/Server/JSONRPC.pm |  3 +++
 Bugzilla/WebService/Server/XMLRPC.pm  | 29 +++++++++++++++++++++++++++
 Bugzilla/WebService/Util.pm           | 37 +++++++++++++++++++++++++++++++++--
 4 files changed, 73 insertions(+), 2 deletions(-)

diff --git a/Bugzilla/Install/Requirements.pm b/Bugzilla/Install/Requirements.pm
index 2b545ebb8..40ddf9cfe 100644
--- a/Bugzilla/Install/Requirements.pm
+++ b/Bugzilla/Install/Requirements.pm
@@ -232,6 +232,12 @@ sub OPTIONAL_MODULES {
         version => 0,
         feature => ['jsonrpc'],
     },
+    {
+        package => 'Test-Taint',
+        module  => 'Test::Taint',
+        version => 0,
+        feature => ['jsonrpc', 'xmlrpc'],
+    },
     {
         # We need the 'utf8_mode' method of HTML::Parser, for HTML::Scrubber.
         package => 'HTML-Parser',
diff --git a/Bugzilla/WebService/Server/JSONRPC.pm b/Bugzilla/WebService/Server/JSONRPC.pm
index b453c6196..e54387a6d 100644
--- a/Bugzilla/WebService/Server/JSONRPC.pm
+++ b/Bugzilla/WebService/Server/JSONRPC.pm
@@ -26,6 +26,7 @@ use base qw(JSON::RPC::Server::CGI Bugzilla::WebService::Server);
 
 use Bugzilla::Error;
 use Bugzilla::WebService::Constants;
+use Bugzilla::WebService::Util qw(taint_data);
 use Date::Parse;
 use DateTime;
 
@@ -123,6 +124,8 @@ sub _argument_type_check {
         $params = $params->[0];
     }
 
+    taint_data($params);
+
     # Now, convert dateTime fields on input.
     $self->_bz_method_name =~ /^(\S+)\.(\S+)$/;
     my ($class, $method) = ($1, $2);
diff --git a/Bugzilla/WebService/Server/XMLRPC.pm b/Bugzilla/WebService/Server/XMLRPC.pm
index c85614f7a..b2a50712a 100644
--- a/Bugzilla/WebService/Server/XMLRPC.pm
+++ b/Bugzilla/WebService/Server/XMLRPC.pm
@@ -68,6 +68,18 @@ eval { require XMLRPC::Lite; };
 our @ISA = qw(XMLRPC::Deserializer);
 
 use Bugzilla::Error;
+use Scalar::Util qw(tainted);
+
+sub deserialize {
+    my $self = shift;
+    my ($xml) = @_;
+    my $som = $self->SUPER::deserialize(@_);
+    if (tainted($xml)) {
+        $som->{_bz_do_taint} = 1;
+    }
+    bless $som, 'Bugzilla::XMLRPC::SOM';
+    return $som;
+}
 
 # Some method arguments need to be converted in some way, when they are input.
 sub decode_value {
@@ -126,6 +138,23 @@ sub _validation_subs {
 
 1;
 
+package Bugzilla::XMLRPC::SOM;
+use strict;
+eval { require XMLRPC::Lite; };
+our @ISA = qw(XMLRPC::SOM);
+use Bugzilla::WebService::Util qw(taint_data);
+
+sub paramsin {
+    my $self = shift;
+    my $params = $self->SUPER::paramsin(@_);
+    if ($self->{_bz_do_taint}) {
+        taint_data($params);
+    }
+    return $params;
+}
+
+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;
diff --git a/Bugzilla/WebService/Util.pm b/Bugzilla/WebService/Util.pm
index 74c1f2f02..8ff608c3a 100644
--- a/Bugzilla/WebService/Util.pm
+++ b/Bugzilla/WebService/Util.pm
@@ -21,10 +21,17 @@
 
 package Bugzilla::WebService::Util;
 use strict;
-
 use base qw(Exporter);
 
-our @EXPORT_OK = qw(filter validate);
+# We have to "require", not "use" this, because otherwise it tries to
+# use features of Test::More during import().
+require Test::Taint;
+
+our @EXPORT_OK = qw(
+    filter 
+    taint_data
+    validate
+);
 
 sub filter ($$) {
     my ($params, $hash) = @_;
@@ -44,6 +51,32 @@ sub filter ($$) {
     return \%newhash;
 }
 
+sub taint_data {
+    my $params = shift;
+    return if !$params;
+    # Though this is a private function, it hasn't changed since 2004 and
+    # should be safe to use, and prevents us from having to write it ourselves
+    # or require another module to do it.
+    Test::Taint::_deeply_traverse(\&_delete_bad_keys, $params);
+    Test::Taint::taint_deeply($params);
+}
+
+sub _delete_bad_keys {
+    foreach my $item (@_) {
+        next if ref $item ne 'HASH';
+        foreach my $key (keys %$item) {
+            # Making something a hash key always untaints it, in Perl.
+            # However, we need to validate our argument names in some way.
+            # We know that all hash keys passed in to the WebService will 
+            # match \w+, so we delete any key that doesn't match that.
+            if ($key !~ /^\w+$/) {
+                delete $item->{$key};
+            }
+        }
+    }
+    return @_;
+}
+
 sub validate  {
     my ($self, $params, @keys) = @_;
     
-- 
cgit v1.2.3-24-g4f1b