# vim: set cindent expandtab ts=4 sw=4: # # Copyright (c) 1998-2005 Chi-Keung Ho. All rights reserved. # # This programe is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # Extmail - a high-performance webmail to maildir # $Id$ package Ext::App::Message; use strict; use Exporter; use vars qw(@ISA @EXPORT $MSGFILE $FOLDER $POS $t0 $t1); @ISA = qw(Exporter Ext::App); use vars qw($CRLF); # XXX todo $CRLF = "\012"; # \r \015, \n \012 use Ext::App; use Ext::MIME; use Ext::Storage::Maildir; use Ext::Utils; use MIME::Base64; use MIME::QuotedPrint; use vars qw(%lang_readmsg $lang_charset); use Ext::Lang; use Ext::Unicode; undef $MSGFILE; undef $FOLDER; undef $POS; sub init { my $self = shift; $self->SUPER::init(@_); return unless($self->valid||$self->permit); $self->add_methods(readmsg_sum => \&readmsg_sum); $self->add_methods(readmsg_rawdt => \&readmsg_rawdt); $self->add_methods(readmsg_header => \&readmsg_header); $self->add_methods(delete => \&delete); $self->add_methods(download => \&download); $self->{default_mode} = 'readmsg_sum'; Ext::Storage::Maildir::init($self->get_working_path); Ext::MIME::init(path => $self->get_working_path, debug=>0); $FOLDER = $self->{query}->cgi('folder'); $POS = $self->{query}->cgi('pos'); $MSGFILE = $ENV{MAILDIR}; # XXX $MSGFILE .= '/'._name2mdir($FOLDER); $self->_initme; if(valid_maildir($FOLDER)) { if(my $file = pos2file($FOLDER, $POS)) { $MSGFILE .= '/cur/'.pos2file($FOLDER, $POS); }else { $self->{tpl}->assign( # must assign sid, App::global_tpl() has not been # called at this stage #SID => $self->{query}->cgi('sid'), REDIRECT => 1, FOLDER => str2url($FOLDER) ); $self->error($lang_readmsg{'message_err'}); } }else { $self->error($lang_readmsg{'folder_err'}); } $self; } sub _initme { initlang($_[0]->userconfig->{lang}, __PACKAGE__); $_[0]->{tpl}->assign( lang_charset => $lang_charset ); $_[0]->{tpl}->assign( \%lang_readmsg ); } sub delete { my $self = shift; my $tpl = $self->{tpl}; my $q = $self->{query}; # use global $POS if(defined $POS) { my $sort_order = get_sortorder($FOLDER); set_bmsgs_delete($FOLDER, $POS); set_msgs_cache($FOLDER, $sort_order); # flush the $MSGFILE to the current pos file $MSGFILE = $ENV{MAILDIR}; # XXX $MSGFILE .= '/'._name2mdir($FOLDER); my $file = ""; while(!($file = pos2file($FOLDER, $POS))) { if($POS>0) { $POS-- } else { last } } if($file) { # still has file $MSGFILE .= '/cur/'.pos2file($FOLDER, $POS); }else { # redirect to the folder message list mode, no more # message can show, abort $tpl->assign( REDIRECT => 1, FOLDER => str2url($FOLDER) ); $self->error($lang_readmsg{'message_err'}); return; } $self->readmsg_sum; }else { $self->error($lang_readmsg{'delete_err'}); } } sub download { my $self = shift; my $tpl = $self->{tpl}; my $q = $self->{query}; my $mimeid = $q->cgi("mimeid"); if($mimeid eq '') { $mimeid = 1; } $tpl->{noprint} = 1; # disable output buffer; get_parts($MSGFILE, $mimeid, 'to_std'); } sub readmsg_rawdt { my $self = shift; my $tpl = $self->{tpl}; my $q = $self->{query}; # disable template output bufffer $tpl->{noprint} = 1; print "Content-type: text/plain\r\n"; print "Content-Disposition: filename=\"rawdata.txt\"\r\n\r\n"; open(FD, "<$MSGFILE") or die "can't open $MSGFILE\n"; while() { print; } close FD; } sub readmsg_header { my $self = shift; my $tpl = $self->{tpl}; my $q = $self->{query}; my ($dir, $pos) = ($q->cgi('folder'), $q->cgi('pos')); $tpl->{noprint} = 1; my $file = pos2file($dir, $pos); open(FD, "< "._name2mdir($dir)."/cur/$file") or die "Can't open $file, $!\n"; local $/=$CRLF.$CRLF; my $h = ; close FD; print "Content-Type: text/plain\r\n"; print "Content-Disposition: filename=\"header.txt\"\r\n\r\n"; print $h; } sub readmsg_sum { my $self = shift; my $tpl = $self->{tpl}; my $q = $self->{query}; my $sid = $self->{sid}; my $usercfg = $self->userconfig(); my $utf8 = Ext::Unicode->new; $tpl->assign(READMSG_SUM=>1); my $parts = get_msg_info($MSGFILE); my $hdr = $parts->{head}{hash}; my $charset = $q->cgi('charset') || hdr_get_hash('charset', %$hdr); $utf8->set_charset($charset); if($q->cgi("detail")) { $tpl->assign(DETAIL=>1); $tpl->assign(PARTS => mydumper($parts)); } my ($from, $to, $subject, $date) = ( decode_words_utf8(hdr_get_hash('From', %$hdr)), decode_words_utf8(hdr_get_hash('To', %$hdr)), decode_words_utf8(hdr_get_hash('Subject', %$hdr)), hdr_get_hash('Date', %$hdr) ); # XXX FIXME experimental code my @cp_maps = qw(gb2312 gbk gb18030 big5 utf-8 iso-2022-jp shift-jis euc-jp euc-kr iso-2022-kr); my $matched = (grep(/^$charset$/i, @cp_maps) ? 1 : 0); $tpl->assign('SEL_CHARSET_LOOP', SRC_CHARSET => 'auto', CHECKED => !$matched); for (@cp_maps) { $tpl->assign( 'SEL_CHARSET_LOOP', SRC_CHARSET => $_, CHECKED => lc $charset eq lc $_ ? 1 : 0, ); } # XXX FIXME - experimental detect code - urgly ! my $sjchar; TRY: { if ($charset) { $sjchar = $charset; # force to CGI charset parameter last TRY; } my $subject = decode_words(hdr_get_hash('Subject', %$hdr)); $subject =~ s/\s+//; # remove space my $c = charset_detect($subject); if ($c =~ /^(windows-1252|iso-8859-)/ && length $subject < 6) { $sjchar = charset_detect(decode_words(hdr_get_hash('From', %$hdr))); } else { $sjchar = $c; } } $from = iconv($from, $sjchar, 'utf-8') if charset_detect($from) ne 'utf-8'; $to = iconv($to, $sjchar, 'utf-8') if charset_detect($to) ne 'utf-8'; $subject = iconv($subject, $sjchar, 'utf-8') if charset_detect($subject) ne 'utf-8'; # XXX FIXME set charset to subject charset if it's unavailable $charset = $sjchar unless $charset; $tpl->assign( SID => $sid, FOLDER => str2url($FOLDER), # XXX should str2url POS => $POS, SUBJECT => html_escape($subject), FROM => html_escape($from), TO => html_escape($to), DATE => $date ); if (my $cc = decode_words_utf8(hdr_get_hash('Cc', %$hdr))) { $tpl->assign( CC => html_escape($cc)); } if (my $bcc = decode_words_utf8(hdr_get_hash('Bcc', %$hdr))) { $tpl->assign( BCC => html_escape($bcc)); } my ($ref, $nomore) = get_msgs_cache($FOLDER,1,$POS); $tpl->assign( HAVE_NEXT => $nomore?0:1, NEXT => $nomore?$POS:$POS+1, HAVE_PREV => $POS eq 0?0:1, PREV => $POS eq 0?0:$POS-1 ); if($usercfg->{'page_size'}>=$POS) { $tpl->assign(PAGE=>0); }else { # the system int() will work for us :-) my $rv = int ($POS / $usercfg->{'page_size'}); $tpl->assign(PAGE=>$rv); } # hash to indicate which part should be ignore, in general # they are email text/body or html my %ignore = (); if(scalar @{$parts->{body}{list}} >1) { # Here is the most complex part that handle email text/body # displaying, Hmm it should be redesign one day, ouch :-( my ($cnt, %th) = (0, ()); # text + html = th my $last_idflag; foreach my $p ( @{get_parts_name($parts)} ) { $last_idflag = $p->{idflag} unless($last_idflag); # init hdr_get_hash('Content-Type', %{$p->{phead}}) =~ m#(text/.*)#i; my $subtype = $1 || 'message/unknow'; # Infact we should check every part's charset, but for simplify # reason, use the first part(text or html)'s charset my $char = ${get_parts_name($parts)}[0]->{phead}{charset} || $charset; if( $cnt < 2 && $subtype =~ /text/i && $last_idflag =~ /alternative/i && $p->{idflag} eq $last_idflag) { # XXX experimental multi-charset handling, wait for fix my $print = {id=>0, type=>'text'}; # default; $th{text} = $cnt if($subtype=~/plain/i); $th{html} = $cnt if($subtype=~/html/i); if(exists $th{text} && exists $th{html}) { if($usercfg->{show_html}) { $print->{id} = $th{html}; $print->{type} = 'html'; }else { $print->{id} = $th{text}; $print->{type} = 'text'; } }elsif(exists $th{text}) { $print->{id} = $th{text}; $print->{type} = 'text'; }elsif(exists $th{html}) { $print->{id} = $th{html}; $print->{type} = 'html'; }else { # not match anything, goto attchment handling goto HANDLE; } # XXX FIXME performance degrade here, get_parts will # call get_msg_info again, damn it, wait for fix!! my $body = get_parts($MSGFILE, $print->{id}, 'to_string'); if($print->{type} eq 'text') { # dirty hack on iso-2022-jp, Thanks ken lau # if we encouter iso-2022-jp, html_escape() will fail to convert # and return null to caller, so we had to use
 to
                    # display body, to be fix :-(
                    if($char=~ /iso-2022-jp/) {
                        $body = '
'.$body.'
'; }else { # XXX FIXME convert to web link if ($usercfg->{conv_link} && $subtype =~ /plain/i) { $body = txt2html($body, html_escape=>1, txt2link=>1); } else { $body = html_escape($body); } } }elsif ($print->{type} eq 'html') { $body = htmlsanity($body); } $utf8->set_charset($char) if ($char); # XXX FIXME $tpl->assign(BODY => str2ncr($char, $body)); $tpl->assign(BODY => $utf8->utf8_encode($body)); $ignore{$cnt} = 1; $cnt++; next; }elsif($cnt < 1 && $subtype=~/text/i) { # only one text/plain or text/html part, no # alternative, compatible with some sucks MUA my $print = { id => 0, type => 'text'}; if($subtype=~/html/i) { $print->{type} = 'html'; } my $body = get_parts($MSGFILE, $print->{id}, 'to_string'); if($print->{type} eq 'text') { if($char=~ /iso-2022-jp/) { $body = '
'.$body.'
'; }else { # XXX FIXME convert to web link if ($usercfg->{conv_link} && $subtype =~ /plain/i) { $body = txt2html($body, html_escape=>1, txt2link=>1); } else { $body = html_escape($body); } } } elsif ($print->{type} eq 'html') { $body = htmlsanity($body); } $utf8->set_charset($char) if ($char); # XXX FIXME =$tpl->assign(BODY => str2ncr($charset, $body)); $tpl->assign(BODY => $utf8->utf8_encode($body)); $ignore{$cnt} = 1; $cnt++; next; } HANDLE: { my $part_char = hdr_get_hash('charset', %{$p->{phead}}) || $char; my $filename = decode_words_utf8($p->{name}); if (charset_detect($filename) ne 'utf-8') { $utf8->set_charset($part_char); $filename = $utf8->utf8_encode($filename); } $tpl->assign(ATTACHMENT => 1); $tpl->assign( 'LOOP_ATTACH', CNT => $cnt, # NAME => str2ncr($charset, $p->{name}), NAME => $filename, HSIZE => human_size($p->{size}) ); $cnt ++; } # END of HANDLE $last_idflag = $p->{idflag}; # XXX } } else { my $type = hdr_get_hash('Content-Type', %$hdr) || 'text/plain';# top type my $phdr = $parts->{body}{list}->[0]->{phead}; my $subtype = hdr_get_hash('Content-Type', %$phdr) || 'plain'; my $charset = hdr_get_hash('charset', %$hdr) || $sjchar; # get the charset my $print = {id => 0, type => 'text'}; # if toptype or subtype match html, display it. this mechanism # make sense to some bad RFC compatible email, most of them are # spam :-) But we can disply it if user want to review. if (hdr_get_hash('filename', %$phdr) || hdr_get_hash('name', %$phdr)) { my $char = ${get_parts_name($parts)}[0]->{phead}{charset} || $charset; my $p = ${get_parts_name($parts)}[0]; $utf8->set_charset($char) if ($char); $tpl->assign(ATTACHMENT => 1); $tpl->assign( 'LOOP_ATTACH', CNT => 0, NAME => $utf8->utf8_encode(decode_words($p->{name})), HSIZE => human_size($p->{size}) ); set_msg_seen($FOLDER, $POS); return; } my $body = get_parts($MSGFILE, 0, 'to_string'); if (hdr_get_hash('charset', %$phdr)) { $charset = hdr_get_hash('charset', %$phdr); } $utf8->set_charset($charset) if $charset; if (($type=~/html/ or $subtype=~/html/) && $usercfg->{show_html}) { $print->{type} = 'html'; $body = htmlsanity($body); } else { if($charset=~ /iso-2022-jp/) { $body = '
'.$body.'
'; }else { # $body = html_escape($body); # XXX FIXME convert to web link if ($usercfg->{conv_link} && $subtype =~ /plain/i) { $body = txt2html($body, txt2link=>1, html_escape=>1); } else { $body = html_escape($body) if ($subtype =~ /plain/i); } } } # XXX FIXME $tpl->assign(BODY => str2ncr($charset, $body)); $tpl->assign(BODY => $utf8->utf8_encode($body)); } # update file status set_msg_seen($FOLDER, $POS); # XXX wait for fix } sub pre_run { 1 } sub post_run { my $template = $_[0]->{query}->cgi('screen') || 'readmsg.html'; # dirty hack, to fallback original working path, ouch :-( reset_working_path(); $_[0]->{tpl}->process($template); $_[0]->{tpl}->print; } sub DESTORY { } 1;