Use global configuration files.

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>