path: root/lib/JWebmail/Controller/Webmail.pm

package JWebmail::Controller::Webmail;

use Mojo::Base Mojolicious::Controller;

use Carp 'carp';
use List::Util qw(any first);

use Mojo::Util qw(encode decode b64_encode b64_decode);
use Mojolicious::Types;

use JWebmail::Config 'LOGIN_SCHEME';
use JWebmail::View::Webmail;
use JWebmail::View::RenderMail;

use constant TRUE_RANDOM => eval { require Crypt::URandom; Crypt::URandom->import('urandom'); 1 };

use constant {
    SES_USER => 'user', # Key for user name in active session
    STS_AUTH => 'auth',
};


# no action has been taken, display login page
sub noaction {
    my $self = shift;

    my $user = $self->session(SES_USER);
    if ($user) {
        $self->res->code(307);
        $self->redirect_to('home');
        return;
    }
    $self->render(action => 'login');
}


# middleware
sub auth {
    my $self = shift;

    my $user = $self->session(SES_USER);
    my ($pw, $ch) = $self->_session_passwd();

    unless ($user && $pw) {
        $self->flash(message => $self->l('No active session.'));
        $self->res->code(401);
        $self->redirect_to('logout');
        return 0;
    }

    $self->stash(STS_AUTH() => $self->users->Auth(user => $user, password => $pw, challenge => $ch));

    return 1;
}


sub _time :prototype(&$$) {
    my $code = shift;
    my $self = shift;
    my $name = shift;

    $self->timing->begin($name);

    my @res = $code->();

    my $elapsed = $self->timing->elapsed($name);
    $self->app->log->debug(sprintf("%s took %fs", $name, $elapsed));

    return wantarray ? @res : $res[-1];
}


sub login {
    my $self = shift;

    my $uses_cram = LOGIN_SCHEME eq fc 'cram_md5';

    my $v = $self->validation;

    my $user = $v->required('userid')->size(4, 50)->param;
    my $passwd = $v->required('password')->size(4, 50)->like(qr/^.+$/)->param; # no new-lines
    my $challenge;
    if ($uses_cram) {
        $challenge = $v->required('challenge')->size(4, 50)->param;
    }

    if ($v->has_error) {
        $self->render(status => 400);
        return;
    }

    my $auth = $self->users->Auth(user => $user, password => $passwd);
    $auth->{challenge} = $challenge if $uses_cram;
    my $valid = _time { $self->users->verify_user($auth) } $self, 'verify user';

    if ($valid) {
        $self->session(SES_USER() => $user);
        $self->_session_passwd($passwd, $challenge);

        $self->res->code(303);
        $self->redirect_to('displayheaders');
    }
    else {
        $self->render(
            status => 401,
            warning => $self->l('Login failed!'),
        );
    }
}


sub logout {
    my $self = shift;

    delete $self->session->{SES_USER()};
    $self->_session_passwd('');

    # $self->session(expires => 1);

    $self->res->code(303);
    $self->redirect_to('login');
}


sub about {
    my $self = shift;

    $self->stash(
        scriptadmin => $self->config->{defaults}{scriptadmin},
        http_host   => $self->tx->req->url->to_abs->host,
        request_uri => $self->tx->req->url,
        remote_addr => $self->tx->original_remote_address,
    );
}


sub displayheaders {
    no warnings 'experimental::smartmatch';
    my $self = shift;

    my $auth = $self->stash(STS_AUTH);

    my $folders = _time { $self->users->folders($auth) } $self, 'user folders';

    unless ( !$self->stash('folder') || any { $self->stash('folder') eq $_ } @$folders ) {
        $self->render(template => 'error',
            status => 404,
            error => $self->l('no_folder'),
            links => [map { $self->url_for(folder => $_) } @$folders],
        );
        return;
    }

    my $v = $self->validation;
    my $sort = $v->optional('sort')->like(qr'^!?(?:date|subject|sender|size)$')->param // '!date';
    my $search = $v->optional('search')->param;

    if ($v->has_error) {
        local $" = ' ';
        $self->render(template => 'error', error => "errors in @{ $v->failed }", status => 400);
        return;
    }

    my $count = _time { $self->users->count($auth, $self->stash('folder')) } $self, 'user count';

    my ($start, $end) = $self->paginate($count->{total_mails});

    $self->timing->begin('user_headers');
    my $headers = do {
        if ($search) {
            $self->users->search(
                $auth, $search, $self->stash('folder'),
            )
        }
        else {
            $self->users->read_headers_for(
                $auth,
                folder => $self->stash('folder'),
                start  => $start,
                end    => $end,
                sort   => $sort,
            )
        }
    };
    my $elapsed = $self->timing->elapsed('user_headers');
    $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},
        total_new_mails => $count->{unread_mails},
    );
}


sub readmail {
    my $self = shift;

    my $mid = $self->stash('id');
    my $auth = $self->stash(STS_AUTH);

    my $mail;
    my $ok = eval { $mail = $self->users->show($auth, '', $mid); 1 };
    if (!$ok) {
        my $err = "$@";
        if ($err =~ /unkown mail-id|no such message/) {
            $self->reply->not_found;
            return;
        }
        die;
    }

    $self->stash(
        v   => JWebmail::View::RenderMail->new(c => $self),
        msg => $mail,
    );
}


sub raw {
    my $self = shift;

    my $mid = $self->stash('id');
    my $auth = $self->stash(STS_AUTH);

    # select a single body element
    my $v = $self->validation;
    my $path = $v->optional('path')->like(qr(^\d(\.\d)*$)a)->param;
    return $self->render(text => 'Issue in parameter "path": '.join(' ', $v->error('path')->@*), status => 400, format => 'txt') if $v->has_error;

    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 = 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});
}


sub writemail { }


sub sendmail {
    my $self = shift;

    my $v = $self->validation;
    $v->csrf_protect;

    my %mail = (
        to      => scalar $v->required('to', 'not_empty')->check('mail_line')->every_param,
        message => scalar $v->required('body', 'not_empty')->param,
        subject => scalar $v->required('subject', 'not_empty')->param,
        cc      => scalar $v->optional('cc', 'not_empty')->check('mail_line')->every_param,
        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(STS_AUTH)->{user},
    );
    $mail{attach_type} = Mojolicious::Types->new()->file_type($mail{attach}->filename) if $mail{attach};

    if ($v->has_error) {
        $self->log->debug("mail send failed. Error in @{ $v->failed }");

        $self->render(action => 'writemail',
            warning => $self->l('error_send'),
        );
        return;
    }

    my $error = $self->send_mail(\%mail);

    if ($error) {
        $v->error(send => ['internal_error']); # make validation fail so that values are restored

        $self->render(action => 'writemail',
            warning => $self->l('error_send'),
            status => 400,
        );
        return;
    }

    $self->flash(message => $self->l('succ_send'));
    $self->res->code(303);
    $self->redirect_to('displayheaders');
}


sub move {
    my $self = shift;

    my $v = $self->validation;
    $v->csrf_protect;

    if ($v->has_error) {
        return;
    }

    my $auth = $self->stash(STS_AUTH);
    my $folders = $self->users->folders($auth);

    my $mm = $self->every_param('mail');
    my $folder = $self->param('folder');

    no warnings 'experimental::smartmatch';
    die "$folder not valid" unless any { $folder eq $_ } @$folders;

    $self->users->move($auth, $_, '', $folder) for @$mm;

    $self->flash(message => $self->l('succ_move'));
    $self->res->code(303);
    $self->redirect_to('displayheaders');
}


### 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 = LOGIN_SCHEME;

    $self->_warn_crypt;

    if (defined $passwd) { # set
        if ($secAlg eq fc 'cram_md5') {
            $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 fc 'cram_md5') {
            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__

=encoding utf-8

=head1 NAME

Webmail - All functions comprising the webmail application.

=head1 SYNOPSIS

    my $r = $app->routes;
    $r->get('/about')->to('Webmail#about');
    $r->post('/login')->to('Webmail#login');

=head1 DESCRIPTION

The controller of JWebmail.

=head1 ROUTES

=head2 noaction

The login page. This should be the root.

=head2 auth

    my $a = $r->under('/')->to('Webmail#auth');

    An intermediate route that makes sure a user has a valid session.

=head2 login

Post route that checks login data.

=head2 logout

Route that clears session data.

=head2 about

Public route.

=head2 displayheaders

Provides an overview over messages.

=head2 readmail

Displays a single mail.
Can also be displayed as JSON or only one body part as the appropriate content type.

=head2 writemail

A mail editor.

=head2 sendmail

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