From 8ee2d7149baa58ea225cb40e0f95030ee21f1081 Mon Sep 17 00:00:00 2001 From: "Jannis M. Hoffmann" Date: Mon, 13 Mar 2023 21:34:03 +0100 Subject: Split up Helper plugin and added Views instead --- lib/JWebmail/Controller/Webmail.pm | 166 +++++++++++++-- lib/JWebmail/Plugin/Helper.pm | 426 ------------------------------------- lib/JWebmail/Plugin/Paginate.pm | 145 +++++++++++++ lib/JWebmail/Plugin/RenderMail.pm | 182 ---------------- lib/JWebmail/View/RenderMail.pm | 191 +++++++++++++++++ lib/JWebmail/View/Webmail.pm | 88 ++++++++ 6 files changed, 571 insertions(+), 627 deletions(-) delete mode 100644 lib/JWebmail/Plugin/Helper.pm create mode 100644 lib/JWebmail/Plugin/Paginate.pm delete mode 100644 lib/JWebmail/Plugin/RenderMail.pm create mode 100644 lib/JWebmail/View/RenderMail.pm create mode 100644 lib/JWebmail/View/Webmail.pm (limited to 'lib/JWebmail') diff --git a/lib/JWebmail/Controller/Webmail.pm b/lib/JWebmail/Controller/Webmail.pm index 8325050..acf7557 100644 --- a/lib/JWebmail/Controller/Webmail.pm +++ b/lib/JWebmail/Controller/Webmail.pm @@ -2,13 +2,20 @@ package JWebmail::Controller::Webmail; use Mojo::Base Mojolicious::Controller; +use Carp 'carp'; use List::Util 'first'; +use Mojo::Util qw(encode decode b64_encode b64_decode); use Mojolicious::Types; +use JWebmail::View::Webmail; +use JWebmail::View::RenderMail; + +use constant TRUE_RANDOM => eval { require Crypt::URandom; Crypt::URandom->import('urandom'); 1 }; + use constant { - S_USER => 'user', # Key for user name in active session - ST_AUTH => 'auth', + SES_USER => 'user', # Key for user name in active session + STS_AUTH => 'auth', }; @@ -16,7 +23,7 @@ use constant { sub noaction { my $self = shift; - my $user = $self->session(S_USER); + my $user = $self->session(SES_USER); if ($user) { $self->res->code(307); $self->redirect_to('home'); @@ -30,8 +37,8 @@ sub noaction { sub auth { my $self = shift; - my $user = $self->session(S_USER); - my ($pw, $ch) = $self->session_passwd(); + my $user = $self->session(SES_USER); + my ($pw, $ch) = $self->_session_passwd(); unless ($user && $pw) { $self->flash(message => $self->l('No active session.')); @@ -40,7 +47,7 @@ sub auth { return 0; } - $self->stash(ST_AUTH() => $self->users->Auth(user => $user, password => $pw, challenge => $ch)); + $self->stash(STS_AUTH() => $self->users->Auth(user => $user, password => $pw, challenge => $ch)); return 1; } @@ -86,8 +93,8 @@ sub login { my $valid = _time { $self->users->verify_user($auth) } $self, 'verify user'; if ($valid) { - $self->session(S_USER() => $user); - $self->session_passwd($passwd, $challenge); + $self->session(SES_USER() => $user); + $self->_session_passwd($passwd, $challenge); $self->res->code(303); $self->redirect_to('displayheaders'); @@ -104,8 +111,8 @@ sub login { sub logout { my $self = shift; - delete $self->session->{S_USER()}; - $self->session_passwd(''); + delete $self->session->{SES_USER()}; + $self->_session_passwd(''); # $self->session(expires => 1); @@ -130,7 +137,7 @@ sub displayheaders { no warnings 'experimental::smartmatch'; my $self = shift; - my $auth = $self->stash(ST_AUTH); + my $auth = $self->stash(STS_AUTH); my $folders = _time { $self->users->folders($auth) } $self, 'user folders'; @@ -178,6 +185,7 @@ sub displayheaders { $self->app->log->debug(sprintf("Reading user headers took %fs", $elapsed)); $self->stash( + v => JWebmail::View::Webmail->new, msgs => $headers, mail_folders => $folders, total_size => $count->{byte_size}, @@ -190,7 +198,7 @@ sub readmail { my $self = shift; my $mid = $self->stash('id'); - my $auth = $self->stash(ST_AUTH); + my $auth = $self->stash(STS_AUTH); my $mail; my $ok = eval { $mail = $self->users->show($auth, '', $mid); 1 }; @@ -203,7 +211,10 @@ sub readmail { die; } - $self->stash(msg => $mail); + $self->stash( + v => JWebmail::View::RenderMail->new(c => $self), + msg => $mail, + ); } @@ -211,7 +222,7 @@ sub raw { my $self = shift; my $mid = $self->stash('id'); - my $auth = $self->stash(ST_AUTH); + my $auth = $self->stash(STS_AUTH); # select a single body element my $v = $self->validation; @@ -221,9 +232,9 @@ sub raw { my $content = $self->users->raw($auth, '', $mid, $path); $self->res->headers->content_disposition(qq[attachment; filename="$content->{head}{filename}"]) - if lc $content->{head}{content_disposition} eq 'attachment'; - my $ct = $self->to_mime_type($content->{head}); - if ($ct eq 'text/plain') { $ct .= '; charset=UTF-8' } + if lc ($content->{head}{content_disposition}//'') eq 'attachment'; + my $ct = JWebmail::View::RenderMail::to_mime_type($content->{head}); + if ($ct =~ m'^text/') { $ct .= '; charset=UTF-8' } $self->res->headers->content_type($ct); $self->render(data => $content->{body}); } @@ -246,7 +257,7 @@ sub sendmail { bcc => scalar $v->optional('bcc', 'not_empty')->check('mail_line')->every_param, reply => scalar $v->optional('back_to', 'not_empty')->check('mail_line')->param, attach => scalar $v->optional('attach', 'non_empty_ul')->upload->param, - from => scalar $self->stash(ST_AUTH)->{user}, + from => scalar $self->stash(STS_AUTH)->{user}, ); $mail{attach_type} = Mojolicious::Types->new()->file_type($mail{attach}->filename) if $mail{attach}; @@ -287,7 +298,7 @@ sub move { return; } - my $auth = $self->stash(ST_AUTH); + my $auth = $self->stash(STS_AUTH); my $folders = $self->users->folders($auth); my $mm = $self->every_param('mail'); @@ -304,6 +315,85 @@ sub move { } +### session password handling + +use constant { S_PASSWD => 'pw', S_OTP_S3D_PW => 'otp_s3d_pw' }; + +sub _rand_data { + my $len = shift; + + if (TRUE_RANDOM) { + #return makerandom_octet(Length => $len, Strength => 0); # was used for Crypt::Random + return urandom($len); + } + else { + my $res = ''; + for (0..$len-1) { + vec($res, $_, 8) = int rand 256; + } + + return $res; + } +} + +sub _session_passwd { + my ($self, $passwd, $challenge) = @_; + my $secAlg = $self->config->{session}{secure}; + + $self->_warn_crypt; + + if (defined $passwd) { # set + if ($secAlg eq 'cram') { + $self->session(S_PASSWD() => $passwd, challenge => $challenge); + } + elsif ($secAlg eq 's3d') { + unless ($passwd) { + $self->s3d(S_PASSWD, ''); + delete $self->session->{S_OTP_S3D_PW()}; + return; + } + die "'$passwd' contains invalid character \\n" if $passwd =~ /\n/; + if (length $passwd < 20) { + $passwd .= "\n" . ' ' x (20 - length($passwd) - 1); + } + my $passwd_utf8 = encode('UTF-8', $passwd); + my $rand_bytes = _rand_data(length $passwd_utf8); + $self->s3d(S_PASSWD, b64_encode($passwd_utf8 ^ $rand_bytes, '')); + $self->session(S_OTP_S3D_PW, b64_encode($rand_bytes, '')); + } + else { + $self->session(S_PASSWD() => $passwd); + } + } + else { # get + if ($secAlg eq 'cram') { + wantarray or carp "you forgot the challenge"; + return ($self->session(S_PASSWD), $self->session('challenge')); + } + elsif ($secAlg eq 's3d') { + my $pw = b64_decode($self->s3d(S_PASSWD) || ''); + my $otp = b64_decode($self->session(S_OTP_S3D_PW) || ''); + my ($res) = split "\n", decode('UTF-8', $pw ^ $otp), 2; + return $res; + } + else { + return $self->session(S_PASSWD); + } + } +} + +sub _warn_crypt { + my $self = shift; + + state $once = 0; + + if ( !TRUE_RANDOM && !$once && lc $self->config->{session}{secure} eq 's3d' ) { + $self->log->warn("Falling back to pseudo random generation. Please install Crypt::URandom"); + $once = 1; + } +} + + 1 __END__ @@ -368,3 +458,41 @@ Sends a mail written in writemail. =head2 move Moves mails between mail forlders. + +=head1 METHODS + +=head2 _session_passwd + +A helper used to set and get the session password. The behavior can be altered by +setting the config variable C<< session => {secure => 's3d'} >>. + + $c->_session_passwd('s3cret'); + +Currently the following modes are supported: + +=over 6 + +=item none + +The password is plainly stored in session cookie. +The cookie is stored on the client side and send with every request. + +=item cram + +A nonce is send to the client and the cram_md5 is generated there via js +and crypto-js. +This is vulnurable to replay attacks as the nonce is not invalidated ever. + +=item s3d + +The password is stored on the server. Additionally the password is encrypted +by an one-time-pad that is stored in the users cookie. +This is vulnurable to replay attacks during an active session. +On log-in it is transfered plainly. + +=back + +=head1 DEPENDENCIES + +Crypt::URandom is recommended + diff --git a/lib/JWebmail/Plugin/Helper.pm b/lib/JWebmail/Plugin/Helper.pm deleted file mode 100644 index b298a17..0000000 --- a/lib/JWebmail/Plugin/Helper.pm +++ /dev/null @@ -1,426 +0,0 @@ -package JWebmail::Plugin::Helper; - -use Mojo::Base Mojolicious::Plugin; - -use List::Util qw(all any min max); -use Carp 'carp'; -use POSIX qw(floor round log ceil); - -use Mojo::Util qw(encode decode b64_encode b64_decode xml_escape); - -use constant TRUE_RANDOM => eval { require Crypt::URandom; Crypt::URandom->import('urandom'); 1 }; - - -### filter and checks for mojo validator - -sub mail_line { - my ($v, $name, $value, @args) = @_; - - my $mail_addr = qr/\w+\@\w+\.\w+/; - # my $unescaped_quote = qr/"(*nlb:\\)/; # greater perl version required - my $unescaped_quote = qr/"(? - ) | ( - $mail_addr - ))$ - /xn; -} - -sub filter_empty_upload { - my ($v, $name, $value) = @_; - - return $value->filename ? $value : undef; -} - - -### template formatting functions - -sub print_sizes10 { - my $var = shift || return '0 Byte'; - - my $i = floor(((log($var)/log(10))+1e-5) / 3); - my $expo = $i * 3; - - my @PREFIX; - $PREFIX[0] = 'Byte'; - $PREFIX[1] = 'kByte'; - $PREFIX[2] = 'MByte'; - $PREFIX[3] = 'GByte'; - $PREFIX[4] = 'TByte'; - $PREFIX[5] = 'PByte'; - - return sprintf('%.0f %s', $var / (10**$expo), $PREFIX[$i]); -} - -sub print_sizes2 { - my $var = shift || return '0 Byte'; - - my $i = floor(((log($var)/log(2))+1e-5) / 10); - my $expo = $i * 10; - my %PREFIX = ( - 0 => 'Byte', - 1 => 'KiByte', - 2 => 'MiByte', - 3 => 'GiByte', - 4 => 'TiByte', - 5 => 'PiByte', - ); - my $pref = $PREFIX{$i}; - return round($var / (2**$expo)) . " $pref"; -} - -my sub dgt { "([[:digit:]]{$_[0]})" } - -sub parse_iso_date { - state $rx = do { my $re = dgt(4).'-'.dgt(2).'-'.dgt(2).'T'.dgt(2).':'.dgt(2).':'.dgt(2); qr/$re/a }; - my @d = shift =~ /$rx/; - if (@d != 6) { - # TODO - warn "issue when parsing date"; - } - return { - year => $d[0], - month => $d[1], - mday => $d[2], - hour => $d[3], - min => $d[4], - sec => $d[5], - }; -} - - -### session password handling - -use constant { S_PASSWD => 'pw', S_OTP_S3D_PW => 'otp_s3d_pw' }; - -sub _rand_data { - my $len = shift; - - if (TRUE_RANDOM) { - #return makerandom_octet(Length => $len, Strength => 0); # was used for Crypt::Random - return urandom($len); - } - else { - my $res = ''; - for (0..$len-1) { - vec($res, $_, 8) = int rand 256; - } - - return $res; - } -} - -sub session_passwd { - my ($c, $passwd, $challenge) = @_; - my $secAlg = $c->config->{session}{secure}; - - warn_crypt($c); - - if (defined $passwd) { # set - if ($secAlg eq 'cram') { - $c->session(S_PASSWD() => $passwd, challenge => $challenge); - } - elsif ($secAlg eq 's3d') { - unless ($passwd) { - $c->s3d(S_PASSWD, ''); - delete $c->session->{S_OTP_S3D_PW()}; - return; - } - die "'$passwd' contains invalid character \\n" if $passwd =~ /\n/; - if (length $passwd < 20) { - $passwd .= "\n" . ' ' x (20 - length($passwd) - 1); - } - my $passwd_utf8 = encode('UTF-8', $passwd); - my $rand_bytes = _rand_data(length $passwd_utf8); - $c->s3d(S_PASSWD, b64_encode($passwd_utf8 ^ $rand_bytes, '')); - $c->session(S_OTP_S3D_PW, b64_encode($rand_bytes, '')); - } - else { - $c->session(S_PASSWD() => $passwd); - } - } - else { # get - if ($secAlg eq 'cram') { - wantarray or carp "you forgot the challenge"; - return ($c->session(S_PASSWD), $c->session('challenge')); - } - elsif ($secAlg eq 's3d') { - my $pw = b64_decode($c->s3d(S_PASSWD) || ''); - my $otp = b64_decode($c->session(S_OTP_S3D_PW) || ''); - my ($res) = split "\n", decode('UTF-8', $pw ^ $otp), 2; - return $res; - } - else { - return $c->session(S_PASSWD); - } - } -} - -sub warn_crypt { - my $c = shift; - - state $once = 0; - - if ( !TRUE_RANDOM && !$once && lc $c->config->{session}{secure} eq 's3d' ) { - $c->log->warn("Falling back to pseudo random generation. Please install Crypt::URandom"); - $once = 1; - } -} - - -### pagination - -sub _clamp { - my ($x, $y, $z) = @_; - - die '!($x <= $z)' unless $x <= $z; - - if ($x <= $y && $y <= $z) { - return $y; - } - - return $x if ($y < $x); - return $z if ($z < $y); -} - -sub _paginate { - my %args = @_; - - my $first_item = $args{first_item}; - my $page_size = $args{page_size}; - my $total_items = $args{total_items}; - - my $current_page = ceil($first_item/$page_size); - my $total_pages = ceil($total_items/$page_size); - - my $page = sub { - my $page_ = shift; - return [0, 0] unless $total_items; - $page_ = _clamp(0, $page_, $total_pages-1); - [_clamp(0, $page_*$page_size, $total_items-1), _clamp(0, ($page_+1)*$page_size, $total_items)] - }; - - my $ret = { - total_items => $total_items, - page_size => $page_size, - - total_pages => $total_pages, - current_page => $current_page, - - first_page => $page->(0), - prev_page => $page->($current_page-1), - this_page => $page->($current_page), - next_page => $page->($current_page+1), - last_page => $page->($total_pages-1), - }; - - if ($total_items) { - $ret->{first_item} = $first_item; - $ret->{last_item} = _clamp($first_item, $first_item+$page_size-1, $total_items-1); - } - - return $ret; -} - -sub paginate { - my $c = shift; - my ($count) = @_; - - my $v = $c->validation; - my $start = $v->optional('start')->num(0, undef)->param // 0; - my $psize = $v->optional('page_size')->num(1, undef)->param // 50; - - $start = _clamp(0, $start, max($count-1, 0)); - my $end = _clamp($start, $start+$psize, max($count, 0)); - - $c->stash(pgn => _paginate( - first_item => int($start/$psize)*$psize, - page_size => $psize, - total_items => $count, - )); - - return $start, $end; -} - - -### registering - -sub register { - my ($self, $app, $conf) = @_; - $conf //= {}; - - if (ref $conf->{import} eq 'ARRAY' and my @import = @{ $conf->{import} }) { - my sub contains { any { $_[0] eq $_ } @import } - - # selective import - $app->helper(print_sizes10 => sub { shift; print_sizes10(@_) }) - if contains 'print_sizes10'; - $app->helper(parse_iso_date => sub { shift; parse_iso_date(@_) }) - if contains 'parse_iso_date'; - $app->helper(print_sizes2 => sub { shift; print_sizes2(@_) }) - if contains 'print_sizes2'; - $app->helper(mime_render => \&mime_render) - if contains 'mime_render'; - $app->helper(session_passwd => \&session_passwd) - if contains 'session_passwd'; - $app->helper(paginate => \&paginate) - if contains 'paginate'; - $app->validator->add_check(mail_line => \&mail_line) - if contains 'mail_line'; - $app->validator->add_filter(non_empty_ul => \&filter_empty_upload) - if contains 'non_empty_ul'; - } - elsif (!$conf->{import}) { # default imports - $app->helper(print_sizes10 => sub { shift; print_sizes10(@_) }); - $app->helper(parse_iso_date => sub { shift; parse_iso_date(@_) }); - $app->helper(mime_render => \&mime_render); - $app->helper(session_passwd => \&session_passwd); - $app->helper(paginate => \&paginate); - - $app->validator->add_check(mail_line => \&mail_line); - - $app->validator->add_filter(non_empty_ul => \&filter_empty_upload); - } - else { - die 'unkown value for "import"' - } -} - - -1 - -__END__ - -=encoding utf-8 - -=head1 NAME - -Helper - Functions used as helpers in controller and templates and additional validator checks and filters - -=head1 SYNOPSIS - - use Mojo::Base 'Mojolicious'; - - sub startup($self) { - $app->plugin('Helper'); - } - -=head1 DESCRIPTION - -L provides useful helper functions and validator cheks and filter for -L and various templates. - -=head1 HELPERS - -=head2 mail_line - -A check for validator used in mail headers for fields containing email addresses. - - $app->validator->add_check(mail_line => \&JWebmail::Plugin::Helper::mail_line); - - my $v = $c->validation; - $v->required('to', 'not_empty')->check('mail_line'); - -=head2 filter_empty_upload - -A filter for validator used to filter out empty uploads. - - $app->validator->add_filter(non_empty_ul => \&JWebmail::Plugin::Helper::filter_empty_upload); - - my $v = $c->validation; - $v->required('file_upload', 'non_empty_ul'); - -=head2 print_sizes10 - -A helper for templates used to format byte sizes. - - $app->helper(print_sizes10 => sub { shift; JWebmail::Plugin::Helper::print_sizes10(@_) }); - - %= print_sizes10 12345 # => 12 kB - -=head2 print_sizes2 - -A helper for templates used to format byte sizes. - - %= print_sizes10 12345 # => 12 KiB - -This is not registered by default. - -=head2 paginate - -A helper for calculating page bounds. - -Takes the total number of items as argument. - -Reads in 'start' and 'page_size' query arguments. -start is 0 based. - -Returns the calculated start and end points as 0 based inclusive range. - -Sets the stash values (all 1 based inclusive): - - first_item - last_item - total_items - page_size - total_pages - current_page - first_page - prev_page - next_page - last_page - -=head2 session_passwd - -A helper used to set and get the session password. The behavior can be altered by -setting the config variable C<< session => {secure => 's3d'} >>. - - $app->helper(session_passwd => \&JWebmail::Plugin::Helper::session_passwd); - - $c->session_passwd('s3cret'); - -Currently the following modes are supported: - -=over 6 - -=item none - -The password is plainly stored in session cookie. -The cookie is stored on the client side and send with every request. - -=item cram - -A nonce is send to the client and the cram_md5 is generated there via js -and crypto-js. -This is vulnurable to replay attacks as the nonce is not invalidated ever. - -=item s3d - -The password is stored on the server. Additionally the password is encrypted -by an one-time-pad that is stored in the users cookie. -This is vulnurable to replay attacks during an active session. -On log-in it is transfered plainly. - -=back - -=head1 DEPENDENCIES - -Mojolicious and recommended Crypt::URandom. - -=head1 SEE ALSO - -L - -=head1 NOTICE - -This package is part of JWebmail. diff --git a/lib/JWebmail/Plugin/Paginate.pm b/lib/JWebmail/Plugin/Paginate.pm new file mode 100644 index 0000000..1a48ed3 --- /dev/null +++ b/lib/JWebmail/Plugin/Paginate.pm @@ -0,0 +1,145 @@ +package JWebmail::Plugin::Paginate; + +use Mojo::Base Mojolicious::Plugin; + +use List::Util qw(any max); +use POSIX 'ceil'; + + +sub _clamp { + my ($x, $y, $z) = @_; + + die '!($x <= $z)' unless $x <= $z; + + if ($x <= $y && $y <= $z) { + return $y; + } + + return $x if ($y < $x); + return $z if ($z < $y); +} + +sub _paginate { + my %args = @_; + + my $first_item = $args{first_item}; + my $page_size = $args{page_size}; + my $total_items = $args{total_items}; + + my $current_page = ceil($first_item/$page_size); + my $total_pages = ceil($total_items/$page_size); + + my $page = sub { + my $page_ = shift; + return [0, 0] unless $total_items; + $page_ = _clamp(0, $page_, $total_pages-1); + [_clamp(0, $page_*$page_size, $total_items-1), _clamp(0, ($page_+1)*$page_size, $total_items)] + }; + + my $ret = { + total_items => $total_items, + page_size => $page_size, + + total_pages => $total_pages, + current_page => $current_page, + + first_page => $page->(0), + prev_page => $page->($current_page-1), + this_page => $page->($current_page), + next_page => $page->($current_page+1), + last_page => $page->($total_pages-1), + }; + + if ($total_items) { + $ret->{first_item} = $first_item; + $ret->{last_item} = _clamp($first_item, $first_item+$page_size-1, $total_items-1); + } + + return $ret; +} + +sub paginate { + my $c = shift; + my ($count) = @_; + + my $v = $c->validation; + my $start = $v->optional('start')->num(0, undef)->param // 0; + my $psize = $v->optional('page_size')->num(1, undef)->param // 50; + + $start = _clamp(0, $start, max($count-1, 0)); + my $end = _clamp($start, $start+$psize, max($count, 0)); + + $c->stash(pgn => _paginate( + first_item => int($start/$psize)*$psize, + page_size => $psize, + total_items => $count, + )); + + return $start, $end; +} + + +sub register { + my ($self, $app, $conf) = @_; + $conf //= {}; + + $app->helper(paginate => \&paginate); +} + + +1 + +__END__ + +=encoding utf-8 + +=head1 NAME + +JWebmail::Plugin::Paginate + +=head1 SYNOPSIS + + sub my_route { + my ($c) = @_; + + $c->stash($c->paginate(1234)); + } + +=head1 DESCRIPTION + +L provides useful helper functions and validator cheks and filter for +L and various templates. + +=head1 HELPERS + +=head2 paginate + +A helper for calculating page bounds. + +Takes the total number of items as argument. + +Reads in 'start' and 'page_size' query arguments. +start is 0 based. + +Returns the calculated start and end points as 0 based inclusive range. + +Sets the stash values (all 1 based inclusive): + + first_item + last_item + total_items + page_size + total_pages + current_page + first_page + prev_page + next_page + last_page + +=head1 SEE ALSO + +L + +=head1 NOTICE + +This package is part of JWebmail. diff --git a/lib/JWebmail/Plugin/RenderMail.pm b/lib/JWebmail/Plugin/RenderMail.pm deleted file mode 100644 index 22edbbd..0000000 --- a/lib/JWebmail/Plugin/RenderMail.pm +++ /dev/null @@ -1,182 +0,0 @@ -package JWebmail::Plugin::RenderMail; - -use Mojo::Base 'Mojolicious::Plugin'; - -use Mojo::ByteStream; -use Mojo::Util 'xml_escape'; - - -sub render_text_plain { - my ($_c, $_subtype, $content, $_path) = @_; - - $content = xml_escape($content); - $content =~ s/\n/
/g; - - return qq'
\n $content
\n'; -} - -sub render_text_html { - my ($c, $_subtype, $_content, $path) = @_; - - my $url = $c->url_for('raw', id => $c->stash('id')); - $url = $url->query(path => join('.', @$path)) if @$path; - - return qq'\n'; -} - -sub render_multipart_alternative { - my ($c, $_subtype, $content, $path) = @_; - - my $parts = $content->{parts}; - my $R = qq'
'; - my $i = 0; - my $end; - - for (reverse @$parts) { - if (!$end) { - my $x = mime_render($c, to_mime_types($_->{head}), $_->{body}, [@$path, $#$parts-$i]); - if ($x) { - $R .= $x; - $end = 1; - } - } - else { - $R .= '
'; - $R .= ''; - $R .= to_mime_type($_->{head}); - $R .= "\n"; - $R .= mime_render($c, to_mime_types($_->{head}), $_->{body}, [@$path, $#$parts-$i]); - $R .= "
\n"; - } - ++$i; - } - return $R . "
\n"; -} - -sub render_multipart { - my ($c, $_subtype, $content, $path) = @_; - - my $parts = $content->{parts}; - my $R = qq'
'; - my $i = 0; - - for (@$parts) { - if ( !$_->{head}{content_disposition} - || lc $_->{head}{content_disposition} eq 'none' - || lc $_->{head}{content_disposition} eq 'inline') { - - $R .= mime_render($c, to_mime_types($_->{head}), $_->{body}, [@$path, $i]); - } - elsif (lc $_->{head}{content_disposition} eq 'attachment') { - $R .= '

'; - $R .= $c->link_to($c->url_for(raw => id => $c->stash('id'))->query(path => join('.', @$path, $i)), (download => $_->{head}{filename}) => sub { - 'Attachment ' . xml_escape($_->{head}{filename}) . ' of type ' . to_mime_type($_->{head}); - }); - $R .= "

\n"; - } - else { - warn "unknown Content-Disposition '$_->{head}{content_disposition}'"; - $R .= "

unknown Content-Disposition '$_->{head}{content_disposition}'

\n"; - } - ++$i; - } - return $R . "
\n"; -} - -sub _format_header { - my ($c, $category, $value) = @_; - - my $R = ''; - - if (ref $value eq 'ARRAY' && $value->@*) { - $R .= '
' . xml_escape(uc $c->l($category)) . "
\n"; - for ($value->@*) { - $R .= '
'; - $R .= xml_escape($_->{display_name} ? qq("$_->{display_name}" <$_->{address}>) : "$_->{address}"); - $R .= "
\n"; - } - } - return $R; -} - -sub render_message { - my ($c, $subtype, $msg, $path) = @_; - - warn "unkown mime-subtype $subtype" unless $subtype eq 'rfc822'; - - my $R .= '
'; - - $R .= '
'; - $R .= '
' . xml_escape(uc $c->l('subject')) . '
'; - $R .= '
' . xml_escape($msg->{head}{subject}) . "
\n"; - $R .= _format_header($c, from => $msg->{head}{from}); - $R .= _format_header($c, to => $msg->{head}{to}); - $R .= _format_header($c, cc => $msg->{head}{cc}); - $R .= _format_header($c, bcc => $msg->{head}{bcc}); - $R .= '
' . xml_escape(uc $c->l('date')) . '
'; - $R .= '
' . xml_escape($msg->{head}{date}) . "
\n"; - $R .= '
' . xml_escape(uc $c->l('content-type')) . '
'; - $R .= '
' . to_mime_type($msg->{head}{mime}) . "
\n"; - $R .= "
\n"; - - #my $content = ref $msg->{body} && exists $msg->{body}{parts} ? $msg->{body}{parts} : $msg->{body}; - - $R .= mime_render($c, to_mime_types($msg->{head}{mime}), $msg->{body}, [@$path, 0]); - - return $R . "
\n"; -} - -our %MIME_Render_Subs = ( - 'text/plain' => \&render_text_plain, - 'text/html' => \&render_text_html, - 'multipart/alternative' => \&render_multipart_alternative, - 'multipart' => \&render_multipart, - 'message' => \&render_message, -); - -sub mime_render { - my ($c, $maintype, $subtype, $content, $path) = @_; - - my $renderer = $MIME_Render_Subs{"$maintype/$subtype"} || $MIME_Render_Subs{$maintype}; - - unless ($renderer) { - return "

Unsupported MIME type of $maintype/$subtype.

\n"; - } - - return $renderer->($c, $subtype, $content, $path); -} - - -sub to_mime_type { lc xml_escape("$_[0]->{content_maintype}/$_[0]->{content_subtype}") } -sub to_mime_types { return xml_escape($_[0]->{content_maintype}), xml_escape($_[0]->{content_subtype}) } - - -sub register { - my ($self, $app, $conf) = @_; - $conf //= {}; - - $app->helper('render_mail.format_mail' => sub { Mojo::ByteStream->new(mime_render($_[0], 'message', 'rfc822', $_[1], [])) }); - $app->helper(to_mime_type => sub { shift; to_mime_type(@_) }); -} - -1 - -__END__ - -=encoding utf-8 - -=head1 NAME - -JWebmail::Plugin::RenderMail - Does the heavy lifting of converting an E-Mail to HTML - -=head1 HELPERS - -=head2 render_mail.format_mail - -Renders a mail to html recursively. - -=head2 to_mime_type - -Combines the content_maintype and content_subtype attributes into the regular MIME description. -These attributes are found in a mail head mime section or as head for multipart messages. - diff --git a/lib/JWebmail/View/RenderMail.pm b/lib/JWebmail/View/RenderMail.pm new file mode 100644 index 0000000..07f356c --- /dev/null +++ b/lib/JWebmail/View/RenderMail.pm @@ -0,0 +1,191 @@ +package JWebmail::View::RenderMail; + +use Mojo::Base -base; + +use Mojo::ByteStream; +use Mojo::Util 'xml_escape'; + + +has 'c'; + + +sub render_text_plain { + my ($_self, $_subtype, $content, $_path) = @_; + + $content = xml_escape($content); + $content =~ s/\n/
/g; + + return qq'
\n $content
\n'; +} + +sub render_text_html { + my ($self, $_subtype, $_content, $path) = @_; + + my $url = $self->c->url_for('raw', id => $self->c->stash('id')); + $url = $url->query(path => join('.', @$path)) if @$path; + + return qq'\n'; +} + +sub render_image { + my ($_self, $subtype, $content, $_path) = @_; + + return qq''; +} + +sub render_multipart_alternative { + my ($self, $_subtype, $content, $path) = @_; + + my $parts = $content->{parts}; + my $R = qq'
'; + my $i = 0; + my $end; + + for (reverse @$parts) { + if (!$end) { + my $x = $self->mime_render(to_mime_types($_->{head}), $_->{body}, [@$path, $#$parts-$i]); + if ($x) { + $R .= $x; + $end = 1; + } + } + else { + $R .= '
'; + $R .= ''; + $R .= to_mime_type($_->{head}); + $R .= "\n"; + $R .= $self->mime_render(to_mime_types($_->{head}), $_->{body}, [@$path, $#$parts-$i]); + $R .= "
\n"; + } + ++$i; + } + return $R . "
\n"; +} + +sub render_multipart { + my ($self, $_subtype, $content, $path) = @_; + + my $parts = $content->{parts}; + my $R = qq'
'; + my $i = 0; + + for (@$parts) { + if ( !$_->{head}{content_disposition} + || lc $_->{head}{content_disposition} eq 'none' + || lc $_->{head}{content_disposition} eq 'inline') { + + $R .= $self->mime_render(to_mime_types($_->{head}), $_->{body}, [@$path, $i]); + } + elsif (lc $_->{head}{content_disposition} eq 'attachment') { + $R .= '

'; + $R .= $self->c->link_to($self->c->url_for(raw => id => $self->c->stash('id'))->query(path => join('.', @$path, $i)), (download => $_->{head}{filename}) => sub { + 'Attachment ' . xml_escape($_->{head}{filename}) . ' of type ' . to_mime_type($_->{head}); + }); + $R .= "

\n"; + } + else { + warn "unknown Content-Disposition '$_->{head}{content_disposition}'"; + $R .= "

unknown Content-Disposition '$_->{head}{content_disposition}'

\n"; + } + ++$i; + } + return $R . "
\n"; +} + +sub _format_header { + my ($self, $category, $value) = @_; + + my $R = ''; + + if (ref $value eq 'ARRAY' && $value->@*) { + $R .= '
' . xml_escape(uc $self->c->l($category)) . "
\n"; + for ($value->@*) { + $R .= '
'; + $R .= xml_escape($_->{display_name} ? qq("$_->{display_name}" <$_->{address}>) : "$_->{address}"); + $R .= "
\n"; + } + } + return $R; +} + +sub render_message { + my ($self, $subtype, $msg, $path) = @_; + + warn "unkown mime-subtype $subtype" unless $subtype eq 'rfc822'; + + my $R .= '
'; + + $R .= '
'; + $R .= '
' . xml_escape(uc $self->c->l('subject')) . '
'; + $R .= '
' . xml_escape($msg->{head}{subject}) . "
\n"; + $R .= $self->_format_header(from => $msg->{head}{from}); + $R .= $self->_format_header(to => $msg->{head}{to}); + $R .= $self->_format_header(cc => $msg->{head}{cc}); + $R .= $self->_format_header(bcc => $msg->{head}{bcc}); + $R .= '
' . xml_escape(uc $self->c->l('date')) . '
'; + $R .= '
' . xml_escape($msg->{head}{date}) . "
\n"; + $R .= '
' . xml_escape(uc $self->c->l('content-type')) . '
'; + $R .= '
' . to_mime_type($msg->{head}{mime}) . "
\n"; + $R .= "
\n"; + + #my $content = ref $msg->{body} && exists $msg->{body}{parts} ? $msg->{body}{parts} : $msg->{body}; + + $R .= $self->mime_render(to_mime_types($msg->{head}{mime}), $msg->{body}, [@$path, 0]); + + return $R . "
\n"; +} + +our %MIME_Render_Subs = ( + 'text/plain' => \&render_text_plain, + 'text/html' => \&render_text_html, + 'multipart/alternative' => \&render_multipart_alternative, + 'multipart' => \&render_multipart, + 'message' => \&render_message, + 'image' => \&render_image, +); + +sub mime_render { + my ($self, $maintype, $subtype, $content, $path) = @_; + + my $renderer = $MIME_Render_Subs{"$maintype/$subtype"} || $MIME_Render_Subs{$maintype}; + + unless ($renderer) { + return "

Unsupported MIME type of $maintype/$subtype.

\n"; + } + + return $renderer->($self, $subtype, $content, $path); +} + + +sub to_mime_type { lc xml_escape("$_[0]->{content_maintype}/$_[0]->{content_subtype}") } +sub to_mime_types { return xml_escape($_[0]->{content_maintype}), xml_escape($_[0]->{content_subtype}) } + + +sub format_mail { + my ($self, $mail) = @_; + + return Mojo::ByteStream->new($self->mime_render('message', 'rfc822', $mail, [])); +} + +1 + +__END__ + +=encoding utf-8 + +=head1 NAME + +JWebmail::View::RenderMail - Does the heavy lifting of converting an E-Mail to HTML + +=head1 FUNCTIONS + +=head2 to_mime_type + +Combines the content_maintype and content_subtype attributes into the regular MIME description. +These attributes are found in a mail head mime section or as head for multipart messages. + +=head1 METHODS + +=head2 format_mail + +Renders a mail to html recursively. diff --git a/lib/JWebmail/View/Webmail.pm b/lib/JWebmail/View/Webmail.pm new file mode 100644 index 0000000..464c97e --- /dev/null +++ b/lib/JWebmail/View/Webmail.pm @@ -0,0 +1,88 @@ +package JWebmail::View::Webmail; + +use Mojo::Base -base; + +use POSIX qw(floor round log); + + +### template formatting functions + +sub print_sizes10 { + shift; + my $var = shift || return '0 Byte'; + + my $i = floor(((log($var)/log(10))+1e-5) / 3); + my $expo = $i * 3; + + my @PREFIX; + $PREFIX[0] = 'Byte'; + $PREFIX[1] = 'kByte'; + $PREFIX[2] = 'MByte'; + $PREFIX[3] = 'GByte'; + $PREFIX[4] = 'TByte'; + $PREFIX[5] = 'PByte'; + + return sprintf('%.0f %s', $var / (10**$expo), $PREFIX[$i]); +} + +sub print_sizes2 { + shift; + my $var = shift || return '0 Byte'; + + my $i = floor(((log($var)/log(2))+1e-5) / 10); + my $expo = $i * 10; + my %PREFIX = ( + 0 => 'Byte', + 1 => 'KiByte', + 2 => 'MiByte', + 3 => 'GiByte', + 4 => 'TiByte', + 5 => 'PiByte', + ); + my $pref = $PREFIX{$i}; + return round($var / (2**$expo)) . " $pref"; +} + +my sub dgt { "([[:digit:]]{$_[0]})" } + +sub parse_iso_date { + shift; + state $rx = do { my $re = dgt(4).'-'.dgt(2).'-'.dgt(2).'T'.dgt(2).':'.dgt(2).':'.dgt(2); qr/$re/a }; + my @d = shift =~ /$rx/; + if (@d != 6) { + # TODO + warn "issue when parsing date"; + } + return { + year => $d[0], + month => $d[1], + mday => $d[2], + hour => $d[3], + min => $d[4], + sec => $d[5], + }; +} + +1 + +__END__ + +=head1 VIEW METHODS + +=head2 print_sizes10 + +A helper for templates used to format byte sizes. + + $app->helper(print_sizes10 => sub { shift; JWebmail::Plugin::Helper::print_sizes10(@_) }); + + %= print_sizes10 12345 # => 12 kB + +=head2 print_sizes2 + +A helper for templates used to format byte sizes. + + %= print_sizes10 12345 # => 12 KiB + +This is not registered by default. + +=head2 parse_iso_date -- cgit v1.2.3