use Debbugs::Common qw(globify_scalar english_join);
use Debbugs::Config qw(:config);
use POSIX qw(strftime);
+use Encode qw(decode_utf8);
BEGIN{
($VERSION) = q$Revision: 494 $ =~ /^Revision:\s+([^\s+])/;
my $head = $entity->head;
chomp(my $type = $entity->effective_type);
my $body = $entity->stringify_body;
+ # this attachment has its own content type, so we must not
+ # try to convert it to UTF-8 or do anything funky.
+ my @layers = PerlIO::get_layers($param{output});
+ binmode($param{output},':raw');
print {$param{output}} "Content-Type: $type";
my ($charset) = $head->get('Content-Type:') =~ m/charset\s*=\s*\"?([\w-]+)\"?/i;
print {$param{output}} qq(; charset="$charset") if defined $charset;
- print {$param{output}}"\n";
+ print {$param{output}} "\n";
if ($filename ne '') {
my $qf = $filename;
$qf =~ s/"/\\"/g;
print {$param{output}} "\n";
my $decoder = MIME::Decoder->new($head->mime_encoding);
$decoder->decode(IO::Scalar->new(\$body), $param{output});
+ if (grep {/utf8/} @layers) {
+ binmode($param{output},':utf8');
+ }
return;
}
elsif (not exists $param{att}) {
my $content_type = $entity->head->get('Content-Type:') || "text/html";
my ($charset) = $content_type =~ m/charset\s*=\s*\"?([\w-]+)\"?/i;
my $body = $entity->bodyhandle->as_string;
- $body = convert_to_utf8($body,$charset) if defined $charset;
+ $body = convert_to_utf8($body,$charset//'utf8');
$body = html_escape($body);
# Attempt to deal with format=flowed
if ($content_type =~ m/format\s*=\s*\"?flowed\"?/i) {
sub handle_email_message{
my ($email,%param) = @_;
- my $output = '';
+ # output needs to have the is_utf8 flag on to avoid double
+ # encoding
+ my $output = decode_utf8('');
my $parser = MIME::Parser->new();
# Because we are using memory, not tempfiles, there's no need to
# clean up here like in Debbugs::MIME
sub handle_record{
my ($record,$bug_number,$msg_number,$seen_msg_ids) = @_;
- my $output = '';
+ # output needs to have the is_utf8 flag on to avoid double
+ # encoding
+ my $output = decode_utf8('');
local $_ = $record->{type};
if (/html/) {
my ($time) = $record->{text} =~ /<!--\s+time:(\d+)\s+-->/;
qw(cleanup_eval_fail),
qw(hash_slice),
],
+ utf8 => [qw(encode_utf8_structure)],
date => [qw(secs_to_english)],
quit => [qw(quit)],
lock => [qw(filelock unfilelock lockpid)],
);
@EXPORT_OK = ();
- Exporter::export_ok_tags(qw(lock quit date util misc));
+ Exporter::export_ok_tags(keys %EXPORT_TAGS);
$EXPORT_TAGS{all} = [@EXPORT_OK];
}
use Debbugs::MIME qw(decode_rfc1522);
use Mail::Address;
use Cwd qw(cwd);
+use Encode qw(encode_utf8 is_utf8);
+use Storable qw(dclone);
use Params::Validate qw(validate_with :types);
$type //= 'address';
my $fh = IO::File->new($fn,'r') or
die "Unable to open $fn for reading: $!";
+ binmode($fh,':encoding(UTF-8)');
while (<$fh>) {
chomp;
next unless m/^(\S+)\s+(\S.*\S)\s*$/;
if (defined ref($scalar)) {
if (ref($scalar) eq 'SCALAR' and
not UNIVERSAL::isa($scalar,'GLOB')) {
- return IO::Scalar->new($scalar);
+ open $handle, '>:scalar:utf8', $scalar;
+ return $handle;
}
else {
return $scalar;
carp "Given a non-scalar reference, non-glob to globify_scalar; returning /dev/null handle";
}
}
- return IO::File->new('/dev/null','w');
+ return IO::File->new('/dev/null','>:utf8');
}
=head2 cleanup_eval_fail()
return map {exists $hashref->{$_}?($_,$hashref->{$_}):()} @keys;
}
+
+=head1 UTF-8
+
+These functions are exported with the :utf8 tag
+
+=head2 encode_utf8_structure
+
+ %newdata = encode_utf8_structure(%newdata);
+
+Takes a complex data structure and encodes any strings with is_utf8
+set into their constituent octets.
+
+=cut
+
+our $depth = 0;
+sub encode_utf8_structure {
+ ++$depth;
+ my @ret;
+ for my $_ (@_) {
+ if (ref($_) eq 'HASH') {
+ push @ret, {encode_utf8_structure(%{$depth == 1 ? dclone($_):$_})};
+ }
+ elsif (ref($_) eq 'ARRAY') {
+ push @ret, [encode_utf8_structure(@{$depth == 1 ? dclone($_):$_})];
+ }
+ elsif (ref($_)) {
+ # we don't know how to handle non hash or non arrays
+ push @ret,$_;
+ }
+ else {
+ push @ret,__encode_utf8($_);
+ }
+ }
+ --$depth;
+ return @ret;
+}
+
+sub __encode_utf8 {
+ my @ret;
+ for my $r (@_) {
+ if (not ref($r) and is_utf8($r)) {
+ $r = encode_utf8($r);
+ }
+ push @ret,$r;
+ }
+ return @ret;
+}
+
+
+
1;
__END__
headers =>
[To => $data->{submitter},
Subject => "$config{ubug}#$data->{bug_num} ".
- "closed by $param{requester} ($param{request_subject})",
+ "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""),
],
)
],
die "Unable to open bug log $bug_log for reading: $!";
}
+ binmode($self->{logfh},':utf8');
$self->{state} = 'kill-init';
$self->{linenum} = 0;
return $self;
return $data if $charset eq 'raw' or is_utf8($data,1);
my $result;
eval {
- # this encode/decode madness is to make sure that the data
- # really is valid utf8 and that the is_utf8 flag is off.
- $result = encode("utf8",decode($charset,$data))
+ $result = decode($charset,$data);
};
if ($@) {
warn "Unable to decode charset; '$charset' and '$data': $@";
# handle being passed undef properly
return undef if not defined $rawstr;
+ if (is_utf8($rawstr)) {
+ $rawstr= encode_utf8($rawstr);
+ }
# We process words in reverse so we can preserve spacing between
# encoded words. This regex splits on word|nonword boundaries and
# nonword|nonword boundaries. We also consider parenthesis and "
use warnings;
use strict;
use vars qw($DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
+use Debbugs::SOAP::Server;
use base qw(Exporter SOAP::Server::Parameters);
BEGIN{
}
-
use IO::File;
use Debbugs::Status qw(get_bug_status);
-use Debbugs::Common qw(make_list getbuglocation getbugcomponent);
+use Debbugs::Common qw(make_list getbuglocation getbugcomponent :utf8);
use Debbugs::Packages;
-use Storable qw(nstore retrieve);
+
+use Storable qw(nstore retrieve dclone);
use Scalar::Util qw(looks_like_number);
delete $ut{$tag} unless exists $tags{$tag};
}
}
- return \%ut;
+ return encode_utf8_structure(\%ut);
}
}
}
# __prepare_response($self);
- return \%status;
+ return encode_utf8_structure(\%status);
}
=head2 get_bugs
my %params = __collapse_params(@params);
my @bugs;
@bugs = Debbugs::Bugs::get_bugs(%params);
- return \@bugs;
+ return encode_utf8_structure(\@bugs);
}
=head2 newest_bugs
my $VERSION = __populate_version(pop);
my ($self,$num) = @_;
my $newest_bug = Debbugs::Bugs::newest_bug();
- return [($newest_bug - $num + 1) .. $newest_bug];
+ return encode_utf8_structure([($newest_bug - $num + 1) .. $newest_bug]);
}
msg_num => $current_msg,
};
}
- return \@messages;
+ return encode_utf8_structure(\@messages);
}
=head2 binary_to_source
my ($self,@params) = @_;
if ($VERSION <= 1) {
- return [Debbugs::Packages::binary_to_source(binary => $params[0],
+ return encode_utf8_structure([Debbugs::Packages::binary_to_source(binary => $params[0],
(@params > 1)?(version => $params[1]):(),
(@params > 2)?(arch => $params[2]):(),
- )];
+ )]);
}
else {
- return [Debbugs::Packages::binary_to_source(@params)];
+ return encode_utf8_structure([Debbugs::Packages::binary_to_source(@params)]);
}
}
my $VERSION = __populate_version(pop);
my ($self,@params) = @_;
- return [Debbugs::Packages::sourcetobinary(@params)];
+ return encode_utf8_structure([Debbugs::Packages::sourcetobinary(@params)]);
}
=head2 get_versions
my $VERSION = __populate_version(pop);
my ($self,@params) = @_;
- return scalar Debbugs::Packages::get_versions(@params);
+ return encode_utf8_structure(scalar Debbugs::Packages::get_versions(@params));
}
=head1 VERSION COMPATIBILITY
use base qw(Exporter);
use Params::Validate qw(validate_with :types);
-use Debbugs::Common qw(:util :lock :quit :misc);
+use Debbugs::Common qw(:util :lock :quit :misc :utf8);
use Debbugs::Config qw(:config);
use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
use Debbugs::Packages qw(makesourceversions make_source_versions getversions get_versions binary_to_source);
use Debbugs::Versions::Dpkg;
use POSIX qw(ceil);
use File::Copy qw(copy);
-use Encode qw(decode encode);
+use Encode qw(decode encode is_utf8);
use Storable qw(dclone);
use List::Util qw(min max);
}
return undef;
}
+ binmode($status_fh,':encoding(UTF-8)');
my %data;
my @lines;
my %namemap = reverse %fields;
for my $line (@lines) {
- eval {
- $line = decode("utf8",$line,Encode::FB_CROAK);
- };
if ($line =~ /(\S+?): (.*)/) {
my ($name, $value) = (lc $1, $2);
# this is a bit of a hack; we should never, ever have \r
}
}
for my $field (keys %fields) {
- $data{$field} = '' unless exists $data{$field};
+ $data{$field} = '' unless exists $data{$field};
+ }
+ if ($version < 3) {
+ for my $field (@rfc1522_fields) {
+ $data{$field} = decode_rfc1522($data{$field});
+ }
}
-
$data{severity} = $config{default_severity} if $data{severity} eq '';
for my $field (qw(found_versions fixed_versions found_date fixed_date)) {
$data{$field} = [split ' ', $data{$field}];
@{$data{"${field}_date"}});
}
- if ($version < 3) {
- for my $field (@rfc1522_fields) {
- $data{$field} = decode_rfc1522($data{$field});
- }
- }
my $status_modified = (stat($status))[9];
# Add log last modified time
$data{log_modified} = (stat($log))[9];
sub makestatus {
my ($data,$version) = @_;
- $version = 2 unless defined $version;
+ $version = 3 unless defined $version;
my $contents = '';
}
%newdata = %{join_status_fields(\%newdata)};
+ %newdata = encode_utf8_structure(%newdata);
+
if ($version < 3) {
for my $field (@rfc1522_fields) {
$newdata{$field} = encode_rfc1522($newdata{$field});
}
}
}
- eval {
- $contents = encode("utf8",$contents,Encode::FB_CROAK);
- };
return $contents;
}
my ($ref, $data, $location, $minversion, $disablebughook) = @_;
my $change;
- my %outputs = (1 => 'status', 2 => 'summary');
+ my %outputs = (1 => 'status', 3 => 'summary');
for my $version (keys %outputs) {
next if defined $minversion and $version < $minversion;
my $status = getbugcomponent($ref, $outputs{$version}, $location);
die "can't find location for $ref" unless defined $status;
- open(S,"> $status.new") || die "opening $status.new: $!";
- print(S makestatus($data, $version)) ||
+ my $sfh;
+ if ($version >= 3) {
+ open $sfh,">","$status.new" or
+ die "opening $status.new: $!";
+ }
+ else {
+ open $sfh,">","$status.new" or
+ die "opening $status.new: $!";
+ }
+ print {$sfh} makestatus($data, $version) or
die "writing $status.new: $!";
- close(S) || die "closing $status.new: $!";
+ close($sfh) or die "closing $status.new: $!";
if (-e $status) {
$change = 'change';
} else {
ref(\$param{template}) eq 'GLOB') {
$tt_type = 'FILE_HANDLE';
$tt_source = $param{template};
+ binmode($tt_source,":encoding(UTF-8)");
}
elsif (ref($param{template}) eq 'SCALAR') {
$tt_type = 'STRING';
my $tt;
if ($tt_type eq 'FILE' and
defined $tt_templates{$tt_source} and
+ ($tt_templates{$tt_source}{mtime} + 60) < time and
(stat $tt_source)[9] <= $tt_templates{$tt_source}{mtime}
) {
$tt = $tt_templates{$tt_source}{template};
}
else {
+ my $passed_source = $tt_source;
+ my $passed_type = $tt_type;
if ($tt_type eq 'FILE') {
$tt_templates{$tt_source}{mtime} =
(stat $tt_source)[9];
+ $passed_source = IO::File->new($tt_source,'r');
+ binmode($passed_source,":encoding(UTF-8)");
+ $passed_type = 'FILEHANDLE';
}
- $tt = Text::Template->new(TYPE => $tt_type,
- SOURCE => $tt_source,
+ $tt = Text::Template->new(TYPE => $passed_type,
+ SOURCE => $passed_source,
UNTAINT => 1,
);
if ($tt_type eq 'FILE') {
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
}
+# STDOUT should be using the utf8 io layer
+binmode(STDOUT,':utf8');
+
use POSIX qw(strftime);
use MIME::Parser;
use MIME::Decoder;
}
my @log;
if ( $mbox ) {
+ binmode(STDOUT,":raw");
my $date = strftime "%a %b %d %T %Y", localtime;
if (@records > 1) {
print $q->header(-type => "text/plain",
else {
if (defined $att and defined $msg and @records) {
+ binmode(STDOUT,":raw");
$msg_num++;
print handle_email_message($records[0]->{text},
ref => $ref,
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
}
+# STDOUT should be in utf8 mode
+binmode(STDOUT,':utf8');
+
use POSIX qw(strftime nice);
use Debbugs::Config qw(:globals :text :config);
# 1: test decode
ok(Debbugs::MIME::decode_rfc1522(q(=?iso-8859-1?Q?D=F6n_Armstr=F3ng?= <don@donarmstrong.com>)) eq
- encode_utf8(q(Dön Armstróng <don@donarmstrong.com>)),"decode_rfc1522 decodes and converts to UTF8 properly");
+ q(Dön Armstróng <don@donarmstrong.com>),"decode_rfc1522 decodes and converts to UTF8 properly");
# 2: test encode
--- /dev/null
+# -*- mode: cperl;-*-
+
+use Test::More tests => 2;
+use Encode qw(decode_utf8);
+
+use_ok('Debbugs::Common');
+is_deeply(Debbugs::Common::encode_utf8_structure(
+ {a => decode_utf8('föö'),
+ b => [map {decode_utf8($_)} qw(blëh bl♥h)],
+ }),
+ {a => 'föö',
+ b => [qw(blëh bl♥h)],
+ },
+ );
use UNIVERSAL;
use Debbugs::MIME qw(decode_rfc1522);
+use Encode qw(encode_utf8);
use_ok('Debbugs::Mail');
END
# 1: test decode
-ok(decode_rfc1522(Debbugs::Mail::encode_headers($test_str)) eq $test_str);
+ok(decode_rfc1522(Debbugs::Mail::encode_headers($test_str)) eq encode_utf8($test_str));
# XXX Figure out a good way to test the send message bit of
# Debbugs::Mail
projects / debbugs.git / commitdiff