Bug 23290: Introduce Koha::XSLT::Security

Also adds a temporary stub for Koha::XSLT_Handler referring to Base.
This will be removed later.

Test plan:
Run t/db_dependent/XSLT_Handler.t

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: David Cook <dcook@prosentient.com.au>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Koha/XSLT/Base.pm

@@ -1,4 +1,4 @@
-package Koha::XSLT_Handler;
+package Koha::XSLT::Base;
 
 # Copyright 2014 Rijksmuseum
 #

Koha/XSLT/Security.pm

@@ -0,0 +1,168 @@
+package Koha::XSLT::Security;
+
+# Copyright 2019 Prosentient Systems, Rijksmuseum
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 3 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+=head1 NAME
+
+Koha::XSLT::Security - Add security features to Koha::XSLT::Base
+
+=head1 SYNOPSIS
+
+    use Koha::XSLT::Security;
+    my $secu = Koha::XSLT::Security->new;
+    $secu->register_callbacks;
+    $secu->set_parser_options($parser);
+
+=head1 DESCRIPTION
+
+    This object allows you to apply security options to Koha::XSLT::Base.
+    It looks for parser options in koha-conf.xml.
+
+=cut
+
+use Modern::Perl;
+use Data::Dumper qw/Dumper/;
+use XML::LibXSLT;
+use C4::Context;
+
+use base qw(Class::Accessor);
+
+=head1 METHODS
+
+=head2 new
+
+    Creates object, checks if koha-conf.xml contains additional configuration
+    options, and checks if XML::LibXSLT::Security is present.
+
+=cut
+
+sub new {
+    my ($class) = @_;
+    my $self = {};
+
+    my $conf = C4::Context->config('koha_xslt_security');
+    if( $conf && ref($conf) eq 'HASH' ) {
+        $self->{_options} = $conf;
+    }
+
+    my $security = eval { XML::LibXSLT::Security->new };
+    if( $security ) {
+        $self->{_security_obj} = $security;
+    } else {
+        warn "No XML::LibXSLT::Security object: $@"; #TODO Move to about ?
+    }
+
+    return bless $self, $class;
+}
+
+=head2 register_callbacks
+
+    Register LibXSLT security callbacks
+
+=cut
+
+sub register_callbacks {
+    my $self = shift;
+
+    my $security = $self->{_security_obj};
+    return if !$security;
+
+    $security->register_callback( read_file  => sub {
+        warn "read_file called in XML::LibXSLT";
+        #i.e. when using the exsl:document() element or document() function (to read a XML file)
+        my ($tctxt,$value) = @_;
+        return 0;
+    });
+    $security->register_callback( write_file => sub {
+        warn "write_file called in XML::LibXSLT";
+        #i.e. when using the exsl:document element (or document() function?) (to write an output file of many possible types)
+        #e.g.
+        #<exsl:document href="file:///tmp/breached.txt">
+        #   <xsl:text>breached!</xsl:text>
+        #</exsl:document>
+        my ($tctxt,$value) = @_;
+        return 0;
+    });
+    $security->register_callback( read_net   => sub {
+        warn "read_net called in XML::LibXSLT";
+        #i.e. when using the document() function (to read XML from the network)
+        #e.g. <xsl:copy-of select="document('http://localhost')" />
+        my ($tctxt,$value) = @_;
+        return 0;
+    });
+    $security->register_callback( write_net  => sub {
+        warn "write_net called in XML::LibXSLT";
+        #NOTE: it's unknown how one would invoke this, but covering our bases anyway
+        my ($tctxt,$value) = @_;
+        return 0;
+    });
+}
+
+=head2 set_callbacks
+
+    my $xslt = XML::LibXSLT->new;
+    $security->set_callbacks( $xslt );
+
+    Apply registered callbacks to a specific xslt instance.
+
+=cut
+
+sub set_callbacks {
+    my ($self, $xslt) = @_;
+
+    my $security = $self->{_security_obj};
+    return if !$security;
+    $xslt->security_callbacks( $security );
+}
+
+=head2 set_parser_options
+
+    $security->set_parser_options($parser);
+
+    If koha-conf.xml includes koha_xslt_security options, set them.
+    We start with implementing expand_entities.
+
+=cut
+
+sub set_parser_options {
+    my ($self, $parser) = @_;
+    my $conf = $self->{_options};
+    return if !$conf;
+
+    if( exists $conf->{expand_entities} && $conf->{expand_entities} eq '0' ) {
+        # we only disable expanding, if we find an explicit 0
+        _set_option($parser, 'expand_entities', 0);
+    }
+}
+
+sub _set_option {
+    my ($parser, $option_name, $value) = @_;
+    if( $parser->option_exists($option_name) ) {
+        $parser->set_option($option_name, $value);
+    }
+    #TODO Should we warn if it does not exist?
+}
+
+=head1 AUTHOR
+
+    David Cook, Prosentient Systems
+    Marcel de Rooy, Rijksmuseum Netherlands
+
+=cut
+
+1;

Koha/XSLT_Handler.pm

@@ -0,0 +1,12 @@
+package Koha::XSLT_Handler;
+# This is just a stub; will be removed later on
+use Modern::Perl;
+use base qw(Koha::XSLT::Base);
+use constant XSLTH_ERR_1    => 'XSLTH_ERR_NO_FILE';
+use constant XSLTH_ERR_2    => 'XSLTH_ERR_FILE_NOT_FOUND';
+use constant XSLTH_ERR_3    => 'XSLTH_ERR_LOADING';
+use constant XSLTH_ERR_4    => 'XSLTH_ERR_PARSING_CODE';
+use constant XSLTH_ERR_5    => 'XSLTH_ERR_PARSING_DATA';
+use constant XSLTH_ERR_6    => 'XSLTH_ERR_TRANSFORMING';
+use constant XSLTH_ERR_7    => 'XSLTH_NO_STRING_PASSED';
+1;