diff options
Diffstat (limited to 'lib/FPanel/Login.pm')
| -rw-r--r-- | lib/FPanel/Login.pm | 241 |
1 files changed, 0 insertions, 241 deletions
diff --git a/lib/FPanel/Login.pm b/lib/FPanel/Login.pm deleted file mode 100644 index ab7bf36..0000000 --- a/lib/FPanel/Login.pm +++ /dev/null @@ -1,241 +0,0 @@ -package FPanel::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<< <guilhem at fripost.org> >> - -=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__ |