package JWebmail::Plugin::Helper;
use Mojo::Base Mojolicious::Plugin;
use List::Util qw(all 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 };
use constant HMAC_MD5 => eval { require Digest::HMAC_MD5; Digest::HMAC_MD5->import('hmac_md5'); 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],
};
}
### mime type html render functions
my $render_text_plain = sub {
my ($c, $content) = @_;
$content = xml_escape($content);
$content =~ s/\n/
/g;
return $content;
};
my $render_text_html = sub {
my $c_ = shift;
return '';
};
our %MIME_Render_Subs = (
'text/plain' => $render_text_plain,
'text/html' => $render_text_html,
);
sub mime_render {
my ($c, $enc, $cont) = @_;
($enc) = $enc =~ m<^(\w+/\w+);?>;
my $renderer = $MIME_Render_Subs{$enc} // return '';
return $renderer->($c, $cont);
};
### 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};
die "you need to install Digest::HMAC_MD5 for cram to work"
if !HMAC_MD5 && $secAlg eq 'cram';
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} || 1;
my $total_items = $args{total_items};
my $first_item1 = $total_items ? $first_item+1 : 0;
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(1, $page_*$page_size + 1, $total_items), _clamp(1, ($page_+1)*$page_size, $total_items)]
};
return (
first_item => $first_item1,
last_item => _clamp($first_item1, $first_item + $page_size, $total_items),
total_items => $total_items,
page_size => $page_size,
total_pages => $total_pages,
current_page => $current_page + 1,
first_page => $page->(0),
prev_page => $page->($current_page-1),
next_page => $page->($current_page+1),
last_page => $page->($total_pages-1),
);
}
sub paginate {
my $c = shift;
my $count = shift;
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-1, max($count-1, 0));
$c->stash(_paginate(first_item => $start, 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} }) {
no warnings 'experimental::smartmatch';
# selective import
$app->helper(print_sizes10 => sub { shift; print_sizes10(@_) })
if 'print_sizes10' ~~ @import;
$app->helper(parse_iso_date => sub { shift; parse_iso_date(@_) })
if 'parse_iso_date' ~~ @import;
$app->helper(print_sizes2 => sub { shift; print_sizes2(@_) })
if 'print_sizes2' ~~ @import;
$app->helper(mime_render => \&mime_render)
if 'mime_render' ~~ @import;
$app->helper(session_passwd => \&session_passwd)
if 'session_passwd' ~~ @import;
$app->helper(paginate => \&paginate)
if 'paginate' ~~ @import;
$app->validator->add_check(mail_line => \&mail_line)
if 'mail_line' ~~ @import;
$app->validator->add_filter(non_empty_ul => \&filter_empty_upload)
if 'non_empty_ul' ~~ @import;
}
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);
}
}
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';
use JWebmail::Plugin::Helper;
sub startup($self) {
$self->helper(mime_render => \&JWebmail::Plugin::Helper::mime_render);
}
# or
$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 mime_render
A helper for templates used to display the content of a mail for the browser.
The output is valid html and should not be escaped.
$app->helper(mime_render => \&JWebmail::Plugin::Helper::mime_render);
%== mime_render 'text/plain' $content
=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
password is plainly stored in session cookie
=item cram
challenge response authentication mechanism uses the C<< $app->secret->[0] >> as nonce.
This is optional if Digest::HMAC_MD5 is installed.
=item s3d
data is stored on the server. Additionally the password is encrypted by an one-time-pad that is stored in the user cookie.
=back
=head1 DEPENDENCIES
Mojolicious and optionally Digest::HMAC_MD5, Crypt::URandom.
=head1 SEE ALSO
L, L, L, L
=head1 NOTICE
This package is part of JWebmail.
=cut