1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
package Dancer::Serializer::XML;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: serializer for handling XML data
$Dancer::Serializer::XML::VERSION = '1.3521';
use strict;
use warnings;
use Carp;
use Dancer::ModuleLoader;
use Dancer::Config 'setting';
use base 'Dancer::Serializer::Abstract';
# singleton for the XML::Simple object
my $_xs;
# helpers
sub from_xml {
my $s = Dancer::Serializer::XML->new;
$s->deserialize(@_);
}
sub to_xml {
my $s = Dancer::Serializer::XML->new;
$s->serialize(@_);
}
# class definition
sub loaded_xmlsimple {
Dancer::ModuleLoader->load('XML::Simple');
}
sub loaded_xmlbackends {
# we need either XML::Parser or XML::SAX too
Dancer::ModuleLoader->load('XML::Parser') or
Dancer::ModuleLoader->load('XML::SAX');
}
sub init {
my ($self) = @_;
die 'XML::Simple is needed and is not installed'
unless $self->loaded_xmlsimple;
die 'XML::Simple needs XML::Parser or XML::SAX and neither is installed'
unless $self->loaded_xmlbackends;
# Disable fetching external entities, as that's a security hole: this allows
# someone to fetch remote websites from the server, or to read local files.
# This only works for XML::Parser when called directly from XML::Simple;
# for XML::SAX we'll need to do some even *more* horrible stuff later on.
$_xs = XML::Simple->new(
ParserOpts => [
Handlers => {
ExternEnt => sub {
return '';
}
}
],
);
}
sub serialize {
my $self = shift;
my $entity = shift;
my %options = (RootName => 'data');
my $s = setting('engines') || {};
if (exists($s->{XMLSerializer}) && exists($s->{XMLSerializer}{serialize})) {
%options = (%options, %{$s->{XMLSerializer}{serialize}});
}
%options = (%options, @_);
$_xs->XMLout($entity, %options);
}
sub deserialize {
my $self = shift;
my $xml = shift;
my %options = ();
my $s = setting('engines') || {};
if (exists($s->{XMLSerializer}) && exists($s->{XMLSerializer}{deserialize})) {
%options = (%options, %{$s->{XMLSerializer}{deserialize}});
}
%options = (%options, @_);
# This is the promised terrible hack: claim that the LWP-talking code has
# already been loaded, and make sure that the handler that's called when
# we're dealing with an external entity does nothing.
# For whichever reason, this handler is called despite XML::Parser
# (which on my machine is the only XML::SAX backend that can handle
# external entities) having a ParseParamEnt option which is off by default,
# but appears to only be used deep in the XML::Parser XS guts.
no warnings 'redefine';
local *XML::Parser::lwp_ext_ent_handler = sub { return };
local $INC{'XML/Parser/LWPExternEnt.pl'}
= 'Dancer::Serializer::XML disabled loading this to patch around '
. 'XXE vulnerabilities';
$_xs->XMLin($xml, %options);
use warnings 'redefine';
}
sub content_type {'text/xml'}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Dancer::Serializer::XML - serializer for handling XML data
=head1 VERSION
version 1.3521
=head1 SYNOPSIS
=head1 DESCRIPTION
=head2 METHODS
=head2 serialize
Serialize a data structure to an XML structure.
=head2 deserialize
Deserialize an XML structure to a data structure
=head2 content_type
Return 'text/xml'
=head2 CONFIG FILE
You can set XML::Simple options for serialize and deserialize in the
config file:
engines:
XMLSerializer:
serialize:
AttrIndent: 1
deserialize:
ForceArray: 1
=head1 AUTHOR
Dancer Core Developers
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2010 by Alexis Sukrieh.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
