aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@fripost.org>2012-09-02 02:45:05 +0200
committerGuilhem Moulin <guilhem.moulin@fripost.org>2012-09-02 02:47:47 +0200
commit742c9938af740b9ba758f4b03909f30106b285a5 (patch)
tree58138e66695572c9a52164560b281c856d4a51b1 /lib
parentec2ed6c255ca97f39d4a58071f8558744bd9958d (diff)
Use global configuration files.
Diffstat (limited to 'lib')
-rw-r--r--lib/FPanel/Interface.pm132
-rw-r--r--lib/FPanel/Login.pm245
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;