Koha/XSLT/Security.pm

   1 package Koha::XSLT::Security;
   2
   3 # Copyright 2019 Prosentient Systems, Rijksmuseum
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 =head1 NAME
  21
  22 Koha::XSLT::Security - Add security features to Koha::XSLT::Base
  23
  24 =head1 SYNOPSIS
  25
  26     use Koha::XSLT::Security;
  27     my $secu = Koha::XSLT::Security->new;
  28     $secu->register_callbacks;
  29     $secu->set_parser_options($parser);
  30
  31 =head1 DESCRIPTION
  32
  33     This object allows you to apply security options to Koha::XSLT::Base.
  34     It looks for parser options in koha-conf.xml.
  35
  36 =cut
  37
  38 use Modern::Perl;
  39 use XML::LibXSLT;
  40 use C4::Context;
  41
  42 use base qw(Class::Accessor);
  43
  44 =head1 METHODS
  45
  46 =head2 new
  47
  48     Creates object, checks if koha-conf.xml contains additional configuration
  49     options, and checks if XML::LibXSLT::Security is present.
  50
  51 =cut
  52
  53 sub new {
  54     my ($class) = @_;
  55     my $self = {};
  56
  57     $self->{_options} = {};
  58     my $conf = C4::Context->config('koha_xslt_security');
  59     if( $conf && ref($conf) eq 'HASH' ) {
  60         $self->{_options} = $conf;
  61     }
  62
  63     my $security = eval { XML::LibXSLT::Security->new };
  64     if( $security ) {
  65         $self->{_security_obj} = $security;
  66     } else {
  67         warn "No XML::LibXSLT::Security object: $@"; #TODO Move to about ?
  68     }
  69
  70     return bless $self, $class;
  71 }
  72
  73 =head2 register_callbacks
  74
  75     Register LibXSLT security callbacks
  76
  77 =cut
  78
  79 sub register_callbacks {
  80     my $self = shift;
  81
  82     my $security = $self->{_security_obj};
  83     return if !$security;
  84
  85     $security->register_callback( read_file  => sub {
  86         warn "read_file called in XML::LibXSLT";
  87         #i.e. when using the exsl:document() element or document() function (to read a XML file)
  88         my ($tctxt,$value) = @_;
  89         return 0;
  90     });
  91     $security->register_callback( write_file => sub {
  92         warn "write_file called in XML::LibXSLT";
  93         #i.e. when using the exsl:document element (or document() function?) (to write an output file of many possible types)
  94         #e.g.
  95         #<exsl:document href="file:///tmp/breached.txt">
  96         #   <xsl:text>breached!</xsl:text>
  97         #</exsl:document>
  98         my ($tctxt,$value) = @_;
  99         return 0;
 100     });
 101     $security->register_callback( read_net   => sub {
 102         warn "read_net called in XML::LibXSLT";
 103         #i.e. when using the document() function (to read XML from the network)
 104         #e.g. <xsl:copy-of select="document('http://localhost')" />
 105         my ($tctxt,$value) = @_;
 106         return 0;
 107     });
 108     $security->register_callback( write_net  => sub {
 109         warn "write_net called in XML::LibXSLT";
 110         #NOTE: it's unknown how one would invoke this, but covering our bases anyway
 111         my ($tctxt,$value) = @_;
 112         return 0;
 113     });
 114 }
 115
 116 =head2 set_callbacks
 117
 118     my $xslt = XML::LibXSLT->new;
 119     $security->set_callbacks( $xslt );
 120
 121     Apply registered callbacks to a specific xslt instance.
 122
 123 =cut
 124
 125 sub set_callbacks {
 126     my ($self, $xslt) = @_;
 127
 128     my $security = $self->{_security_obj};
 129     return if !$security;
 130     $xslt->security_callbacks( $security );
 131 }
 132
 133 =head2 set_parser_options
 134
 135     $security->set_parser_options($parser);
 136
 137     If koha-conf.xml includes koha_xslt_security options, set them.
 138     We start with implementing expand_entities.
 139
 140 =cut
 141
 142 sub set_parser_options {
 143     my ($self, $parser) = @_;
 144     my $conf = $self->{_options};
 145
 146     if( $conf->{expand_entities_unsafe} ) { # NOT recommended
 147         _set_option($parser, 'expand_entities', 1);
 148     } else {
 149         # If not explicitly set, we should disable expanding for security
 150         _set_option($parser, 'expand_entities', 0);
 151     }
 152 }
 153
 154 sub _set_option {
 155     my ($parser, $option_name, $value) = @_;
 156     if( $parser->option_exists($option_name) ) {
 157         $parser->set_option($option_name, $value);
 158     }
 159     #TODO Should we warn if it does not exist?
 160 }
 161
 162 =head1 AUTHOR
 163
 164     David Cook, Prosentient Systems
 165     Marcel de Rooy, Rijksmuseum Netherlands
 166
 167 =cut
 168
 169 1;