View | Details | Raw Unified | Return to bug 23290
Collapse All | Expand All

(-)a/Koha/XSLT/Base.pm (-1 / +1 lines)
Lines 1-4 Link Here
1
package Koha::XSLT_Handler;
1
package Koha::XSLT::Base;
2
2
3
# Copyright 2014 Rijksmuseum
3
# Copyright 2014 Rijksmuseum
4
#
4
#
(-)a/Koha/XSLT/Security.pm (+168 lines)
Line 0 Link Here
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;
(-)a/Koha/XSLT_Handler.pm (-1 / +12 lines)
Line 0 Link Here
0
- 
1
package Koha::XSLT_Handler;
2
# This is just a stub; will be removed later on
3
use Modern::Perl;
4
use base qw(Koha::XSLT::Base);
5
use constant XSLTH_ERR_1    => 'XSLTH_ERR_NO_FILE';
6
use constant XSLTH_ERR_2    => 'XSLTH_ERR_FILE_NOT_FOUND';
7
use constant XSLTH_ERR_3    => 'XSLTH_ERR_LOADING';
8
use constant XSLTH_ERR_4    => 'XSLTH_ERR_PARSING_CODE';
9
use constant XSLTH_ERR_5    => 'XSLTH_ERR_PARSING_DATA';
10
use constant XSLTH_ERR_6    => 'XSLTH_ERR_TRANSFORMING';
11
use constant XSLTH_ERR_7    => 'XSLTH_NO_STRING_PASSED';
12
1;

Return to bug 23290