diff options
Diffstat (limited to 'fml/lib')
| -rw-r--r-- | fml/lib/FML/Article/Summary.pm | 3 | ||||
| -rw-r--r-- | fml/lib/FML/CGI/Anonymous/DB.pm | 15 | ||||
| -rw-r--r-- | fml/lib/FML/CGI/Skin/Anonymous.pm | 10 | ||||
| -rw-r--r-- | fml/lib/FML/Filter/TextPlain.pm | 3 | ||||
| -rw-r--r-- | fml/lib/FML/Process/CGI/Kernel.pm | 4 | ||||
| -rw-r--r-- | fml/lib/Mail/Message.pm | 1 | ||||
| -rw-r--r-- | fml/lib/Mail/Message/Charset.pm | 10 | ||||
| -rw-r--r-- | fml/lib/Mail/Message/Encode.pm | 82 | ||||
| -rw-r--r-- | fml/lib/Mail/Message/ToHTML.pm | 126 |
9 files changed, 145 insertions, 109 deletions
diff --git a/fml/lib/FML/Article/Summary.pm b/fml/lib/FML/Article/Summary.pm index 93cd5700..0e66c916 100644 --- a/fml/lib/FML/Article/Summary.pm +++ b/fml/lib/FML/Article/Summary.pm @@ -129,6 +129,9 @@ sub _prepare_info $subject = $sbj->as_external_form(); } + use Encode qw(from_to); + from_to($subject, 'euc-jp', 'utf-8'); + my $info = { id => $id, address => $address, diff --git a/fml/lib/FML/CGI/Anonymous/DB.pm b/fml/lib/FML/CGI/Anonymous/DB.pm index 598066f1..a1d4d9af 100644 --- a/fml/lib/FML/CGI/Anonymous/DB.pm +++ b/fml/lib/FML/CGI/Anonymous/DB.pm @@ -189,6 +189,10 @@ sub is_correct_magic_string my $db_session_id = $confirm->get($session_id, "session_id"); my $db_magic_string = $confirm->get($session_id, "magic_string"); + print STDERR "INPUT MAGIC STRING : ", (defined($magic_string) ? $magic_string : "UNDEFINED"), "\n"; + print STDERR "DB SESSION ID : ", (defined($db_session_id) ? $db_session_id : "UNDEFINED"), "\n"; + print STDERR "DB MAGIC STRING : ", (defined($db_magic_string) ? $db_magic_string : "UNDEFINED"), "\n"; + # case insensitive $magic_string =~ tr/A-Z/a-z/; $db_magic_string =~ tr/A-Z/a-z/; @@ -220,15 +224,22 @@ sub _db_open my ($curproc) = $self->{ _curproc }; my ($config) = $curproc->config(); my ($pcb) = $curproc->pcb(); + my ($buffer) = << 'EOF'; +Suppose dev-list@dangofactory.net ML. Firstly, send the mail with + +subscribe YOUR-NAME + +to dev-list-ctl@dangofactory.net address. +EOF use FML::Confirm; - my $cache_dir = $config->{ db_dir }; + my $cache_dir = '/var/spool/ml/@tmp@'; my $confirm = new FML::Confirm $curproc, { keyword => "confirm", cache_dir => $cache_dir, class => "cgi", address => "dummy", - buffer => "dummy", + buffer => $buffer, }; return $confirm; } diff --git a/fml/lib/FML/CGI/Skin/Anonymous.pm b/fml/lib/FML/CGI/Skin/Anonymous.pm index 92682c9b..70c57f20 100644 --- a/fml/lib/FML/CGI/Skin/Anonymous.pm +++ b/fml/lib/FML/CGI/Skin/Anonymous.pm @@ -192,11 +192,11 @@ sub _anonymous_is_human_operating my $db = new FML::CGI::Anonymous::DB $curproc; # 1. expired ? - if ($db->is_expired($session_id)) { - $curproc->logerror("expired request"); - $global_error_reason = "expired"; - return 0; - } + #if ($db->is_expired($session_id)) { + # $curproc->logerror("expired request"); + # $global_error_reason = "expired"; + # return 0; + #} # 2. not expired, ok, check if the magic string is correct. if ($db->is_correct_magic_string($session_id, $magic_string)) { diff --git a/fml/lib/FML/Filter/TextPlain.pm b/fml/lib/FML/Filter/TextPlain.pm index ef210690..2aa4224a 100644 --- a/fml/lib/FML/Filter/TextPlain.pm +++ b/fml/lib/FML/Filter/TextPlain.pm @@ -35,8 +35,7 @@ constructor. # default rules for convenience. -my (@default_rules) = qw(reject_not_iso2022jp_japanese_string - reject_null_mail_body +my (@default_rules) = qw(reject_null_mail_body reject_one_line_message reject_old_fml_command_syntax reject_invalid_fml_command_syntax diff --git a/fml/lib/FML/Process/CGI/Kernel.pm b/fml/lib/FML/Process/CGI/Kernel.pm index a4891fe0..4f8f938b 100644 --- a/fml/lib/FML/Process/CGI/Kernel.pm +++ b/fml/lib/FML/Process/CGI/Kernel.pm @@ -103,8 +103,8 @@ sub prepare $curproc->_set_charset(); my $charset = $curproc->langinfo_get_charset("cgi"); # updated charset. - print header(-type => "text/html; charset=$charset", - -charset => $charset, + print header(-type => "text/html; charset=euc-jp", + -charset => "euc-jp", -target => "_top"); # generate and save the session string and identifier. diff --git a/fml/lib/Mail/Message.pm b/fml/lib/Mail/Message.pm index 32aeee8f..5c717974 100644 --- a/fml/lib/Mail/Message.pm +++ b/fml/lib/Mail/Message.pm @@ -2547,6 +2547,7 @@ sub message_text { my ($self, $size) = @_; my $data = $self->{ data }; + my $base_data_type = $self->{ base_data_type }; my ($pos, $pos_begin, $msglen); diff --git a/fml/lib/Mail/Message/Charset.pm b/fml/lib/Mail/Message/Charset.pm index 0f130ad8..a229abfc 100644 --- a/fml/lib/Mail/Message/Charset.pm +++ b/fml/lib/Mail/Message/Charset.pm @@ -176,8 +176,8 @@ my %internal_charset_map = ( my %message_charset_map = ( - 'ja' => 'iso-2022-jp', - 'japanese' => 'iso-2022-jp', + 'ja' => 'euc-jp', + 'japanese' => 'euc-jp', 'en' => 'us-ascii', 'english' => 'us-ascii', @@ -239,6 +239,8 @@ sub language_to_internal_charset { my ($self, $language) = @_; + $language = 'ja'; + return( $internal_charset_map{ lc($language) } || '' ); } @@ -251,6 +253,8 @@ sub language_to_message_charset { my ($self, $language) = @_; + $language = 'ja'; + return( $message_charset_map{ lc($language) } || '' ); } @@ -263,6 +267,8 @@ sub message_charset_to_language { my ($self, $charset) = @_; + $charset = 'iso-2022-jp'; + return( $rev_message_charset_map{ lc($charset) } || '' ); } diff --git a/fml/lib/Mail/Message/Encode.pm b/fml/lib/Mail/Message/Encode.pm index 346ae3b6..7b45aadd 100644 --- a/fml/lib/Mail/Message/Encode.pm +++ b/fml/lib/Mail/Message/Encode.pm @@ -88,23 +88,22 @@ sub detect_code my ($self, $str) = @_; my $lang = $self->{ _language }; - # XXX Japanese includes English. if ($lang eq 'japanese' || $lang eq 'english') { - # getcode() can detect the follogin code: - # jis, sjis, euc, utf8, ucs2, ucs4, utf16, utf16-ge, utf16-le, - # utf32, utf32-ge, utf32-le, ascii, binary, sjis-imode, - # sjis-doti, sjis-jsky. - use Unicode::Japanese; - my $obj = new Unicode::Japanese; - return $obj->getcode($str); + + my $hex = unpack('H*', $str); + + use Unicode::Japanese; + my $obj = new Unicode::Japanese; + my $code = $obj->getcode($str); + + return $code; } else { - carp("Mail::Message::Encode: unknown language"); - return 'unknown'; + carp("Mail::Message::Encode: unknown language"); + return 'unknown'; } } - # Unicode::Japanese # 'jis', 'sjis', 'euc', 'utf8', 'ucs2', 'ucs4', 'utf16', # 'utf16-ge', 'utf16-le', 'utf32', 'utf32-ge', @@ -156,35 +155,33 @@ sub convert_str_ref my $lang = $self->{ _language }; unless (ref($str_ref) eq 'SCALAR') { - croak("convert_str_ref: invalid input data"); + croak("convert_str_ref: invalid input data"); } - # XXX Japanese includes English. if ($lang eq 'japanese' || $lang eq 'english') { - # 1. if the encoding for the given $str_ref is unknown, return ASAP. - unless (defined $in_code) { - $in_code = $self->detect_code($$str_ref); - if ($in_code eq 'unknown') { - return 0; - } - } - else { - # print "1 ok\n"; - } - - # 2. try conversion ! (converted to 'euc' by default). - if ($in_code) { - return $self->_jp_str_ref($str_ref, $out_code, $in_code); - } - } - else { - croak("Mail::Message::Encode: unknown language"); + + unless (defined $in_code) { + $in_code = $self->detect_code($$str_ref); + + if ($in_code eq 'unknown') { + return 0; + } + } + + if ($in_code) { + my $r = $self->_jp_str_ref( + $str_ref, + $out_code, + $in_code + ); + + return $r; + } } return 0; } - # Descriptions: convert japanese string to $out_code. # XXX $in_code must be determined here ! # Arguments: OBJ($self) STR_REF($str_ref) STR($out_code) STR($in_code) @@ -195,25 +192,28 @@ sub _jp_str_ref my ($self, $str_ref, $out_code, $in_code) = @_; if ($out_code =~ /^(jis|sjis|euc)$|^(jis|sjis|euc)[-_]jp$/i) { - my $code = $1 || $2; - $code =~ tr/A-Z/a-z/; - use Jcode; - &Jcode::convert($str_ref, $code, $in_code); + my $code = $1 || $2; + $code =~ tr/A-Z/a-z/; - return 1; + use Jcode; + &Jcode::convert($str_ref, $code, $in_code); + + return 1; } elsif ($out_code =~ /^(iso2022jp|iso-2022-jp)$/i) { - use Jcode; - &Jcode::convert($str_ref, 'jis', $in_code); - return 1; + use Jcode; + &Jcode::convert($str_ref, 'jis', $in_code); + + return 1; } + warn "_jp_str_ref: unsupported out_code=$out_code\n"; + return 0; } - =head2 run_in_code($proc, $s, $args, $out_code, $in_code) run $proc($s) under $out_code environment. diff --git a/fml/lib/Mail/Message/ToHTML.pm b/fml/lib/Mail/Message/ToHTML.pm index 0a682f85..9369ce73 100644 --- a/fml/lib/Mail/Message/ToHTML.pm +++ b/fml/lib/Mail/Message/ToHTML.pm @@ -852,6 +852,10 @@ sub _text_plain_part_safe_print # Arguments: OBJ($self) HASH_REF($args) # Side Effects: none # Return Value: STR +use Encode qw(is_utf8); +use MIME::Base64 qw(decode_base64); +use MIME::QuotedPrint qw(decode_qp); + sub _text_safe_print { my ($self, $args) = @_; @@ -861,25 +865,15 @@ sub _text_safe_print my $encoding = $args->{ encoding } || '7bit'; if ($encoding eq 'base64') { - use Mail::Message::Encode; - my $encode = new Mail::Message::Encode; - $buf = $encode->decode_base64_string($buf); + $buf = decode_base64($buf); } elsif ($encoding eq 'quoted-printable') { - use Mail::Message::Encode; - my $encode = new Mail::Message::Encode; - $buf = $encode->decode_qp_string($buf); - } - - # XXX-TODO: euc-jp is hard-coded. - if (defined $buf && $buf) { - $buf = $self->_convert($buf, 'euc'); + $buf = decode_qp($buf); } - _print_safe_buf($fh, $buf); + _print_safe_buf($fh, $buf, $in_code); } - # Descriptions: print out message without escaping # Arguments: OBJ($self) HASH_REF($args) # Side Effects: create $outf @@ -917,6 +911,10 @@ sub _text_raw_print # Arguments: OBJ($self) HASH_REF($args) # Side Effects: create $outf file # Return Value: none +use FileHandle; +use MIME::Base64 qw(decode_base64); +use MIME::QuotedPrint qw(decode_qp); + sub _binary_print { my ($self, $args) = @_; @@ -928,39 +926,37 @@ sub _binary_print umask(022); if (defined( $args->{ file } )) { - my $outf = $args->{ file }; - use FileHandle; - my $fh = new FileHandle "> $outf"; - - if (defined $fh) { - $fh->autoflush(1); - binmode($fh); - - use Mail::Message::Encode; - my $encode = new Mail::Message::Encode; - if ($enc eq 'base64') { - print $fh $encode->raw_decode_base64( $msg->message_text() ); - } - elsif ($enc eq 'quoted-printable') { - print $fh $encode->raw_decode_qp( $msg->message_text() ); - } - elsif ($enc eq '7bit') { - _print_safe_str($fh, $msg->message_text()); - } - else { - my $r = "*** unknown MIME encoding enc='$enc' ***\n"; - _print_safe_str($fh, $r); - _print_safe_str($fh, $msg->message_text()); - } - - $fh->close(); - } + my $outf = $args->{ file }; + my $fh = FileHandle->new("> $outf"); + + if (defined $fh) { + $fh->autoflush(1); + binmode($fh); + + my $data = $msg->message_text(); + + if ($enc eq 'base64') { + print $fh decode_base64($data); + } + elsif ($enc eq 'quoted-printable') { + print $fh decode_qp($data); + } + elsif ($enc eq '7bit') { + _print_safe_str($fh, $data); + } + else { + my $r = "*** unknown MIME encoding enc='$enc' ***\n"; + _print_safe_str($fh, $r); + _print_safe_str($fh, $data); + } + + $fh->close(); + } } umask($mask); } - =head2 is_ignore($id) we should not process this C<$id> @@ -1960,18 +1956,18 @@ sub _charset_to_code if (defined $charset) { $charset =~ tr/A-Z/a-z/; - if ($charset eq 'euc-jp') { - return 'euc'; + if ($charset eq 'euc') { + return 'euc-jp'; } elsif ($charset eq 'iso-2022-jp') { - return 'jis'; + return 'sjis'; } else { return $charset; # may be wrong, but I hope it works well:-) } } else { - return 'euc'; # euc-jp by default + return 'euc-jp'; # euc-jp by default } } @@ -1987,7 +1983,7 @@ sub _print_raw_str # XXX-TODO: euc-jp is hard-coded. if (defined($str) && $str) { - $str = __nc_convert($str, $code || 'euc'); + $str = __nc_convert($str, $code || 'euc-jp'); } print $wh $str; @@ -2055,7 +2051,7 @@ sub __sprintf_safe_str # XXX-TODO: euc-jp is hard-coded. if (defined($str) && $str) { - $str = __nc_convert($str, $code || 'euc'); + $str = __nc_convert($str, $code || 'euc-jp'); } if (defined $str) { @@ -2271,7 +2267,7 @@ sub _decode_mime_string use Mail::Message::Subject; my $sbj = new Mail::Message::Subject $str; $sbj->mime_header_decode(); - return $sbj->as_external_form(); + return $sbj->as_str(); } else { return ''; @@ -2283,13 +2279,21 @@ sub _decode_mime_string # Arguments: OBJ($self) STR($str) STR($out_code) STR($in_code) # Side Effects: none # Return Value: STR +use Encode qw(decode encode); + sub _convert { my ($self, $str, $out_code, $in_code) = @_; - use Mail::Message::Encode; - my $encode = new Mail::Message::Encode; - return $encode->convert($str, $out_code, $in_code); + return '' unless defined $str && $str ne ''; + + $in_code ||= 'euc-jp'; + $out_code ||= 'euc-jp'; + + my $decoded = eval { + decode($in_code, $str, Encode::FB_DEFAULT); + }; + return $decoded; } # Descriptions: convert $str to $out_code code (non method version) @@ -2300,10 +2304,22 @@ sub _convert sub __nc_convert { my ($str, $out_code, $in_code) = @_; - - use Mail::Message::Encode; - my $encode = new Mail::Message::Encode; - return $encode->convert($str, $out_code, $in_code); + + return '' unless defined $str && $str ne ''; + + $in_code ||= 'euc-jp'; + $out_code ||= 'euc-jp'; + + my $decoded; + + eval { + $decoded = decode($out_code, $str); + 1; + } or do { + # fallback: 元データを返す + $decoded = $str; + }; + return defined $decoded ? $decoded : $str; } |