| Subject: | Don't give strings with utf8 flag set to MIME::Base64::encode_base64(). |
In these 2 methods, there is no checking to see if the given string is
utf8 flagged or not:
SOAP::XMLSchema1999::Serializer::as_base64
SOAP::XMLSchema2001::Serializer::as_base64Binary
I had a few cases where a utf8 flagged string containing a euro symbol
was passed causing MIME::Base64::encode_base64 to die (rightfully
because it is meant to encode octets only).
The solution is to add this code just before
MIME::Base64::encode_base64() is called in order to turn the utf8 flag
off:
require Encode;
if (Encode::is_utf8($value)) {
if (Encode->can('_utf8_off')) { # the quick way, but it may change in
future Perl versions.
Encode::_utf8_off($value);
}
else {
$value = pack('C*',unpack('C*',$value)); # the slow but safe way,
but this fallback works always.
}
}
The (dirty) workaround for those of you who can't wait for this to be
fixed is to place this code in your SOAP server just below the 'use'
clauses:
# First of all inject some patches into broken SOAP::Lite modules.
# This is dirty symbol table hack. It works for now, but remove this
when SOAP::Lite has been fixed.
if ($SOAP::Lite::VERSION <= 0.70) {
if (UNIVERSAL::can('SOAP::XMLSchema2001::Serializer',
'as_base64Binary')) {
my $origsub =
\&SOAP::XMLSchema2001::Serializer::as_base64Binary;
*SOAP::XMLSchema2001::Serializer::as_base64Binary = sub
{
my $self = shift;
my($value, $name, $type, $attr) = @_;
# Base64 encoding only makes sense for octal
characters, so to prevent
# MIME::Base64::encode_base64() from rightfully
croaking when given a utf8
# flagged string to encode, remove the utf8
flag of the string so that it
# is treated as a string of bytes (even though
it's not).
require Encode;
if (Encode::is_utf8($value)) {
if (Encode->can('_utf8_off')) { # the
quick way, but it may change in future Perl versions.
Encode::_utf8_off($value);
}
else {
$value =
pack('C*',unpack('C*',$value)); # the slow but safe way, but this
fallback works always.
}
}
return &$origsub($self, $value, $name, $type,
$attr);
}
}
if (UNIVERSAL::can('SOAP::XMLSchema1999::Serializer',
'as_base64')) {
my $origsub =
\&SOAP::XMLSchema1999::Serializer::as_base64;
*SOAP::XMLSchema1999::Serializer::as_base64 = sub {
my $self = shift;
my($value, $name, $type, $attr) = @_;
# Base64 encoding only makes sense for octal
characters, so to prevent
# MIME::Base64::encode_base64() from rightfully
croaking when given a utf8
# flagged string to encode, remove the utf8
flag of the string so that it
# is treated as a string of bytes (even though
it's not).
require Encode;
if (Encode::is_utf8($value)) {
if (Encode->can('_utf8_off')) { # the
quick way, but it may change in future Perl versions.
Encode::_utf8_off($value);
}
else {
$value =
pack('C*',unpack('C*',$value)); # the slow but safe way, but this
fallback works always.
}
}
return &$origsub($self, $value, $name, $type,
$attr);
}
}
}