RSS Git Download  Clone
Raw Blame History
package DocsLib;

# uses Plugin::Auth::Tiny - # registers keyword 'needs', which is a coderef that
# checks for 'user' key in session, or redirects to login page 

use 5.34.0; # say
use DateTime;
use Data::Printer;
use Scalar::Util qw(reftype blessed);

use Dancer2;
use Dancer2::Plugin::Auth::Tiny; 
use Dancer2::Plugin::CryptPassphrase; # this is (deliberately) slow due to hashing

use App::Model; # D2 plugin, provides 'model' keyword

use Module::List::Pluggable 'import_modules'; # import all Routes::<class>
import_modules( 'Routes', { exceptions => [] } );

prefix undef;

use constant PERLVERSION => $^V;
use if PERLVERSION lt v5.36.0, experimental => 'signatures'; # but not for routes

set auto_page => 1; # maybe not in use, but useful anyway

our $VERSION = model->app_version; say "App version: $VERSION";

hook before => sub { # my $s = session(); p $s;
	debug '-' x 12 . ' new request ' . '-' x 11;
	debug session->data;
	# debug 'session expires in '.(session->expires - DateTime->now->epoch).' sec';
};

hook after => sub { debug session->data };

# for requests without trailing slash:
get '/dpw'      => sub { redirect uri_for_route('dpw_home') };
get '/infolib'  => sub { redirect uri_for_route('infolib_home') };
get '/moongate' => sub { redirect uri_for_route('moongate_home') };

hook before_template_render => sub { # debug session->expires;
    my $tokens = shift;
	$tokens->{app_version} = $VERSION;
    $tokens->{total_count} = sub { model->total_count(@_) };
	$tokens->{apphandler}  = config->{apphandler}; # missing from settings in tt
	$tokens->{session_object}  = session(); # tt only has access to data() section of session
    $tokens->{session_expires} = _from_epoch( session->expires ); # p $tokens;
};

get 'login_page' => '/login' => sub { # my $p = params(); p $p;
    my $return_url = query_parameters->get('return_url'); # set by Auth::Tiny
    template login => { return_url => $return_url }
};

post 'authenticate_login' => '/login' => sub { # my $p = params(); p $p;
    my $password   = body_parameters->get('password');
    my $return_url = body_parameters->get('return_url'); # debug $return_url;

	if ( my $username = _authenticate_user($password) ) {
        app->change_session_id;
        session user => $username; # Plugin::Auth::Tiny requires session id = 'user'
        info "$username successfully logged in";
        redirect $return_url || '/';
    }
    else {
		$username = body_parameters->get('username') || 'unknown user';
        warning "failed login attempt for $username";
        template login => { login_error => 1, return_url => $return_url };
    }
};

get 'gitlog' => '/gitlog' => sub { template gitlog => { log => model->gitlog } };

# this isn't needed except for testing:
get 'logout' => '/logout' => sub {
    my $prefix = query_parameters->get('prefix'); # debug $prefix;
    app->destroy_session;
    redirect $prefix;
};

get 'index' => '/' => sub { template index => {}, { layout => 'default' } };

get 'routes_list' => '/routes' => sub {
    my $routes = app->routes; # p $routes;

    my @list;

    for my $method (sort keys %$routes) { # debug $method;
        next if $method eq 'head'; # not needed
        for my $route (@{ $routes->{$method} }) { # debug $route->name;
            my $handler = $route->code;
            my $handler_name = _coderef_name($handler);

            push @list, {
                method  => uc $method,
                name    => $route->name,
                path    => $route->spec_route,
                # handler => $handler_name, # not useful
            };
        }
    }
    template routes => { routes => \@list };
    # return to_json(\@list);   # needs Dancer2::Plugin::JSON or JSON::MaybeXS
};

any qr{.*} => sub {
    status 'not_found';
	my $prefix = ( split '/', request->path )[1]; # debug $prefix; # 2nd element
    template 404 => { prefix => $prefix };
};

sub _from_epoch {
    my $int = shift || return; # no session, will fatal on from_epoch() if undef
    DateTime->from_epoch( epoch => $int, time_zone => 'Europe/London' );
}

sub _coderef_name {
    my ($code) = @_; # p $code;
    return 'anonymous' unless $code;

    if (blessed($code) && $code->can('name')) {
        return $code->name;  # some wrapped subs expose names
    }

    # crude fallback: stringify the coderef
    return "$code";
}

#  using PBKDF2 for development, faster but less secure than Argon2 for deployment
sub _authenticate_user ($password) {
	my $username = body_parameters->get('username');

	if ( grep app->environment eq $_, qw/development test/ ) { # use faster PBKDF2 method
		my $user = setting 'user'; # in development_local.yml
		$username ||= $user->{name}; # don't need to provide it for dev
		return $username if model->verify_password( $password, $user->{pwd} );
	}
	else { # Plugin::CryptPassphrase (uses more secure argon2 auth; see ~/scripts/crypt_passphrase.pl)
		my $user = model->find_user($username);
		return $username if verify_password( $password, $user->{password} );
	}
	return undef; # failed authentication
}

true;