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::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 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     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     return if !$conf;
 146
 147     if( exists $conf->{expand_entities} && $conf->{expand_entities} eq '0' ) {
 148         # we only disable expanding, if we find an explicit 0
 149         _set_option($parser, 'expand_entities', 0);
 150     }
 151 }
 152
 153 sub _set_option {
 154     my ($parser, $option_name, $value) = @_;
 155     if( $parser->option_exists($option_name) ) {
 156         $parser->set_option($option_name, $value);
 157     }
 158     #TODO Should we warn if it does not exist?
 159 }
 160
 161 =head1 AUTHOR
 162
 163     David Cook, Prosentient Systems
 164     Marcel de Rooy, Rijksmuseum Netherlands
 165
 166 =cut
 167
 168 1;