From ec17f0ce71a233025768a54b4a1beae34e2b8a45 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 9 Sep 2012 21:01:45 +0200 Subject: =?UTF-8?q?lib/FPanel/=20=E2=86=92=20lib/Fripost/Panel/?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/FPanel/Interface.pm | 437 ----------------------------------------- lib/FPanel/Login.pm | 241 ----------------------- lib/Fripost/Panel/Interface.pm | 437 +++++++++++++++++++++++++++++++++++++++++ lib/Fripost/Panel/Login.pm | 241 +++++++++++++++++++++++ 4 files changed, 678 insertions(+), 678 deletions(-) delete mode 100644 lib/FPanel/Interface.pm delete mode 100644 lib/FPanel/Login.pm create mode 100644 lib/Fripost/Panel/Interface.pm create mode 100644 lib/Fripost/Panel/Login.pm (limited to 'lib') diff --git a/lib/FPanel/Interface.pm b/lib/FPanel/Interface.pm deleted file mode 100644 index 053e1a2..0000000 --- a/lib/FPanel/Interface.pm +++ /dev/null @@ -1,437 +0,0 @@ -package FPanel::Interface; - -use 5.010_000; -use strict; -use warnings; -use utf8; - -=head1 NAME - -Interface.pm - - -=cut - -use Fripost::Schema; -use Fripost::Password; -use parent 'FPanel::Login'; -use HTML::Entities; - - -# 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' ); -} - - -# This is the first page seen by authenticated users. It lists the known -# domains. -sub ListDomains : StartRunmode { - my $self = shift; - my %CFG = $self->cfg; - - my ($ul,$ud) = split /\@/, $self->authen->username, 2; - - my $fp = Fripost::Schema->SASLauth( $self->authen->username, %CFG ); - my @domains = $fp->domain->search( -concat => "\n", -die => 403); - $fp->done; - - my $template = $self->load_tmpl( 'list-domains.html', cache => 1, utf8 => 1 - , loop_context_vars => 1 - , global_vars => 1 ); - $template->param( url => $self->query->url - , user_localpart => $ul - , user_domainpart => $ud - , domains => [ @domains ] - ); - return $template->output; -} - - -# This Run Mode lists the known mailboxes, aliases and lists under the current -# domain. -sub ListLocals : Runmode { - my $self = shift; - my %CFG = $self->cfg; - - my ($ul,$ud) = split /\@/, $self->authen->username, 2; - my $d = (split /\//, $ENV{PATH_INFO}, 3)[1]; - my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); - - # Query *the* matching domain - my %domain = $fp->domain->get( $d, -die => 404 ); - - # Query the mailboxes, aliases and lists under the given domain. We - # don't die with a HTTP error code here, as it is not supposed to - # crash. - my @mailboxes = $fp->mailbox->search( $d ); - my @aliases = $fp->alias->search( $d ); - my @lists = $fp->list->search( $d ); - - $fp->done; - - my $template = $self->load_tmpl( 'list-locals.html', cache => 1, utf8 => 1 - , loop_context_vars => 1 - , global_vars => 1 ); - - $template->param( url => $self->query->url - , user_localpart => $ul - , user_domainpart => $ud - ); - $template->param( domain => $domain{domain} - , isactive => $domain{isactive} - , description => join ("\n", @{$domain{description}}) ); - # Can the user edit the domain (change description, toggle - # activation, modify catchalls?) - $template->param( canEditDomain => $domain{permissions} =~ /[op]/ ); - - # Can the user add mailboxes? - $template->param( canAddMailbox => $domain{permissions} =~ /p/ ); - # Should we list mailboxes? - $template->param( listMailboxes => $#mailboxes >= 0 || - $domain{permissions} =~ /p/ ); - $template->param( mailboxes => [ - map { { user => $_->{user} - , description => join ("\n", @{$_->{description}}) - , isactive => $_->{isactive} - , forwards => [ map { {forward => $_} } @{$_->{forwards}} ] - , quota => $_->{quota} - }; - } - @mailboxes - ]); - - # Can the user add aliases? - $template->param( canAddalias => $domain{permissions} =~ /[aop]/ ); - # Should we list aliases? - $template->param( listAliases => $#aliases >= 0 || - $domain{permissions} =~ /[aop]/ ); - $template->param( aliases => [ - map { { alias => $_->{alias} - , description => join ("\n", @{$_->{description}}) - , isactive => $_->{isactive} - , destinations => [ map { {destination => $_} } - @{$_->{maildrop}} ] - }; - } - @aliases - ]); - $template->param( catchalls => [ map { {catchall => $_} } - @{$domain{catchalls}} ] - , CAodd => not $#aliases % 2); - - # Can the user add lists? - $template->param( canAddList => $domain{permissions} =~ /[lop]/ ); - # Should we list lists? - $template->param( listLists => $#lists >= 0 || $domain{permissions} =~ /[lop]/ ); - $template->param( lists => [ - map { { list => $_->{list} - , description => join ("\n", @{$_->{description}}) - , isactive => $_->{isactive} - , transport => $_->{transport} - }; - } - @lists - ]); - return $template->output; -} - - -# In this Run Mode authenticated users can edit the domain description -# and catchalls, and toggle activation (if they have the permission). -sub EditDomain : Runmode { - my $self = shift; - my %CFG = $self->cfg; - - my ($ul,$ud) = split /\@/, $self->authen->username, 2; - my $d = (split /\//, $ENV{PATH_INFO}, 3)[1]; - - my $q = $self->query; - return $self->redirect($q->url .'/') if defined $q->param('cancel'); - - my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); - - my $error; # Tells whether the change submission has failed. - if (defined $q->param('submit')) { - # Changes have been submitted: process them - $error = $fp->domain->replace({ - domain => $d, - isactive => $q->param('isactive'), - description => $q->param('description'), - catchalls => $q->param('catchalls') - }, -concat => "(\n|\x{0D}\x{0A})"); - } - my %domain = $fp->domain->get( $d, -die => 404 ); - $fp->done; - - my $template = $self->load_tmpl( 'edit-domain.html', cache => 1, utf8 => 1 - , loop_context_vars => 1 - , global_vars => 1 ); - $template->param( url => $self->query->url - , user_localpart => $ul - , user_domainpart => $ud - , domain => $d - ); - if ($error) { - # Preserve the (incorrect) form - $template->param( isactive => $q->param('isactive') - , description => $q->param('description') - , catchalls => $q->param('catchalls') - , error => encode_entities ($error, "‘‘") ); - } - else { - $template->param( isactive => $domain{isactive} - , description => join ("\x{0D}\x{0A}", - @{$domain{description}}) - , catchalls => join ("\x{0D}\x{0A}", - @{$domain{catchalls}}) ); - } - $template->param( newChanges => defined $self->query->param('submit') ); - return $template->output; -} - - -# In this Run Mode authenticated users can edit the entry (if they have -# the permission). -sub EditLocal : Runmode { - my $self = shift; - my %CFG = $self->cfg; - - my ($ul,$ud) = split /\@/, $self->authen->username, 2; - my ($null,$d,$l,$crap) = split /\//, $ENV{PATH_INFO}, 4; - - my $q = $self->query; - return $self->redirect($q->url.'/'.$d.'/') if defined $q->param('cancel'); - - my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); - - my $error; # Tells whether the change submission has failed. - if (defined $q->param('submit')) { - # Changes have been submitted: process them - my $t = $q->param('t') // die "Undefined type"; - my %entry; - if ($t eq 'mailbox') { - $entry{user} = $l.'@'.$d; - $entry{forwards} = $q->param('forwards'); - - if ($q->param('oldpw') ne '' or - $q->param('newpw') ne '' or - $q->param('newpw2') ne '') { - # If the user tries to change the password, we make her - # bind first, to prevent an attacker from setting a - # custom password and accessing the emails. - if ($q->param('newpw') ne $q->param('newpw2')) { - $error = "Passwords do not match"; - } - elsif (length $q->param('newpw') < $CFG{password_min_length}) { - $error = "Password should be at least " - .$CFG{password_min_length} - ." characters long."; - } - else { - my $fp; - eval { - $fp = Fripost::Schema::->auth( - $self->authen->username, - $q->param('oldpw'), - ldap_uri => $CFG{ldap_uri}, - ldap_suffix => $CFG{ldap_suffix}, - -die => "Wrong password (for ‘" - .$self->authen->username."‘)." ); - }; - $error = $@ || $fp->mailbox->passwd( - $entry{user}, - Fripost::Password::hash($q->param('newpw')) - ); - $fp->done if defined $fp; - } - } - } - elsif ($t eq 'alias') { - $entry{alias} = $l.'@'.$d; - $entry{maildrop} = $q->param('maildrop'); - } - elsif ($t eq 'list') { - $entry{list} = $l.'@'.$d; - $entry{transport} = $q->param('transport'); - } - else { - # Unknown type - return $self->redirect($q->url .'/'. $d .'/'); - } - $entry{isactive} = $q->param('isactive'); - $entry{description} = $q->param('description'); - $error = $fp->$t->replace( \%entry, -concat => "(\n|\x{0D}\x{0A})") - unless $error; - } - - # Search for *the* matching mailbox, alias or list. - my %local = $fp->local->get ($l, $d, -die => 404, - -concat => "\x{0D}\x{0A}"); - $fp->done; - - my $template = $self->load_tmpl( "edit-$local{type}.html", - cache => 1, utf8 => 1 ); - $template->param( url => $self->query->url - , user_localpart => $ul - , user_domainpart => $ud - , domain => $d - ); - if ($error) { - # Preserve the (incorrect) form, except the passwords - if ($local{type} eq 'mailbox') { - $template->param( user => $l - , forwards => $q->param('forwards') ); - } - elsif ($local{type} eq 'alias') { - $template->param( alias => $l - , maildrop => $q->param('maildrop') ); - } - elsif ($local{type} eq 'list') { - $template->param( list => $l ); - } - else { - # Unknown type - return $self->redirect($q->url.'/'.$d.'/'); - } - $template->param( isactive => $q->param('isactive') - , description => $q->param('description') - , error => encode_entities ($error, "‘‘") ); - } - else { - if ($local{type} eq 'mailbox') { - $template->param( user => $local{user} - , forwards => $local{forwards} ); - } - elsif ($local{type} eq 'alias') { - $template->param( alias => $local{alias} - , maildrop => $local{maildrop} ); - } - elsif ($local{type} eq 'list') { - $template->param( list => $local{list} ); - } - else { - # Unknown type - return $self->redirect($q->url.'/'.$d.'/'); - } - $template->param( isactive => $local{isactive} - , description => $local{description} ); - } - $template->param( newChanges => defined $self->query->param('submit') ); - return $template->output; -} - - -# In this Run Mode authenticated users can add mailboxes, aliases and -# lists (if they have the permission). -sub AddLocal : Runmode { - my $self = shift; - my %CFG = $self->cfg; - - my ($ul,$ud) = split /\@/, $self->authen->username, 2; - my $d = (split /\//, $ENV{PATH_INFO}, 3)[1]; - - my $q = $self->query; - return $self->redirect($q->url.'/'.$d.'/') if defined $q->param('cancel'); - - my $t = $q->param('t') // die "Undefined type"; - my $error; # Tells whether the change submission has failed. - if (defined $q->param('submit')) { - # Changes have been submitted: process them - my %entry; - if ($t eq 'mailbox') { - $entry{user} = $q->param('user').'@'.$d; - $entry{forwards} = $q->param('forwards'); - if ($q->param('password') ne $q->param('password2')) { - $error = "Passwords do not match"; - } - elsif (length $q->param('password') < $CFG{password_min_length}) { - $error = "Password should be at least " - .$CFG{password_min_length} - ." characters long."; - } - else { - $entry{password} = Fripost::Password::hash($q->param('password')); - } - # TODO: inherit the quota from the postmaster's? - } - elsif ($t eq 'alias') { - $entry{alias} = $q->param('alias').'@'.$d; - $entry{maildrop} = $q->param('maildrop'); - } - elsif ($t eq 'list') { - $entry{list} = $q->param('list').'@'.$d; - $entry{transport} = $q->param('transport'); - } - else { - # Unknown type - return $self->redirect($q->url.'/'.$d.'/'); - } - $entry{isactive} = $q->param('isactive'); - $entry{description} = $q->param('description'); - - unless ($error) { - my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); - $error = $fp->$t->add( \%entry, -concat => "(\n|\x{0D}\x{0A})"); - $fp->done; - return $self->redirect($q->url.'/'.$d.'/') unless $error; - } - } - - my $template = $self->load_tmpl( "add-$t.html", cache => 1, utf8 => 1 ); - $template->param( url => $self->query->url - , user_localpart => $ul - , user_domainpart => $ud - , domain => $d - ); - if ($error) { - # Preserve the (incorrect) form, except the passwords - if ($t eq 'mailbox') { - $template->param( user => $q->param('user') - , forwards => $q->param('forwards') ); - } - elsif ($t eq 'alias') { - $template->param( alias => $q->param('alias') - , maildrop => $q->param('maildrop') ); - } - elsif ($t eq 'list') { - $template->param( list => $q->param('list') - , isenc => $q->param('transport') eq 'schleuder' ); - } - else { - # Unknown type - return $self->redirect($q->url.'/'.$d.'/'); - } - $template->param( isactive => $q->param('isactive') - , description => $q->param('description') - , error => encode_entities ($error, "‘‘") ); - } - else { - $template->param( isactive => 1 ); - } - return $template->output; -} - - -=head1 AUTHOR - -Guilhem Moulin C<< >> - -=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__ 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<< >> - -=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__ diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm new file mode 100644 index 0000000..b636861 --- /dev/null +++ b/lib/Fripost/Panel/Interface.pm @@ -0,0 +1,437 @@ +package Fripost::Panel::Interface; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +Interface.pm - + +=cut + +use parent 'Fripost::Panel::Login'; +use Fripost::Schema; +use Fripost::Password; +use HTML::Entities; + + +# 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' ); +} + + +# This is the first page seen by authenticated users. It lists the known +# domains. +sub ListDomains : StartRunmode { + my $self = shift; + my %CFG = $self->cfg; + + my ($ul,$ud) = split /\@/, $self->authen->username, 2; + + my $fp = Fripost::Schema->SASLauth( $self->authen->username, %CFG ); + my @domains = $fp->domain->search( -concat => "\n", -die => 403); + $fp->done; + + my $template = $self->load_tmpl( 'list-domains.html', cache => 1, utf8 => 1 + , loop_context_vars => 1 + , global_vars => 1 ); + $template->param( url => $self->query->url + , user_localpart => $ul + , user_domainpart => $ud + , domains => [ @domains ] + ); + return $template->output; +} + + +# This Run Mode lists the known mailboxes, aliases and lists under the current +# domain. +sub ListLocals : Runmode { + my $self = shift; + my %CFG = $self->cfg; + + my ($ul,$ud) = split /\@/, $self->authen->username, 2; + my $d = (split /\//, $ENV{PATH_INFO}, 3)[1]; + my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); + + # Query *the* matching domain + my %domain = $fp->domain->get( $d, -die => 404 ); + + # Query the mailboxes, aliases and lists under the given domain. We + # don't die with a HTTP error code here, as it is not supposed to + # crash. + my @mailboxes = $fp->mailbox->search( $d ); + my @aliases = $fp->alias->search( $d ); + my @lists = $fp->list->search( $d ); + + $fp->done; + + my $template = $self->load_tmpl( 'list-locals.html', cache => 1, utf8 => 1 + , loop_context_vars => 1 + , global_vars => 1 ); + + $template->param( url => $self->query->url + , user_localpart => $ul + , user_domainpart => $ud + ); + $template->param( domain => $domain{domain} + , isactive => $domain{isactive} + , description => join ("\n", @{$domain{description}}) ); + # Can the user edit the domain (change description, toggle + # activation, modify catchalls?) + $template->param( canEditDomain => $domain{permissions} =~ /[op]/ ); + + # Can the user add mailboxes? + $template->param( canAddMailbox => $domain{permissions} =~ /p/ ); + # Should we list mailboxes? + $template->param( listMailboxes => $#mailboxes >= 0 || + $domain{permissions} =~ /p/ ); + $template->param( mailboxes => [ + map { { user => $_->{user} + , description => join ("\n", @{$_->{description}}) + , isactive => $_->{isactive} + , forwards => [ map { {forward => $_} } @{$_->{forwards}} ] + , quota => $_->{quota} + }; + } + @mailboxes + ]); + + # Can the user add aliases? + $template->param( canAddalias => $domain{permissions} =~ /[aop]/ ); + # Should we list aliases? + $template->param( listAliases => $#aliases >= 0 || + $domain{permissions} =~ /[aop]/ ); + $template->param( aliases => [ + map { { alias => $_->{alias} + , description => join ("\n", @{$_->{description}}) + , isactive => $_->{isactive} + , destinations => [ map { {destination => $_} } + @{$_->{maildrop}} ] + }; + } + @aliases + ]); + $template->param( catchalls => [ map { {catchall => $_} } + @{$domain{catchalls}} ] + , CAodd => not $#aliases % 2); + + # Can the user add lists? + $template->param( canAddList => $domain{permissions} =~ /[lop]/ ); + # Should we list lists? + $template->param( listLists => $#lists >= 0 || $domain{permissions} =~ /[lop]/ ); + $template->param( lists => [ + map { { list => $_->{list} + , description => join ("\n", @{$_->{description}}) + , isactive => $_->{isactive} + , transport => $_->{transport} + }; + } + @lists + ]); + return $template->output; +} + + +# In this Run Mode authenticated users can edit the domain description +# and catchalls, and toggle activation (if they have the permission). +sub EditDomain : Runmode { + my $self = shift; + my %CFG = $self->cfg; + + my ($ul,$ud) = split /\@/, $self->authen->username, 2; + my $d = (split /\//, $ENV{PATH_INFO}, 3)[1]; + + my $q = $self->query; + return $self->redirect($q->url .'/') if defined $q->param('cancel'); + + my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); + + my $error; # Tells whether the change submission has failed. + if (defined $q->param('submit')) { + # Changes have been submitted: process them + $error = $fp->domain->replace({ + domain => $d, + isactive => $q->param('isactive'), + description => $q->param('description'), + catchalls => $q->param('catchalls') + }, -concat => "(\n|\x{0D}\x{0A})"); + } + my %domain = $fp->domain->get( $d, -die => 404 ); + $fp->done; + + my $template = $self->load_tmpl( 'edit-domain.html', cache => 1, utf8 => 1 + , loop_context_vars => 1 + , global_vars => 1 ); + $template->param( url => $self->query->url + , user_localpart => $ul + , user_domainpart => $ud + , domain => $d + ); + if ($error) { + # Preserve the (incorrect) form + $template->param( isactive => $q->param('isactive') + , description => $q->param('description') + , catchalls => $q->param('catchalls') + , error => encode_entities ($error, "‘‘") ); + } + else { + $template->param( isactive => $domain{isactive} + , description => join ("\x{0D}\x{0A}", + @{$domain{description}}) + , catchalls => join ("\x{0D}\x{0A}", + @{$domain{catchalls}}) ); + } + $template->param( newChanges => defined $self->query->param('submit') ); + return $template->output; +} + + +# In this Run Mode authenticated users can edit the entry (if they have +# the permission). +sub EditLocal : Runmode { + my $self = shift; + my %CFG = $self->cfg; + + my ($ul,$ud) = split /\@/, $self->authen->username, 2; + my ($null,$d,$l,$crap) = split /\//, $ENV{PATH_INFO}, 4; + + my $q = $self->query; + return $self->redirect($q->url.'/'.$d.'/') if defined $q->param('cancel'); + + my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); + + my $error; # Tells whether the change submission has failed. + if (defined $q->param('submit')) { + # Changes have been submitted: process them + my $t = $q->param('t') // die "Undefined type"; + my %entry; + if ($t eq 'mailbox') { + $entry{user} = $l.'@'.$d; + $entry{forwards} = $q->param('forwards'); + + if ($q->param('oldpw') ne '' or + $q->param('newpw') ne '' or + $q->param('newpw2') ne '') { + # If the user tries to change the password, we make her + # bind first, to prevent an attacker from setting a + # custom password and accessing the emails. + if ($q->param('newpw') ne $q->param('newpw2')) { + $error = "Passwords do not match"; + } + elsif (length $q->param('newpw') < $CFG{password_min_length}) { + $error = "Password should be at least " + .$CFG{password_min_length} + ." characters long."; + } + else { + my $fp; + eval { + $fp = Fripost::Schema::->auth( + $self->authen->username, + $q->param('oldpw'), + ldap_uri => $CFG{ldap_uri}, + ldap_suffix => $CFG{ldap_suffix}, + -die => "Wrong password (for ‘" + .$self->authen->username."‘)." ); + }; + $error = $@ || $fp->mailbox->passwd( + $entry{user}, + Fripost::Password::hash($q->param('newpw')) + ); + $fp->done if defined $fp; + } + } + } + elsif ($t eq 'alias') { + $entry{alias} = $l.'@'.$d; + $entry{maildrop} = $q->param('maildrop'); + } + elsif ($t eq 'list') { + $entry{list} = $l.'@'.$d; + $entry{transport} = $q->param('transport'); + } + else { + # Unknown type + return $self->redirect($q->url .'/'. $d .'/'); + } + $entry{isactive} = $q->param('isactive'); + $entry{description} = $q->param('description'); + $error = $fp->$t->replace( \%entry, -concat => "(\n|\x{0D}\x{0A})") + unless $error; + } + + # Search for *the* matching mailbox, alias or list. + my %local = $fp->local->get ($l, $d, -die => 404, + -concat => "\x{0D}\x{0A}"); + $fp->done; + + my $template = $self->load_tmpl( "edit-$local{type}.html", + cache => 1, utf8 => 1 ); + $template->param( url => $self->query->url + , user_localpart => $ul + , user_domainpart => $ud + , domain => $d + ); + if ($error) { + # Preserve the (incorrect) form, except the passwords + if ($local{type} eq 'mailbox') { + $template->param( user => $l + , forwards => $q->param('forwards') ); + } + elsif ($local{type} eq 'alias') { + $template->param( alias => $l + , maildrop => $q->param('maildrop') ); + } + elsif ($local{type} eq 'list') { + $template->param( list => $l ); + } + else { + # Unknown type + return $self->redirect($q->url.'/'.$d.'/'); + } + $template->param( isactive => $q->param('isactive') + , description => $q->param('description') + , error => encode_entities ($error, "‘‘") ); + } + else { + if ($local{type} eq 'mailbox') { + $template->param( user => $local{user} + , forwards => $local{forwards} ); + } + elsif ($local{type} eq 'alias') { + $template->param( alias => $local{alias} + , maildrop => $local{maildrop} ); + } + elsif ($local{type} eq 'list') { + $template->param( list => $local{list} ); + } + else { + # Unknown type + return $self->redirect($q->url.'/'.$d.'/'); + } + $template->param( isactive => $local{isactive} + , description => $local{description} ); + } + $template->param( newChanges => defined $self->query->param('submit') ); + return $template->output; +} + + +# In this Run Mode authenticated users can add mailboxes, aliases and +# lists (if they have the permission). +sub AddLocal : Runmode { + my $self = shift; + my %CFG = $self->cfg; + + my ($ul,$ud) = split /\@/, $self->authen->username, 2; + my $d = (split /\//, $ENV{PATH_INFO}, 3)[1]; + + my $q = $self->query; + return $self->redirect($q->url.'/'.$d.'/') if defined $q->param('cancel'); + + my $t = $q->param('t') // die "Undefined type"; + my $error; # Tells whether the change submission has failed. + if (defined $q->param('submit')) { + # Changes have been submitted: process them + my %entry; + if ($t eq 'mailbox') { + $entry{user} = $q->param('user').'@'.$d; + $entry{forwards} = $q->param('forwards'); + if ($q->param('password') ne $q->param('password2')) { + $error = "Passwords do not match"; + } + elsif (length $q->param('password') < $CFG{password_min_length}) { + $error = "Password should be at least " + .$CFG{password_min_length} + ." characters long."; + } + else { + $entry{password} = Fripost::Password::hash($q->param('password')); + } + # TODO: inherit the quota from the postmaster's? + } + elsif ($t eq 'alias') { + $entry{alias} = $q->param('alias').'@'.$d; + $entry{maildrop} = $q->param('maildrop'); + } + elsif ($t eq 'list') { + $entry{list} = $q->param('list').'@'.$d; + $entry{transport} = $q->param('transport'); + } + else { + # Unknown type + return $self->redirect($q->url.'/'.$d.'/'); + } + $entry{isactive} = $q->param('isactive'); + $entry{description} = $q->param('description'); + + unless ($error) { + my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); + $error = $fp->$t->add( \%entry, -concat => "(\n|\x{0D}\x{0A})"); + $fp->done; + return $self->redirect($q->url.'/'.$d.'/') unless $error; + } + } + + my $template = $self->load_tmpl( "add-$t.html", cache => 1, utf8 => 1 ); + $template->param( url => $self->query->url + , user_localpart => $ul + , user_domainpart => $ud + , domain => $d + ); + if ($error) { + # Preserve the (incorrect) form, except the passwords + if ($t eq 'mailbox') { + $template->param( user => $q->param('user') + , forwards => $q->param('forwards') ); + } + elsif ($t eq 'alias') { + $template->param( alias => $q->param('alias') + , maildrop => $q->param('maildrop') ); + } + elsif ($t eq 'list') { + $template->param( list => $q->param('list') + , isenc => $q->param('transport') eq 'schleuder' ); + } + else { + # Unknown type + return $self->redirect($q->url.'/'.$d.'/'); + } + $template->param( isactive => $q->param('isactive') + , description => $q->param('description') + , error => encode_entities ($error, "‘‘") ); + } + else { + $template->param( isactive => 1 ); + } + return $template->output; +} + + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=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__ diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm new file mode 100644 index 0000000..8dcfd2b --- /dev/null +++ b/lib/Fripost/Panel/Login.pm @@ -0,0 +1,241 @@ +package Fripost::Panel::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<< >> + +=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__ -- cgit v1.2.3