#!/usr/bin/perl -T

#----------------------------------------------------------------------
# Fripost's admin panel - PSGI application
# Copyright © 2012-2018 Fripost
# Copyright © 2012-2018 Guilhem Moulin <guilhem@fripost.org>
#
# This program is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#----------------------------------------------------------------------

use strict;
use warnings;

use Digest::SHA "hmac_sha256";
use MIME::Base64 qw/encode_base64 decode_base64 encode_base64url/;

use Crypt::URandom "urandom";
use HTML::Template ();
use Plack::Builder ();
use Plack::Session::Store::Cache ();
use Plack::Session::State::Cookie ();
use URI::Escape "uri_unescape";
use CGI "escapeHTML"; # XXX use HTML::Escape::escape_html() instead

use lib "lib";
use Fripost ();
use Fripost::Session ();
use Fripost::Util "read_config";

my %CONFIG = read_config();
$CONFIG{www} //= {};
$CONFIG{www}->{"templates-directory"} //= "./templates/html";

# Generate or decode the HMAC key
if ((my $v = $CONFIG{www}->{"hmac-key"} // "") eq "") {
    print STDERR "Generating new random key for HMAC-SHA256...\n";
    $CONFIG{www}->{"hmac-key"} = urandom(32);
} else {
    my $key = decode_base64($v);
    # decode_base64() silently ignores invalid characters so we
    # re-encode the output to validate it
    die "Invalid base64 value: $v\n" if encode_base64($key, "") ne $v;
    $CONFIG{www}->{"hmac-key"} = $key;
}

# Where to redirect authenticated users
my $WELCOME_PAGE = "/overview";


########################################################################
#

# throw(FORMAT, [ARG, ..])
#   Format the error message in $ERRSTR and throw an exception.
our $ERRSTR;
sub throw($;@) {
    my $format = shift;
    chomp $format;
    $format =~ s#C<(%\p{PosixAlpha})>#<tt>$1</tt>#g;
    $ERRSTR = sprintf($format, map {escapeHTML($_)} @_);
    die "I'm a bug, please report"; # we should never see this
}

# csrf_token_validate(REQ)
#   Throw an exception if the "csrf-token" POST parameter isn't a valid
#   CSRF token.
sub csrf_token_validate($) {
    my $req = shift;
    my $sid = $req->session_options->{id};
    my $key = $CONFIG{www}->{"hmac-key"} // die;
    my $token = $req->body_parameters->get("csrf-token");

    throw("CSRF token validation failed.") unless
        defined $sid and defined $token and
        # tokens are valid for 1 day
        $token =~ s/\A([0-9]+)-// and (time - $1) <= 86400 and
        $token eq encode_base64url( hmac_sha256($1 . $sid, $key) );
}

# render(REQ, TEMPLATE, [VAR1 => VAL1, ..])
#   Render an HTML template, embedding a CSRF token and possibly other
#   variables.
sub render($$%) {
    my $sid = shift->session_options->{id} // die;
    my $filename = shift;
    my %params = @_;

    my $tmpl = HTML::Template::->new(
        path => $CONFIG{www}->{"templates-directory"}
      , filename => $filename
      , cache => $ENV{PLACK_ENV} eq "development" ? 0 : 1
      , loop_context_vars => 1
    );

    my $timestamp = time;
    my $digest = hmac_sha256($timestamp . $sid, $CONFIG{www}->{"hmac-key"});
    $params{CSRF_TOKEN} = $timestamp ."-". encode_base64url($digest);

    $tmpl->param(%params);
    return [ 200, ["Content-Type" => "text/html"], [$tmpl->output] ];
}

# redirect(CODE => LOCATION)
#   Produce a redirection page with the given code and location.
sub redirect($$) {
    my ($code, $location) = @_;
    return [ $code, ["Location" => $location], [] ];
}


########################################################################
# Configure middleware for session cache and cookie
#
$ENV{PLACK_ENV} //= "development";
my $builder = Plack::Builder::->new();
{
    my %cookie_opts;
    foreach (qw/domain path/) {
        my $v = $CONFIG{www}->{"cookie-$_"};
        $cookie_opts{$_} = $v if defined $v and $v ne "";
    }
    foreach (qw/httponly secure/) {
        my $v = $CONFIG{www}->{"cookie-$_"} // continue;
        $cookie_opts{$_} = lc $v eq "true" ? 1 : lc $v eq "false" ? 0 : undef;
    }

    my $cache = Fripost::Util::session_cache(%{$CONFIG{www}});
    $builder->add_middleware( "Session"
      , store => Plack::Session::Store::Cache::->new(cache => $cache)
      , state => Plack::Session::State::Cookie::->new(
            # fresh session IDs have 192 bits of entropy (32 characters in base64)
            sid_generator => sub() { encode_base64url(urandom(24), "") }
          , sid_validator => qr/\A[A-Za-z0-9\-_]{32}\z/
          , %cookie_opts
        )
    )
}

if ($ENV{PLACK_ENV} eq "development") {
    # don't rely on system CSS/JS/fonts libraries in dev mode
    my %resources = qw{
         css/bootstrap.min.css    https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css
         css/font-awesome.min.css https://maxcdn.bootstrapcdn.com/font-awesome/4.7.0/css/font-awesome.min.css
         js/bootstrap.min.js      https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js
         js/jquery.min.js         https://code.jquery.com/jquery-3.3.1.min.js
    };
    warn "WARNING: Development mode, with cross-site requests!\n"
        ."In production, serve static files locally using a reverse proxy instead.\n";
    foreach my $r (keys %resources) {
        $builder->mount( "/static/$r" => sub($) { redirect(303 => $resources{$r}) } );
    }
    # serve our own existing static files
    $builder->add_middleware("Static", path => qr{\A/static/}, pass_through => 1);
}


########################################################################
# Mount the login page
#
$builder->mount("/login" => sub($) {
    my $req = Plack::Request::->new(shift);
    my %tmpl_params = (ALERT => "");
    local $ERRSTR = undef;

    if ($req->method eq "POST") {
        my $r = eval {
            csrf_token_validate($req);
            # don't connect to the backend if the CSRF token is invalid
            my $fp = Fripost::->new(%CONFIG, onerror => \&throw);

            # append the default domain to bare usernames
            my $username = $req->body_parameters->get("username");
            $username .= "@" . $CONFIG{www}->{"default-domain"} if
                defined $username and defined $CONFIG{www}->{"default-domain"}
                and $username !~ /[\@\N{U+FE6B}\N{U+FF20}]/;

            # try to authenticate now
            $fp->login($username, $req->body_parameters->get("password"));

            # $creds contains its own authentication ID; we're can't use
            # the session ID because the new one isn't available until
            # after the function exits
            $req->session->{credentials} = Fripost::Session::->new($fp);

            # login was successful; get a new session ID now, to protect
            # against session fixation attacks
            $req->session_options->{change_id}++;
        };
        if (defined $r) {
            my $goto = $req->query_parameters->get("goto");
            $goto = uri_unescape($goto) if defined $goto;
            return redirect(302 => $goto // $WELCOME_PAGE);
        } elsif (not defined $ERRSTR) {
            die "Internal error: ", $@;
        } else {
            delete $req->session->{credentials};
            $tmpl_params{ALERT} = $ERRSTR;
            $tmpl_params{ALERT_TYPE} = "danger";
        }
    }
    elsif (defined $req->session->{credentials}) {
        # already logged in
        my $goto = $req->query_parameters->get("goto");
        $goto = uri_unescape($goto) if defined $goto;
        return redirect(302 => $goto // $WELCOME_PAGE);
    }
    else {
        if ($req->query_parameters->get("signoff")) {
            $tmpl_params{ALERT_TYPE} = "success";
            $tmpl_params{ALERT} = "You successfully logged out.";
        }
    }

    $tmpl_params{DOMAIN} = $CONFIG{www}->{"cookie-domain"};
    render( $req, "login.html", %tmpl_params );
});


########################################################################
# Mount the logout page
#
$builder->mount("/logout" => sub($) {
    my $req = Plack::Request::->new(shift);
    local $ERRSTR = undef;

    if ($req->method eq "POST") {
        # log out out via POST and validate the CSRF token
        if (defined (eval { csrf_token_validate($req) })) {

            # silently try to destroy the session on the LDAP backend
            $req->session->{credentials}->destroy(%CONFIG, onerror => sub($@) {});

            # force the session to expire in our local cache
            delete $req->session->{credentials};
            $req->session_options->{expire} = 1;

            return redirect( 302 => "/login?signoff=1" );
        }
        elsif (not defined $ERRSTR) {
            die "Internal error: ", $@;
        }
    }

    # refuse to log out otherwise, redirect to the welcome page instead
    return redirect( 302 => $WELCOME_PAGE );
});


########################################################################
# Mount the overview page
#
$builder->mount($WELCOME_PAGE => sub($) {
    my $req = Plack::Request::->new(shift);

    return redirect( 302 => "/login" )
        # skip "?goto=..." for the default page
        unless defined $req->session->{credentials};

    local $ERRSTR = undef;
    my %tmpl_params;

    my $r = eval {
        # authenticate the session credentials (and refresh the entry)
        $req->session->{credentials}->authenticate(%CONFIG, onerror => \&throw);
    };
    if (defined $r) {
        $tmpl_params{AUTHZID} = $req->session->{credentials}->{authzid};
    } elsif (not defined $ERRSTR) {
        die "Internal error: ", $@;
    } else {
        # something went wrong...
        $tmpl_params{AUTHZID} = "oops";
    }

    render( $req, "overview.html", %tmpl_params );
});


########################################################################
# Add a catch-all: redirect all other segments to the welcome page.
#
$builder->mount( "/" => sub($) { redirect( 303 => $WELCOME_PAGE ) } );
$builder->to_app();