diff options
author | Guilhem Moulin <guilhem.moulin@fripost.org> | 2012-09-02 02:45:05 +0200 |
---|---|---|
committer | Guilhem Moulin <guilhem.moulin@fripost.org> | 2012-09-02 02:47:47 +0200 |
commit | 742c9938af740b9ba758f4b03909f30106b285a5 (patch) | |
tree | 58138e66695572c9a52164560b281c856d4a51b1 /lib | |
parent | ec2ed6c255ca97f39d4a58071f8558744bd9958d (diff) |
Use global configuration files.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/FPanel/Interface.pm | 132 | ||||
-rw-r--r-- | lib/FPanel/Login.pm | 245 |
2 files changed, 187 insertions, 190 deletions
diff --git a/lib/FPanel/Interface.pm b/lib/FPanel/Interface.pm index 72fa29f..6781ae5 100644 --- a/lib/FPanel/Interface.pm +++ b/lib/FPanel/Interface.pm @@ -7,75 +7,63 @@ use utf8; use lib 'lib'; use base 'FPanel::Login'; -sub cgiapp_init { - my $self = shift; - - $self->SUPER::cgiapp_init; - # define runmodes (pages) that require successful login: - $self->authen->protected_runmodes( ':all' ); +# This method is called right before the 'setup' method below. It +# inherits the configuration from the super class. +sub cgiapp_init { + my $self = shift; + + $self->SUPER::cgiapp_init; + + # Every single Run Mode here is protected + $self->authen->protected_runmodes( ':all' ); } -sub index : Runmode { - my $self = shift; - my $template = $self->load_tmpl('index.html' - , cache => 1 - , utf8 => 1 ); - my $domain = (split /\//, $ENV{PATH_INFO},3)[1]; - $template->param({ - NAME => 'INDEX', - URL => $self->query->url(), - MYDOMAIN => $domain, - USER => $self->authen->username, - }); - return $template->output; -} +# This is the first page an authenticated user sees. It lists the known +# domains. sub DomainList : StartRunmode { - my $self = shift; - - my ($u,$d) = split /@/, $self->authen->username, 2; - my $dn = "fvu=$u,fvd=$d,ou=virtual,o=mailHosting,dc=fripost,dc=dev"; - - my $ldap = Net::LDAP->new( 'ldap://127.0.0.1:389', - , async => 1, - , onerror => 'die' - ); - my $sasl = Authen::SASL->new( mechanism => 'DIGEST-MD5' - , callback => { user => 'FPanel' - , pass => 'panel' - , authname => "dn:$dn" } - ); - my $mesg = $ldap->bind( sasl => $sasl ) ; - die $mesg->error if $mesg->code; - - my $domains = $ldap->search( base => "ou=virtual,o=mailHosting,dc=fripost,dc=dev" - , scope => 'one' - , filter => 'objectClass=FripostVirtualDomain' - , deref => 'never' - ); - die $domains->error if $domains->code; - - - my $template = $self->load_tmpl('domain-list.html' - , cache => 1 - , utf8 => 1 - , loop_context_vars => 1 - , global_vars => 1 ); - $template->param( URL => $self->query->url ); - $template->param( USER_LOCALPART => $u, USER_DOMAINPART => $d); - $template->param( DOMAINS => [ - map { { DOMAIN => $_->get_value('fvd') - , PERMS => &list_perms($_, $dn) - , DESCRIPTION => join ("\n", $_->get_value('description')) - , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE' ? 1 : 0 - }; - } - $domains->sorted('fvd') - ]); - return $template->output; + my $self = shift; + my %CFG = $self->cfg; + my $suffix = join ',', @{$CFG{ldap_suffix}}; + + my ($l,$d) = split /@/, $self->authen->username, 2; + my $authzDN = "fvu=$l,fvd=$d,". $suffix; + my $ldap = $self->ldap_from_auth_user($authzDN); + + my $domains = $ldap->search( base => $suffix + , scope => 'one' + , filter => 'objectClass=FripostVirtualDomain' + , deref => 'never' + ); + die $domains->error if $domains->code; + + + my $template = $self->load_tmpl( 'domain-list.html', cache => 1, utf8 => 1 + , loop_context_vars => 1 + , global_vars => 1 ); + $template->param( URL => $self->query->url ); + $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d); + $template->param( DOMAINS => [ + map { { DOMAIN => $_->get_value('fvd') + , PERMS => &list_perms($_, $authzDN) + , DESCRIPTION => join ("\n", $_->get_value('description')) + , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE' ? 1 : 0 + }; + } + $domains->sorted('fvd') + ]); + return $template->output; } + +# This subroutine displays the access that the given DN has on the entry. +# Possible values are : +# - "can create aliases" (a) +# - "can create lists" (l) +# - "can create aliases & lists" (al) +# - "owner" (o) +# - "postmaster" (p) sub list_perms { my ($entry, $dn) = @_; my $perms = ''; @@ -115,5 +103,25 @@ sub list_perms { } } + +# This method SASL binds the web application and uses the provided +# authorization DN. +sub ldap_from_auth_user { + my $self = shift; + my $authzDN = shift; + + my $ldap = Net::LDAP->new( $self->cfg('ldap_uri'), async => 1, onerror => 'die' ); + my $sasl = Authen::SASL->new( mechanism => 'DIGEST-MD5' + , callback => { user => $self->cfg('ldap_authcID') + , pass => $self->cfg('ldap_authcPW') + , authname => "dn:$authzDN" } + ); + my $mesg = $ldap->bind( sasl => $sasl ) ; + die $mesg->error if $mesg->code; + + return $ldap; +} + + 1; diff --git a/lib/FPanel/Login.pm b/lib/FPanel/Login.pm index 55188f6..506a7b8 100644 --- a/lib/FPanel/Login.pm +++ b/lib/FPanel/Login.pm @@ -14,6 +14,7 @@ use CGI::Application::Plugin::ConfigAuto qw/cfg/; use Net::LDAP; use Authen::SASL; +use File::Spec::Functions qw/catfile catdir/; # This method is called right before the 'setup' method below. It @@ -21,21 +22,22 @@ use Authen::SASL; sub cgiapp_init { my $self = shift; + my %CFG = $self->cfg; + $self->session_config( CGI_SESSION_OPTIONS => [ 'driver:DB_File;serializer:freezethaw' , $self->query - , { FileName => '/tmp/fpanel-cgisessions.db', + , { FileName => $CFG{session_db_filename}, UMask => 0600 } - , { name => 'FripostAdminPanel_SessAuth' } + , { name => $CFG{session_authname} } ], - DEFAULT_EXPIRY => '+24h', - COOKIE_PARAMS => { -name => 'FripostAdminPanel_SessAuth' - , -path => '/cgi-bin/' + 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 - # TODO: Turn the secure flag for HTTPS connections - , -secure => 0 + , -secure => $CFG{secure_cookie} # We are not using JavaScript in this framework , -httponly => 1 }, @@ -44,12 +46,25 @@ sub cgiapp_init { # Configure authentication parameters $self->authen->config( - DRIVER => [ 'Generic' - , sub { &authenticate(@_) } ], + 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 ); + $mesg->code ? 0 : $u; + } ], STORE => 'Session', LOGIN_RUNMODE => 'login', RENDER_LOGIN => \&login_box, - LOGIN_SESSION_TIMEOUT => { IDLE_FOR => '30m' }, + LOGIN_SESSION_TIMEOUT => { IDLE_FOR => $CFG{timeout} }, LOGOUT_RUNMODE => 'logout', ); @@ -59,55 +74,58 @@ sub cgiapp_init { # 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->tmpl_path( 'template/' ); - $self->mode_param( \&mymode_param ); -} + $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"; -# This method chooses the Run Mode depending on the URL and query string. -sub mymode_param { - my $self = shift; - my $q = $self->query; - my @path = split /\//, $ENV{PATH_INFO}; - pop @path if $#path > 0 and $path[$#path] eq ''; + # The user just logged in + return 'okay' if (defined $q->param('authen_username')) and + (defined $q->param('authen_password')); + my $a = $q->param('a'); - my $mode = 'DomainList'; + return 'login' if defined $a and $a eq 'login'; + return 'logout' if defined $a and $a eq 'logout'; - if (defined $q->param('authen_username') and - defined $q->param('authen_password')) { - $mode = 'okay' - } - elsif (defined $q->param('a')) { - my $a = $q->param('a'); - if ($a eq 'login') { - $mode = 'login'; + # /domain/{user,alias,list}/?requests + my ($null,$domain,$local,$crap) = split /\//, $ENV{PATH_INFO}; + + return 'DomainList' unless (defined $null) and $null eq ''; + + unless (defined $domain and $domain ne '') { + if (defined $a) { + return 'AddDomain' if $a eq 'AddDomain'; + } + return 'DomainList'; } - elsif ($a eq 'logout') { - $mode = 'logout'; + + unless (defined $local and $local ne '') { + if (defined $a) { + return 'EditDomain' if $a eq 'edit'; + return 'AddAccount' if $a eq 'AddAccount'; + return 'AddAlias' if $a eq 'AddAlias'; + } + return 'LocalList'; } - elsif ($a eq 'AddDomain') { - $mode = 'AddDomain'; + + unless (defined $crap and $crap ne '') { + return 'LocalEdit'; } - } - elsif ($#path < 0) { - $mode = 'DomainList'; - } - elsif ($path[1] ne '') { - # $domain = $path[1]; - $mode = 'index'; - } - print STDERR $q->self_url, "\n"; - print STDERR $ENV{PATH_INFO} . '?' . $q->query_string - . " -> " - . $mode - . "\n"; - return $mode; + + return 'DomainList'; + }); } +# 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') // @@ -115,100 +133,71 @@ sub okay : Runmode { return $self->redirect($destination); } -sub login : Runmode { - my $self = shift; - my $url = $self->query->url; - - # Do not come back here afterwards - $self->query->delete( 'a' ) - if (defined $self->query->param('a')) and - $self->query->param('a') eq 'login'; - - # A logged user has no reason to ask for a relogin - $self->authen->logout if $self->authen->is_authenticated; - - $self->query->param( destination => $self->query->self_url) - unless (defined $self->query->param('destination')); - return $self->login_box; +# 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; } -sub login_box { - my $self = shift; - - my $template = $self->load_tmpl('login.html' - , cache => 1 - , utf8 => 1 ); - - my $destination = $self->query->param('destination') // - $self->mymode_param(); - - $template->param(ERROR => $self->authen->login_attempts); - $template->param(DESTINATION => $destination); - return $template->output; +# 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) { - $self->authen->logout; - $self->session->delete; - $self->session->flush; - } - - # Do not come back here afterwards - $self->query->delete( 'a' ) - if (defined $self->query->param('a')) and - $self->query->param('a') eq 'logout'; - - return $self->redirect($self->query->self_url); + 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. Users are not suppose to see that unless +# the CGI crashes :P sub error_rm : ErrorRunmode { - my $self = shift; - my $error = shift; - - my $template = $self->load_tmpl('error.html' - , cache => 1 - , utf8 => 1 ); - $template->param(NAME => 'ERROR'); - $template->param(MESSAGE => $error); - $template->param(URL => $self->query->url); - - return $template->output; + my $self = shift; + my $error = shift; + + 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; } -#sub AUTOLOAD : Runmode { -# my $self = shift; -# my $rm = shift; -# my $template = $self->load_tmpl("template/error.html"); -# $template->param(NAME => 'AUTOLOAD'); -# $template->param(MESSAGE => -# "Error: could not find run mode \'$rm\'\n"); -# $template->param(URL => $self->query->url); -# return $template->output; -#} - -sub authenticate { -# my $self = shift; - - my ($u, $p) = @_; - my ($l,$d) = split /@/, $u, 2; - - -# my %CFG = $self->cfg; - - unless (defined $d) { - $d = 'fripost.org'; - $u .= '@'.$d; - } - my $ldap = Net::LDAP->new( 'ldap://127.0.0.1:389' ); - my $mesg = $ldap->bind ( "fvu=$l,fvd=$d,ou=virtual,o=mailHosting,dc=fripost,dc=dev" - , password => $p ); - $mesg->code ? 0 : $u; -} 1; |