Koha/Koha/XSLT/Security.pm

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, see <http://www.gnu.org/licenses>.

=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 = {};

    $self->{_options} = {};
    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};

    if( $conf->{expand_entities_unsafe} ) { # NOT recommended
        _set_option($parser, 'expand_entities', 1);
    } else {
        # If not explicitly set, we should disable expanding for security
        _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;