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