Finished the factoring of localpart-related methods.

2 files changed, 53 insertions, 44 deletions

diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index 7f7d770..b2ad686 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -15,7 +15,7 @@ use parent 'Fripost::Panel::Login';
 
 use Fripost::Schema;
 use Fripost::Schema::Util 'split_addr';
-use Fripost::Password;
+use Fripost::Schema::Password;
 use HTML::Entities 'encode_entities';
 use URI::Escape::XS 'encodeURIComponent';
 use Net::IDN::Encode qw/email_to_unicode email_to_ascii domain_to_ascii/;
@@ -72,7 +72,7 @@ sub AddDomain : Runmode {
     Encode::_utf8_on($domainname) if defined $domainname;
 
     my $session_param;
-    $session_param = 'AddDomain-owner-emails-'.domain_to_ascii($domainname)
+    $session_param = 'AddDomain-Owner-Emails-'.domain_to_ascii($domainname)
         if defined $domainname;
 
     my $error; # Tells whether the change submission has failed.
@@ -83,7 +83,8 @@ sub AddDomain : Runmode {
         if (defined $q->param('owner') and defined $session_param) {
             # Ensure that the user didn't spoof the domain ownership.
             my @owners = split "\0", $self->session->param($session_param);
-            $error = "‘".$q->param('owner')."’ was not listed among the domain owners."
+            $error = "‘".$q->param('owner').
+                     "’ was not listed among the domain owners"
                 unless defined $self->session->param($session_param)
                            and grep { $q->param('owner') eq $_ } @owners;
         }
@@ -107,14 +108,16 @@ sub AddDomain : Runmode {
 
     if (!$error and defined $domainname) {
         $tmpl_file = 'add-domain-2.html';
+        my @exclude = qw/fripost.org/;
         @owners = Fripost::Schema::Domain::->list_owner_emails
-                           ( $domainname, -error => \$error );
+                           ( $domainname, -error => \$error
+                           ,'-ignore-MX' => \@exclude );
         undef $tmpl_file if $error;
     }
     # Something went wrong, or the domain is unknown
     $tmpl_file //= 'add-domain-1.html';
 
-    my $template = $self->load_tmpl( $tmpl_file, cache => 1,
+    my $template = $self->load_tmpl( $tmpl_file, cache => 1
                                    , loop_context_vars => 1 );
     $template->param( $self->userInfo );
     $template->param( error => encode_entities ($error) ) if $error;
@@ -125,7 +128,8 @@ sub AddDomain : Runmode {
         # spoofed email.
         $self->session->param( $session_param, join("\0", @owners) );
         $self->session->flush;
-        $template->param( owners => [ map {{owner => $_}} @owners ] )
+        $template->param( owners =>
+            [ map {{owner => encode_entities $_}} @owners ] )
     }
 
     return $template->output;
@@ -158,7 +162,7 @@ sub EditDomain : Runmode {
                  // die "404\n";
     $fp->done;
 
-    my $template = $self->load_tmpl( 'edit-domain.html', cache => 1,
+    my $template = $self->load_tmpl( 'edit-domain.html', cache => 1
                                    , loop_context_vars => 1 );
     $template->param( $self->userInfo );
     $template->param( isPostmaster => $domain->{permissions} =~ /p/ );
@@ -194,11 +198,17 @@ sub ListLocals : Runmode {
     if (defined $q->param('unlock')) {
         # Unlock the domain, and come back to the home page.
         # Errors are thrown away.
-        $fp->domain->unlock( $domainname, $q->param('unlock'), -error => undef )
+        $fp->pending->unlock( $domainname, $q->param('unlock'), -error => undef )
             if $q->param('unlock') ne '';
         $fp->done;
         return $self->redirect('../');
     }
+    if (defined $q->param('a') and $q->param('a') eq 'delete') {
+        # Delete the domain.
+        $fp->local->delete($domainname, -error => undef );
+        $fp->done;
+        return $self->redirect('../');
+    }
 
     # Query *the* matching domain, or 404.
     my $domain = $fp->domain->search( $domainname, -filter => 'unlocked' )
@@ -207,8 +217,8 @@ sub ListLocals : Runmode {
     # Query the users, aliases and lists under the given domain.
     my @locals = $fp->local->search ( $domainname, sort => 1);
     $fp->done;
-    map { $_->{name} = (split_addr $_->{name})[0]; # Remove the domainpart
-          $_->{URL} = &mkURL('.', $_->{name}) }    # Add a URL
+    map { $_->{name}= (split_addr $_->{name})[0]; # Remove the domainpart
+          $_->{URL} = &mkURL('.', $_->{name})    }# Add a URL
         @locals;
 
     my @users   = grep { $_->{type} eq 'user' } @locals;
@@ -220,7 +230,7 @@ sub ListLocals : Runmode {
                            email_to_ascii($_->{name}.'@'.$domainname) }
         @lists;
 
-    my $template = $self->load_tmpl( 'list-locals.html', cache => 1,
+    my $template = $self->load_tmpl( 'list-locals.html', cache => 1
                                    , loop_context_vars => 1 );
 
     $template->param( $self->userInfo );
@@ -243,7 +253,7 @@ sub ListLocals : Runmode {
 
     # Can the user add aliases?
     $template->param( canAddalias => $domain->{permissions} =~ /[aop]/ );
-    $template->param( listCanAddAlias => [ map { {item => encode_entities($_)} }
+    $template->param( listCanAddAlias => [ map { {item => encode_entities $_} }
                                                @{$domain->{canAddAlias}} ] )
         if $domain->{permissions} =~ /[op]/;
     # Should we list aliases?
@@ -255,7 +265,7 @@ sub ListLocals : Runmode {
 
     # Can the user add lists?
     $template->param( canAddList => $domain->{permissions} =~ /[lop]/ );
-    $template->param( listCanAddList => [ map { {item => encode_entities($_)} }
+    $template->param( listCanAddList => [ map { {item => encode_entities $_} }
                                               @{$domain->{canAddList}} ] )
         if $domain->{permissions} =~ /[op]/;
     # Should we list lists?
@@ -282,7 +292,7 @@ sub AddLocal : Runmode {
 
     # Get the domain name from the URL.
     my $domainname = ($self->split_path)[1];
-    my $t = $q->param('t') // return $self->redirect('./');
+    my $t = $q->param('t') or return $self->redirect('./');
     return $self->redirect('./') unless grep { $t eq $_ } qw/user alias list/;
     my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
 
@@ -305,10 +315,12 @@ sub AddLocal : Runmode {
                         ." characters long.";
             }
             else {
-                $local->{password} = Fripost::Password::hash($q->param('password'));
+                $local->{password} =
+                    Fripost::Schema::Password::hash($q->param('password'));
             }
             # TODO: inherit the user quota from the postmaster's?
         }
+        # Password needs special care
         $local->{password} = $q->param('password') if $t eq 'list';
 
         $rest{gpg} = { use_agent => 0
@@ -334,11 +346,14 @@ sub AddLocal : Runmode {
     $template->param( $self->userInfo
                     , domainname => encode_entities($domainname)
                     , &fill_HTML_template_from_query ($q));
-    $template->param( transport =>
-            [ { item => 'mailman', selected => $q->param('transport') eq 'mailman', name => 'GNU Mailman' }
-            , { item => 'schleuder', selected => $q->param('transport') eq 'schleuder', name => 'Schleuder' }
-            ]) # TODO ugly
-        if $t eq 'list' and defined $q->param('transport');
+    $template->param( transport => [
+        map { { item => $_
+              , name => ucfirst $_
+              , selected => $q->param('transport') eq $_
+            } }
+            (keys %Fripost::Schema::Local::list_commands)
+        ] )
+        if $t eq 'list';
     $template->param( error => encode_entities ($error) ) if $error;
     return $template->output;
 }
@@ -361,8 +376,6 @@ sub EditLocal : Runmode {
     # Search for *the* matching user, alias or list.
     $fp->domain->search ($domainname, -filter => 'unlocked', -count => 1)
         or die "404\n";
-    my $local = $fp->local->search ($name, -filter => 'unlocked')
-        or die "404\n";
 
     my $error; # Tells whether the change submission has failed.
     if (defined $q->param('a') and $q->param('a') eq 'delete') {
@@ -373,13 +386,15 @@ sub EditLocal : Runmode {
             return $self->redirect('../');
         }
     }
-    $fp->done;
+    my $local = $fp->local->search ($name, -filter => 'unlocked')
+        or die "404\n";
 
+    my $t = $local->{type};
     if (defined $q->param('submit')) {
         # Changes have been submitted: process them
         my $local = &parse_CGI_query($q);
-        $local->{type} = $q->param('t');
         $local->{name} = $name;
+        $local->{type} = $t;
         my %rest;
 
         if ($q->param('password') || $q->param('password2')) {
@@ -397,26 +412,18 @@ sub EditLocal : Runmode {
                 $local->{password} = Fripost::Password::hash($q->param('password'));
             }
         }
+        $fp->local->replace($local, -error => \$error);
     }
+    $fp->done;
 
     # Do not send passwords back to the sender.
     $q->delete(qw/password password2/);
 
-    my $t = $local->{type};
     my $template = $self->load_tmpl( "edit-$t.html", cache => 1 );
     $template->param( $self->userInfo
                     , localpart => encode_entities($localname)
                     , domainpart => encode_entities($domainname) );
-
-    if ($error) {
-        # Preserve the (incorrect) form, except the passwords
-        $template->param( &fill_HTML_template_from_query ($q) );
-    }
-    else {
-        $template->param( &fill_HTML_template_from_entry ($local,
-                -hide => [qw/quota transport/]) );
-    }
-    # TODO: submit
+    $template->param( &fill_HTML_template_from_query ($q) );
     my $news = (defined $q->param('submit') or
                (defined $q->param('a') and $q->param('a') eq 'delete'));
     $template->param( newChanges => $news );
@@ -471,7 +478,7 @@ sub fill_HTML_template_from_entry {
         }
         elsif (grep {$key eq $_} (qw/URL list_URL transport/,
                                   @single_valued_keys)) {
-            $vars{$key} = $entry->{$key};
+            $vars{$key} = encode_entities($entry->{$key});
         }
         elsif (grep {$key eq $_} @multi_valued_keys) {
             my @array = map { encode_entities ($_) } @{$entry->{$key}};
@@ -492,9 +499,11 @@ sub fill_HTML_template_from_query {
     my %rest = @_;
     my %vars;
 
-    $params{$_} = encode_entities ($rest{$_}) for keys %rest;
+    $params{$_} = $rest{$_} for keys %rest;
     foreach my $key (keys %params) {
-        $vars{$key} = $params{$key} // undef
+        next unless defined $params{$key};
+        Encode::_utf8_on($params{$key});
+        $vars{$key} = encode_entities($params{$key})
             if grep { $key eq $_ } ('name', @single_valued_keys, @multi_valued_keys);
     }
     $vars{isActive} //= 1;
@@ -508,8 +517,9 @@ sub parse_CGI_query {
 
     $params{$_} = $rest{$_} for keys %rest;
     foreach my $key (keys %params) {
+        next unless defined $params{$key};
         Encode::_utf8_on($params{$key}) if defined $params{$key};
-        if ($key eq 'name') {
+        if (grep { $key eq $_ } qw/name transport/) {
             $entry->{$key} = $params{$key};
         }
         elsif (grep {$key eq $_} @single_valued_keys) {
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index 22a870a..3b2846a 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -19,7 +19,6 @@ use CGI::Application::Plugin::Redirect;
 use CGI::Application::Plugin::ConfigAuto 'cfg';
 
 use Fripost::Schema;
-use Fripost::Schema::Util 'split_addr';
 
 use HTML::Entities 'encode_entities';
 use URI::Escape::XS 'decodeURIComponent';
@@ -60,8 +59,8 @@ sub cgiapp_init {
                 $CFG{default_realm} // return 0;
                 $u .= '@'.$CFG{default_realm};
             }
-            my $fp = Fripost::Schema::->auth($u, $p, %CFG, -die => 0);
-            return 0 unless defined $fp;
+            my $fp = Fripost::Schema::->auth($u, $p, %CFG, -error => undef)
+                         // return 0;
             $fp->done;
             return $u;
         } ],
@@ -223,8 +222,8 @@ sub split_path {
     $script =~ s@/$@@s; # Strip the trailing '/' off the script name
 
     my $uri = $self->query->request_uri;
-    $uri =~ s/^$script//s;  # Strip the facing CGI script name
-    $uri =~ s/\?.*//s;      # Strip the query
+    $uri =~ s/^\Q$script\E\b//s; # Strip the facing CGI script name
+    $uri =~ s/\?.*//s;           # Strip the query
 
     map { my $x = decodeURIComponent($_); Encode::_utf8_on($x); $x }
         (split '/', $uri);