aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xcgi-bin/index.cgi8
-rw-r--r--config.in19
-rw-r--r--config.yml17
-rw-r--r--default.in40
-rw-r--r--lib/FPanel/Interface.pm132
-rw-r--r--lib/FPanel/Login.pm245
-rwxr-xr-xserver.pl25
-rw-r--r--template/error.html6
8 files changed, 272 insertions, 220 deletions
diff --git a/cgi-bin/index.cgi b/cgi-bin/index.cgi
index 9ac0e6e..6f3053f 100755
--- a/cgi-bin/index.cgi
+++ b/cgi-bin/index.cgi
@@ -6,6 +6,7 @@ use utf8;
use lib 'lib';
use FPanel::Interface;
+
# TODO: Try out Fast CGI
#use CGI::Fast();
#
@@ -14,5 +15,10 @@ use FPanel::Interface;
# $app->run();
#}
-my $cgi = FPanel::Interface->new();
+my @config = 'default.in';
+push @config, 'config.in' if -f 'config.in';
+
+my $cgi = FPanel::Interface->new(
+ PARAMS => { cfg_file => [ @config ], format => 'equal' }
+);
$cgi->run();
diff --git a/config.in b/config.in
new file mode 100644
index 0000000..f687c46
--- /dev/null
+++ b/config.in
@@ -0,0 +1,19 @@
+# This is the custom configuration for the Fripost Administration Panel,
+# which takes precedence over the default configuration in 'default.in'.
+
+
+# TODO: The secure flag should be left on on HTTPS connections.
+secure_cookie = 0
+
+# Where the error reports should be sent to.
+report_email = admin@fripost.org
+
+# The domain that will be appended to non fully qualified usernames.
+default_realm = fripost.org
+
+# The LDAP suffix that will be appended to bind and search DN:s.
+ldap_suffix = ou=virtual,o=mailHosting,dc=fripost,dc=dev
+
+# TODO: This should be replaced with a Keberos ticket.
+ldap_authcID = FPanel
+ldap_authcPW = panel
diff --git a/config.yml b/config.yml
deleted file mode 100644
index 17df6d4..0000000
--- a/config.yml
+++ /dev/null
@@ -1,17 +0,0 @@
----
-# LDAP configuration
-ldap: { server_host: ldap://127.0.0.1:3890/
- , base_dn: ou=virtual,o=mailHosting,dc=fripost,dc=dev
- , authcid: FPanel
- , bind_pw: panel #TODO: this is to be replaced with a Kerberos ticket (SASL/GSSAPI authentication)
- }
-
-# The domain that is to be appended to non fully qualified usernames
-default_realm: fripost.org
-
-# Session configuration
-session: { cookie: { path: '/index.cgi'
- , secure: 0 # TODO: turn that on on HTTS connections
- }
- , expire: '+24h'
- }
diff --git a/default.in b/default.in
new file mode 100644
index 0000000..683a5bf
--- /dev/null
+++ b/default.in
@@ -0,0 +1,40 @@
+# This is the default configuration for the Fripost Administration
+# Panel. It is best not to modify this file as many of the keys here are
+# mandatory. Custom configuration should be but in `config.in' instead,
+# which overrides the below.
+
+
+
+# Non absolute paths are be relative to this directory.
+pwd = ./
+
+
+# Directory for templates
+tmpl_path = template/
+
+
+# Session configuration
+#
+# Where to put the session database on our server
+session_db_filename = /tmp/fpanel-cgisessions.db
+
+# The name of the cookies sent to the users
+session_authname = FripostAdminPanel_SessAuth
+
+# When does the session expire
+session_expire = +24h
+
+# Turn on the 'secure' flag before sending a cookie
+secure_cookie = 1
+
+# The path attribute for the sent cookies
+cgi-bin = /cgi-bin/
+
+# A timeout for idle connections, after which the user is automatically
+# logged out
+timeout = 30m
+
+
+
+# LDAP configuration
+ldap_uri =ldap://127.0.0.1:389
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;
diff --git a/server.pl b/server.pl
index 3a1ac83..dc65539 100755
--- a/server.pl
+++ b/server.pl
@@ -4,20 +4,25 @@ use strict;
use warnings;
use utf8;
-use CGI::Application::Server;
+use MyServer;
use lib 'lib';
use FPanel::Interface;
-#use MyCGI::App::Account::Dispatch;
-my $server = CGI::Application::Server->new();
-#my $panel = FPanel::Interface->new(
-# PARAMS => { cfg_file => ['config.yml']
-# , format => 'YAML'
-# }
-#);
+my $server = MyServer->new();
$server->entry_points({
- '/cgi-bin' => #$panel
- 'FPanel::Interface'
+ '/cgi-bin' => 'FPanel::Interface'
});
+
+my @config = 'default.in';
+push @config, 'config.in' if -f 'config.in';
+
+# TODO: This is only for testing purposes. Using a blessed target above
+# prevents me from logging in.
+$server->options({
+ '/cgi-bin' => {
+ PARAMS => { cfg_file => [ @config ], format => 'equal' }
+ }
+});
+
$server->run();
diff --git a/template/error.html b/template/error.html
index d9d4eb1..ef454ab 100644
--- a/template/error.html
+++ b/template/error.html
@@ -8,8 +8,10 @@
<body>
<TMPL_IF NAME=NAME>
<p>This is the <span class="error"><TMPL_VAR NAME=NAME></span> page.
- You are not suppose to see this. If you think it is a bug, please
- report it to <a href="mailto:admin@fripost.org">admin@fripost.org</a>.
+ <TMPL_IF NAME=EMAIL>
+ You are not suppose to see this. If you think it is a bug, please
+ report it to <a href="mailto:<TMPL_VAR NAME=EMAIL>"><TMPL_VAR NAME=EMAIL></a>.
+ </TMPL_IF>
</p>
</TMPL_IF>
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 02:34:43 +0000