diff options
Diffstat (limited to 'lib/FPanel')
| -rw-r--r-- | lib/FPanel/Interface.pm | 690 | ||||
| -rw-r--r-- | lib/FPanel/Login.pm | 54 |
2 files changed, 296 insertions, 448 deletions
diff --git a/lib/FPanel/Interface.pm b/lib/FPanel/Interface.pm index 1c1f9ee..8087cb9 100644 --- a/lib/FPanel/Interface.pm +++ b/lib/FPanel/Interface.pm @@ -11,15 +11,16 @@ Interface.pm - =cut -use lib 'lib'; -use base 'FPanel::Login'; +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 @@ -32,253 +33,161 @@ sub cgiapp_init { sub ListDomains : StartRunmode { 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' - , attrs => [ qw/fvd description - fripostIsStatusActive - fripostCanCreateAlias - fripostCanCreateList - fripostOwner - fripostPostmaster/ ] - ); - die "403\n" if $domains->code; - $ldap->unbind; + 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 ); - $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d); - $template->param( DOMAINS => [ - map { { DOMAIN => $_->get_value('fvd') - # TODO: do we really want to list the permissions? - , PERMS => &list_perms_long($_, $authzDN) - , DESCRIPTION => join ("\n", $_->get_value('description')) - , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE' - }; - } - $domains->sorted('fvd') - ]); + $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 in the current +# 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 $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 $domainname = (split /\//, $ENV{PATH_INFO}, 3)[1]; + 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 $domains = $ldap->search( base => "fvd=$domainname,$suffix" - , scope => 'base' - , filter => 'objectClass=FripostVirtualDomain' - , deref => 'never' - , attrs => [ qw/fvd description - fripostIsStatusActive - fripostOptionalMaildrop - fripostCanCreateAlias - fripostCanCreateList - fripostOwner - fripostPostmaster/ ] - ); - die "404\n" if $domains->code; - # The following is not supposed to happen. - die "Error: Multiple matching entries found." if $domains->count > 1; - my $domain = $domains->pop_entry or die "404\n"; - - - # Query the mailboxes under the given domain - my $mailboxes = $ldap->search( base => "fvd=$domainname,$suffix" - , scope => 'one' - , filter => 'objectClass=FripostVirtualMailbox' - , deref => 'never' - , attrs => [ qw/fvu description - fripostIsStatusActive - fripostOptionalMaildrop - fripostMailboxQuota/ ] - ); - # We don't return 403 or 404 here, since it's not supposed to crash. - die $mailboxes->error if $mailboxes->code; - - # Query the aliases under the given domain - my $aliases = $ldap->search( base => "fvd=$domainname,$suffix" - , scope => 'one' - , filter => 'objectClass=FripostVirtualAlias' - , deref => 'never' - , attrs => [ qw/fva description - fripostIsStatusActive - fripostOwner - fripostMaildrop/ ] - ); - # We don't return 403 or 404 here, since it's not supposed to crash. - die $aliases->error if $aliases->code; - - # Query the lists under the given domain - my $lists = $ldap->search( base => "fvd=$domainname,$suffix" - , scope => 'one' - , filter => 'objectClass=FripostVirtualList' - , deref => 'never' - , attrs => [ qw/fvl description - fripostIsStatusActive - fripostOwner - fripostListManager/ ] - ); - # We don't return 403 or 404 here, since it's not supposed to crash. - die $lists->error if $lists->code; - - $ldap->unbind; - - # Get the perms of the autenticated user, so that we know where - # should put "add" and "edit" links (the LDAP ACLs back that up - # eventually, anyway). - my $perms = &list_perms($domain, $authzDN); + 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 ); - $template->param( DOMAIN => $domainname ); - $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d); - $template->param( DESCRIPTION => - join ("\n", $domain->get_value('description')) ); - $template->param( ISACTIVE => - $domain->get_value('fripostIsStatusActive') eq 'TRUE' ); + $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( CANEDIT => $perms =~ /[op]/ ); + $template->param( canEditDomain => $domain{permissions} =~ /[op]/ ); # Can the user add mailboxes? - $template->param( CANADDMAILBOX => $perms =~ /p/ ); + $template->param( canAddMailbox => $domain{permissions} =~ /p/ ); # Should we list mailboxes? - $template->param( LISTMAILBOXES => $mailboxes->count || $perms =~ /p/ ); - $template->param( MAILBOXES => [ - map { { USER => $_->get_value('fvu') - , DESCRIPTION => join ("\n", $_->get_value('description')) - , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE' - , FORWARDS => [ map { {FORWARD => $_} } - $_->get_value('fripostOptionalMaildrop') ] - , QUOTA => $_->get_value('fripostMailboxQuota') // '' + $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->sorted('fvu') + @mailboxes ]); # Can the user add aliases? - $template->param( CANADDALIAS => $perms =~ /[aop]/ ); + $template->param( canAddalias => $domain{permissions} =~ /[aop]/ ); # Should we list aliases? - $template->param( LISTALIASES => $aliases->count || $perms =~ /[aop]/ ); - $template->param( ALIASES => [ - map { { ALIAS => $_->get_value('fva') - , DESCRIPTION => join ("\n", $_->get_value('description')) - , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE' - # TODO: do we really want to list the owners? - , OWNERS => [ map { {OWNER => &dn2email($_)} } - $_->get_value('fripostOwner') ] - , DESTINATIONS => [ map { {DESTINATION => $_} } - $_->get_value('fripostMaildrop') ] + $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->sorted('fva') + @aliases ]); - $template->param( CATCHALLS => [ map { {CATCHALL => $_} } - $domain->get_value('fripostOptionalMaildrop') ] - # TODO: do we really want to list the owners? - , OWNERS => [ ( map { {OWNER => &dn2email($_)} } - $domain->get_value('fripostOwner') ) - , ( map { {OWNER => &dn2email($_)} } - $domain->get_value('fripostPostmaster') ) ] - , CAODD => $aliases->count % 2 ); + $template->param( catchalls => [ map { {catchall => $_} } + @{$domain{catchalls}} ] + , CAodd => not $#aliases % 2); # Can the user add lists? - $template->param( CANADDLIST => $perms =~ /[lop]/ ); + $template->param( canAddList => $domain{permissions} =~ /[lop]/ ); # Should we list lists? - $template->param( LISTLISTS => $lists->count || $perms =~ /[lop]/ ); - $template->param( LISTS => [ - map { { LIST => $_->get_value('fvl') - , DESCRIPTION => join ("\n", $_->get_value('description')) - , ISACTIVE => $_->get_value('fripostIsStatusActive') eq 'TRUE' - # TODO: do we really want to list the owners? - , OWNERS => [ map { {OWNER => &dn2email($_)} } - $_->get_value('fripostOwner') ] - , TRANSPORT => $_->get_value('fripostListManager') + $template->param( listLists => $#lists >= 0 || $domain{permissions} =~ /[lop]/ ); + $template->param( lists => [ + map { { list => $_->{list} + , description => join ("\n", @{$_->{description}}) + , isactive => $_->{isactive} + , transport => $_->{transport} }; } - $lists->sorted('fvl') + @lists ]); return $template->output; } # In this Run Mode authenticated users can edit the domain description -# and catchall, and toggle activation (if they have the permission). +# and catchalls, and toggle activation (if they have the permission). sub EditDomain : Runmode { 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 $domainname = (split /\//, $ENV{PATH_INFO}, 3)[1]; + 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 ); - my $error; # Tells wether the change submission has fails. - if (defined $self->query->param('submit')) { + my $q = $self->query; + my $error; # Tells whether the change submission has failed. + if (defined $q->param('submit')) { # Changes have been submitted: process them - my %changes; - my $q = $self->query; - $changes{fripostIsStatusActive} = $q->param('status') eq 'active' ? - 'TRUE' : 'FALSE'; - $changes{description} = [ split /\n/, $q->param('description') ]; - $changes{fripostOptionalMaildrop} = [ &form2EmailList($q->param('maildrop')) ]; - my $mesg = $ldap->modify( "fvd=$domainname,$suffix", - replace => \%changes ); - $error = $mesg->error if $mesg->code; + $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 $domains = $ldap->search( base => "fvd=$domainname,$suffix" - , scope => 'base' - , filter => 'objectClass=FripostVirtualDomain' - , deref => 'never' - ); - die "404\n" if $domains->code; - # The following is not supposed to happen. - die "Error: Multiple matching entries found." if $domains->count > 1; - my $domain = $domains->pop_entry or die "404\n"; - - $ldap->unbind; + 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 ); - $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d); - $template->param( DOMAIN => $domainname ); - $template->param( DESCRIPTION => - join ("\n",$domain->get_value('description')) ); - $template->param( MAILDROP => - join ("\n",$domain->get_value('fripostOptionalMaildrop')) ); - $template->param( ISACTIVE => $domain->get_value('fripostIsStatusActive') eq 'TRUE' ); - $template->param( NEWCHANGES => defined $self->query->param('submit') ); - $template->param( ERROR => $error ); + $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; } @@ -288,128 +197,125 @@ sub EditDomain : Runmode { sub EditLocal : Runmode { 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 ($ul,$ud) = split /\@/, $self->authen->username, 2; + my ($null,$d,$l,$crap) = split /\//, $ENV{PATH_INFO}, 4; + my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); - my ($null,$domainname,$localname,$crap) = split /\//, $ENV{PATH_INFO}, 4; - - my $error; # Tells wether the change submission has fails. - if (defined $self->query->param('submit')) { + my $q = $self->query; + my $error; # Tells whether the change submission has failed. + if (defined $q->param('submit')) { # Changes have been submitted: process them - my (%changes, $t2); - my $q = $self->query; - my $t = lc $q->param('t') // die "Error: Unknown type"; - + my $t = $q->param('t') // die "Undefined type"; + my %entry; if ($t eq 'mailbox') { - $t2 = 'fvu'; - if ($q->param('oldpassword') ne '' or - $q->param('newpassword') ne '' or - $q->param('newpassword2') ne '') { + $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('newpassword') eq $q->param('newpassword2')) { - my $ldap2 = Net::LDAP->new( $CFG{ldap_uri} ); - my $mesg = $ldap2->bind ( "fvu=$l,fvd=$d,$suffix", - password => $q->param('oldpassword') ); - if ($mesg->code) { - $error = "Wrong password (for ".$self->authen->username.")."; - } - else { - my $pw = $q->param('newpassword'); - # TODO: hash it. - $mesg = $ldap2->modify( "fvu=$localname,fvd=$domainname,$suffix", - replace => { userPassword => $pw } ); - $error = $mesg->error if $mesg->code; - } - $ldap2->unbind; + 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 { - $error = "Password don't match."; + 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; } } - - $changes{fripostOptionalMaildrop} = [ &form2EmailList($q->param('maildrop')) ]; } - elsif ($t eq 'alias') { - $t2 = 'fva'; - $changes{fripostMaildrop} = [ &form2EmailList($q->param('maildrop')) ]; + $entry{alias} = $l.'@'.$d; + $entry{maildrop} = $q->param('maildrop'); } - elsif ($t eq 'list') { - $t2 = 'fvl'; + $entry{list} = $l.'@'.$d; + $entry{transport} = $q->param('transport'); } - else { - die "Error: Unknown type"; - } - - # Global parameters - $changes{fripostIsStatusActive} = $q->param('status') eq 'active' ? - 'TRUE' : 'FALSE'; - $changes{description} = [ split /\n/, $q->param('description') ]; - - unless (defined $error) { - my $mesg = $ldap->modify( "$t2=$localname,fvd=$domainname,$suffix", - replace => \%changes ); - $error = $mesg->error if $mesg->code; + # 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; } - # Query *the* matching mailbox, alias or list. - my $locals = $ldap->search( base => "fvd=$domainname,$suffix" - , scope => 'one' - , filter => "(|(&(objectClass=FripostVirtualMailbox) - (fvu=$localname)) - (&(objectClass=FripostVirtualAlias) - (fva=$localname)) - (&(objectClass=FripostVirtualList) - (fvl=$localname)) - )" - , deref => 'never' - , attrs => [ qw/fvu description - fripostIsStatusActive - fripostOptionalMaildrop - fripostMailboxQuota - fva fripostMaildrop - fvl fripostListManager/ ] - ); - die "404\n" if $locals->code; - # The following is not supposed to happen. - die "Error: Multiple matching entries found." if $locals->count > 1; - my $local = $locals->pop_entry or die "404\n"; - - my $template; - if ($local->dn =~ /^fvu=/) { - $template = $self->load_tmpl( 'edit-mailbox.html', cache => 1, utf8 => 1 ); - $template->param( MAILBOX => $local->get_value('fvu') ); - $template->param( MAILDROP => - join ("\n",$local->get_value('fripostOptionalMaildrop')) ); - } - elsif ($local->dn =~ /^fva=/) { - $template = $self->load_tmpl( 'edit-alias.html', cache => 1, utf8 => 1 ); - $template->param( ALIAS => $local->get_value('fva') ); - $template->param( MAILDROP => - join ("\n",$local->get_value('fripostMaildrop')) ); + # 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, "‘‘") ); } - elsif ($local->dn =~ /^fvl=/) { - $template = $self->load_tmpl( 'edit-list.html', cache => 1, utf8 => 1 ); - $template->param( LIST => $local->get_value('fvl') ); + 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( URL => $self->query->url ); - $template->param( DOMAIN => $domainname ); - $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d); - $template->param( DESCRIPTION => - join ("\n",$local->get_value('description')) ); - $template->param( ISACTIVE => $local->get_value('fripostIsStatusActive') eq 'TRUE' ); - $template->param( NEWCHANGES => defined $self->query->param('submit') ); - $template->param( ERROR => $error ); + $template->param( newChanges => defined $self->query->param('submit') ); return $template->output; } @@ -419,143 +325,87 @@ sub EditLocal : Runmode { sub AddLocal : Runmode { 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 $domainname = (split /\//, $ENV{PATH_INFO}, 3)[1]; - my $localname; + my ($ul,$ud) = split /\@/, $self->authen->username, 2; + my $d = (split /\//, $ENV{PATH_INFO}, 3)[1]; - my $error; my $q = $self->query; - if (defined $self->query->param('submit')) { - # A new alias has been submitted: process it - my %new; - $localname = $q->param('alias'); - $new{objectClass} = 'FripostVirtualAlias'; - $new{fripostIsStatusActive} = $q->param('status') eq 'active' ? - 'TRUE' : 'FALSE'; - $new{fripostOwner} = $authzDN; - my @desc = split /\n/, $q->param('description'); - $new{description} = [ @desc ] if @desc; - my @maildrop = &form2EmailList($q->param('maildrop')); - $new{fripostMaildrop} = [ @maildrop ] if @maildrop; - - # TODO: more checks - my $mesg = $ldap->add( "fva=$localname,fvd=$domainname,$suffix", - attrs => [ %new ] ); - if ($mesg->code) { - $error = $mesg->error; + 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 { - return $self->redirect($q->url .'/'. $domainname .'/'); + # 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-alias.html', cache => 1, utf8 => 1 ); - $template->param( URL => $self->query->url ); - $template->param( DOMAIN => $domainname ); - $template->param( USER_LOCALPART => $l, USER_DOMAINPART => $d); - if (defined $error) { - $template->param( ALIAS => $q->param('alias') ); - $template->param( ISACTIVE => $q->param('status') eq 'active'); - $template->param( DESCRIPTION => join ("\n",$q->param('description')) ); - $template->param( MAILDROP => join ("\n",$q->param('maildrop')) ); - $template->param( ERROR => $error ); - } - return $template->output; -} - - -# This subroutine displays the access that the given DN has on the entry -# (long version). Possible values are : -# - "can create aliases" (a) -# - "can create lists" (l) -# - "can create aliases & lists" (al) -# - "owner" (o) -# - "postmaster" (p) -sub list_perms_long { - my $perms = &list_perms(@_); - - if ( $perms =~ /a/) { - return 'can create aliases & lists' if $perms =~ /l/; - return 'can create aliases'; - } - elsif ( $perms eq 'l' ) { - return 'can create lists'; - } - elsif ( $perms eq 'o' ) { - return 'owner'; - } - elsif ( $perms eq 'p' ) { - return 'postmaster'; + 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, "‘‘") ); } -} - -# This subroutine displays the access that the given DN has on the entry -# (short version). -sub list_perms { - my ($entry, $dn) = @_; - my $perms = ''; - - $perms .= 'a' - if grep { $dn eq $_ or (split /,/,$dn,2)[1] eq $_ } - $entry->get_value ('fripostCanCreateAlias'); - - $perms .= 'l' - if grep { $dn eq $_ or (split /,/,$dn,2)[1] eq $_ } - $entry->get_value ('fripostCanCreateList'); - - $perms = 'o' - if grep { $dn eq $_ } $entry->get_value('fripostOwner'); - - $perms = 'p' - if grep { $dn eq $_ } $entry->get_value('fripostPostmaster'); - - return $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; -} - -# Converts a DN into an email. -sub dn2email { - my $dn = shift; - $dn =~ /^fv[ual]=([^,]+),fvd=([^,]+),/ or return ''; - return "$1\@$2"; -} - - -# Produces an e-mail list from a form: split the new lines and strip out -# the spaces. -sub form2EmailList { - my $str = shift; - my @list; - foreach my $e (split /\n/, $str) { - $e =~ s/\s//g; - push @list, $e unless $e =~ /^$/; + else { + $template->param( isactive => 1 ); } - return @list; + return $template->output; } diff --git a/lib/FPanel/Login.pm b/lib/FPanel/Login.pm index 9be724a..3a44768 100644 --- a/lib/FPanel/Login.pm +++ b/lib/FPanel/Login.pm @@ -11,17 +11,18 @@ Login.pm - =cut -use base 'CGI::Application'; +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 qw/cfg/; +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 @@ -50,12 +51,12 @@ sub cgiapp_init { }, SEND_COOKIE => 1, ); - + # Configure authentication parameters $self->authen->config( DRIVER => [ 'Generic', sub { my ($u,$p) = @_; - my ($l,$d) = split /@/, $u, 2; + my ($l,$d) = split /\@/, $u, 2; unless (defined $d) { $CFG{default_realm} // return 0; @@ -72,10 +73,10 @@ sub cgiapp_init { STORE => 'Session', LOGIN_RUNMODE => 'login', RENDER_LOGIN => \&login_box, - LOGIN_SESSION_TIMEOUT => { IDLE_FOR => $CFG{timeout} }, + LOGIN_SESSION_TIMEOUT => { IDLE_FOR => $CFG{timeout} }, LOGOUT_RUNMODE => 'logout', ); - + # The run modes that require authentication $self->authen->protected_runmodes( qw /okay error_rm/ ); } @@ -86,6 +87,7 @@ sub cgiapp_init { # 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') ) ); @@ -121,11 +123,7 @@ sub setup { return 'ListLocals'; } - unless (defined $crap and $crap ne '') { - return 'EditLocal'; - } - - return 'error_404'; + return 'EditLocal'; }); } @@ -142,20 +140,20 @@ sub okay : Runmode { # This is the login Run Mode. sub login : Runmode { - my $self = shift; - + 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; } @@ -163,11 +161,11 @@ sub login : Runmode { # 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') ); - + $template->param( error => $self->authen->login_attempts ); + $template->param( destination => $self->query->param('destination') ); + return $template->output; } @@ -175,18 +173,18 @@ sub login_box { # 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); } @@ -207,17 +205,17 @@ sub error_rm : ErrorRunmode { elsif ($error eq '404' ) { $mesg = 'Not found' } - $template->param( CODE => $error ); - $template->param( MESSAGE => $mesg ); + $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 . '/'); + $template->param( email => $self->cfg('report_email') ); + $template->param( message => $error ); + $template->param( url => $self->query->url . '/'); return $template->output; } } |