From ec17f0ce71a233025768a54b4a1beae34e2b8a45 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 9 Sep 2012 21:01:45 +0200 Subject: =?UTF-8?q?lib/FPanel/=20=E2=86=92=20lib/Fripost/Panel/?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/Fripost/Panel/Login.pm | 241 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 241 insertions(+) create mode 100644 lib/Fripost/Panel/Login.pm (limited to 'lib/Fripost/Panel/Login.pm') diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm new file mode 100644 index 0000000..8dcfd2b --- /dev/null +++ b/lib/Fripost/Panel/Login.pm @@ -0,0 +1,241 @@ +package Fripost::Panel::Login; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +Login.pm - + +=cut + +use parent 'CGI::Application'; + +use CGI::Application::Plugin::AutoRunmode; +use CGI::Application::Plugin::Session; +use CGI::Application::Plugin::Authentication; +use CGI::Application::Plugin::Redirect; +use CGI::Application::Plugin::ConfigAuto 'cfg'; + +use Net::LDAP; +use Authen::SASL; +use File::Spec::Functions qw/catfile catdir/; +use HTML::Entities; + + +# This method is called right before the 'setup' method below. It +# initializes the session and authentication configurations. +sub cgiapp_init { + my $self = shift; + + my %CFG = $self->cfg; + + $self->session_config( + CGI_SESSION_OPTIONS => [ 'driver:DB_File;serializer:freezethaw' + , $self->query + , { FileName => $CFG{session_db_filename}, + UMask => 0600 } + , { name => $CFG{session_authname} } + ], + DEFAULT_EXPIRY => $CFG{session_expire}, + COOKIE_PARAMS => { -name => $CFG{session_authname} + , -path => $CFG{'cgi-bin'} + # Expires when the browser quits + , -expires => -1 + ,'-max-age' => -1 + , -secure => $CFG{secure_cookie} + # We are not using JavaScript in this framework + , -httponly => 1 + }, + SEND_COOKIE => 1, + ); + + # Configure authentication parameters + $self->authen->config( + DRIVER => [ 'Generic', sub { + my ($u,$p) = @_; + my ($l,$d) = split /\@/, $u, 2; + + unless (defined $d) { + $CFG{default_realm} // return 0; + $d = $CFG{default_realm}; + $u .= '@'.$d; + } + my $bind_dn = "fvu=$l,fvd=$d,". join (',', @{$CFG{ldap_suffix}}); + + my $ldap = Net::LDAP->new( $CFG{ldap_uri} ); + my $mesg = $ldap->bind ( $bind_dn, password => $p ); + $ldap->unbind; + $mesg->code ? 0 : $u; + } ], + STORE => 'Session', + LOGIN_RUNMODE => 'login', + RENDER_LOGIN => \&login_box, + LOGIN_SESSION_TIMEOUT => { IDLE_FOR => $CFG{timeout} }, + LOGOUT_RUNMODE => 'logout', + ); + + # The run modes that require authentication + $self->authen->protected_runmodes( qw /okay error_rm/ ); +} + + +# This method is called by the inherited new() constructor method. +# It defines the path for templates and chooses the Run Mode depending +# on the URL and query string. +sub setup { + my $self = shift; + $self->header_props( -charset=>'utf-8' ); + + $self->tmpl_path( catdir ( $self->cfg('pwd'), $self->cfg('tmpl_path') ) ); + + $self->mode_param( sub { + my $self = shift; + my $q = $self->query; + print STDERR $ENV{PATH_INFO} . '?' . $q->query_string, "\n"; + + # The user just logged in + return 'okay' if defined $q->param('login'); + my $a = $q->param('a'); + + return 'login' if defined $a and $a eq 'login'; + return 'logout' if defined $a and $a eq 'logout'; + + # /domain/{user,alias,list}/?query_url + my ($null,$domain,$local,$crap) = split /\//, $ENV{PATH_INFO}; + + return 'ListDomains' unless (defined $null) and $null eq ''; + + unless (defined $domain and $domain ne '') { + if (defined $a) { + return 'AddDomain' if $a eq 'add'; + } + return 'ListDomains'; + } + + unless (defined $local and $local ne '') { + if (defined $a) { + return 'EditDomain' if $a eq 'edit'; + return 'AddLocal' if $a eq 'add'; + } + return 'ListLocals'; + } + + return 'EditLocal'; + }); +} + + +# This Run Mode redirects the freshly logged in user to the URL s/he +# wanted to visit. +sub okay : Runmode { + my $self = shift; + my $destination = $self->query->param('destination') // + $self->query->url; + return $self->redirect($destination); +} + + +# This is the login Run Mode. +sub login : Runmode { + my $self = shift; + + # A logged user has no reason to ask for a relogin, so s/he is seen as + # an intruder + $self->authen->logout if $self->authen->is_authenticated; + + # Do not come back here on the next Run Mode + $self->query->delete('a') if (defined $self->query->param('a')) and + $self->query->param('a') eq 'login'; + + # Where the users wants to go + $self->query->param( destination => $self->query->self_url) + unless defined $self->query->param('destination'); + + return $self->login_box; +} + + +# This method loads the login form. +sub login_box { + my $self = shift; + + my $template = $self->load_tmpl( 'login.html', cache => 1, utf8 => 1 ); + $template->param( error => $self->authen->login_attempts ); + $template->param( destination => $self->query->param('destination') ); + + return $template->output; +} + + +# This is the logout Run Mode. +sub logout : Runmode { + my $self = shift; + + if ($self->authen->is_authenticated) { + # Log out the user, delete the session and flush it off the disk + $self->authen->logout; + $self->session->delete; + $self->session->flush; + } + + # Do not come back here on the next Run Mode + $self->query->delete('a') if (defined $self->query->param('a')) and + $self->query->param('a') eq 'logout'; + + return $self->redirect($self->query->self_url); +} + +# This is the error Run Mode. +sub error_rm : ErrorRunmode { + my $self = shift; + my $error = shift; + + if ($error =~ /^4\d+$/) { + # HTTP client error. + chomp $error; + $self->header_props ( -status => $error ); + my $template = $self->load_tmpl( 'error_http.html', cache => 1, utf8 => 1 ); + my $mesg; + if ($error eq '403' ) { + $mesg = 'Forbidden' + } + elsif ($error eq '404' ) { + $mesg = 'Not Found' + } + $template->param( code => $error ); + $template->param( message => encode_entities ($mesg, "‘‘") ); + return $template->output; + } + + else { + # Users are not supposed to see that unless the CGI crashes :P + my $template = $self->load_tmpl( 'error.html', cache => 1, utf8 => 1 ); + $template->param( email => $self->cfg('report_email') ); + $template->param( message => $error ); + $template->param( url => $self->query->url . '/'); + return $template->output; + } +} + + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +=cut + +1; + +__END__ -- cgit v1.2.3