From 465f8ed1b317afb1c7aefde04e53118a19be1a18 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@fripost.org>
Date: Tue, 29 Jan 2013 21:44:24 +0100
Subject: Finished the factoring of localpart-related methods.

---
 lib/Fripost/Schema/Util.pm | 99 +++++++++++-----------------------------------
 1 file changed, 22 insertions(+), 77 deletions(-)

(limited to 'lib/Fripost/Schema/Util.pm')

diff --git a/lib/Fripost/Schema/Util.pm b/lib/Fripost/Schema/Util.pm
index b3439cc..3ab6d68 100644
--- a/lib/Fripost/Schema/Util.pm
+++ b/lib/Fripost/Schema/Util.pm
@@ -12,10 +12,9 @@ use warnings;
 use utf8;
 
 use Exporter 'import';
-our @EXPORT_OK = qw /concat get_perms explode
-                     must_attrs domain_valid email_valid split_addr dn2mail
+our @EXPORT_OK = qw /mandatory_attrs domain_valid email_valid split_addr dn2mail
                      canonical_dn ldap_explode_dn ldap_error ldap_and_filter
-                     ldap_clean_entry
+                     ldap_clean_entry escape_filter_nostar
                      assert ldap_assert_absent softdie/;
 use Email::Valid;
 use Net::IDN::Encode qw/domain_to_unicode email_to_unicode
@@ -24,70 +23,11 @@ use Net::LDAP::Util;
 use Encode;
 
 
-# Let the first argument, if defined, intersperse the other arguments.
-sub concat {
-    my $concat = shift;
-
-    if (defined $concat) {
-        return join ($concat, @_);
-    }
-    else {
-        return [ @_ ];
-    }
-}
-
-# The reverse of 'concat': takes a single line, and split it along
-# "concat", if defined. Returns an array reference in any case.
-sub explode {
-    my $concat = shift;
-
-    my $out;
-    if (defined $concat) {
-        $out = [ split /$concat/, $_[0] ];
-    }
-    else {
-        $out = [ @_ ];
-    }
-    [ grep { !/^\s*$/ } @$out ];
-}
-
-
-# This subroutine displays the access that the given DN has on the entry.
-# Possible values are :
-# - '': no rights
-# - a:  can create aliases
-# - l:  can create lists
-# - al: can create aliases & lists
-# - o:  owner
-# - p:  postmaster
-sub get_perms {
-    my ($entry, $dn) = @_;
-    my @dn = @{ldap_explode_dn ($dn)};
-    shift @dn;
-    my $dn2 = canonical_dn (@dn);
-    my $perms = '';
-
-    $perms .= 'a'
-        if grep { $dn eq $_  or  $dn2 eq $_ }
-                $entry->get_value ('fripostCanAddAlias');
-
-    $perms .= 'l'
-        if grep { $dn eq $_  or  $dn2 eq $_ }
-                $entry->get_value ('fripostCanAddList');
-
-    $perms = 'o'
-        if grep { $dn eq $_ } $entry->get_value('fripostOwner');
-
-    $perms = 'p'
-        if grep { $dn eq $_ } $entry->get_value('fripostPostmaster');
-
-    return $perms;
-}
 
 
 # "&must_att $h qw/a b c .../" ensures that attributes a b c... are all
 # defined in the hash reference.
-sub must_attrs {
+sub mandatory_attrs {
     my $h = shift;
     foreach (@_) {
         die 'Missing value: ‘'.$_."’\n"
@@ -97,8 +37,7 @@ sub must_attrs {
 }
 
 
-# Ensure that the first argument is a valid email. Can also be used to
-# check the validity of domains using the '-prefix' option.
+# Ensure that the first argument is a valid email.
 # '-exact' forces the input to be a bare email, ("name <email>" is not
 # allowed).
 sub email_valid {
@@ -106,9 +45,8 @@ sub email_valid {
     my %options = @_;
 
     my $i = $in;
-    $i =~ s/^[^<>]+\s<([^>]+)>/$1/;
+    $in = 'fake'.$i if defined $options{'-allow-empty-local'} and $i =~ /^\@/;
     my $mesg = $options{'-error'} // "Invalid e-mail";
-    $in = $options{'-prefix'}.$i if defined $options{'-prefix'};
     Encode::_utf8_on($in);
     Encode::_utf8_on($i);
 
@@ -116,32 +54,34 @@ sub email_valid {
     eval {
         $in = Net::IDN::Encode::email_to_ascii($in);
         $addr = Email::Valid::->address( -address => $in,
-                                            -tldcheck => 1,
-                                            -fqdn => 1 );
+                                         -tldcheck => 1,
+                                         -fqdn => 1 );
         $match = defined $addr;
-        $match &&= $addr eq $in if $options{'-exact'};
+        $match &&= $addr eq $in
+            if $options{'-exact'} or $options{'-allow-empty-local'};
     };
     if ($@ || !$match) {
       return if $options{'-nodie'};
       die $mesg." ‘".$i."’\n";
     }
-    $addr =~ s/^$options{'-prefix'}// if defined $options{'-prefix'};
+    $addr =~ s/^fake\@/\@/ if defined $options{'-allow-empty-local'};
     return $addr;
 }
 
 sub domain_valid {
-    my $domainname = shift;
-    Encode::_utf8_on($domainname);
+    my $in = shift;
+    Encode::_utf8_on($in);
     my %options = @_;
 
-    my $in = 'fake@'.Net::IDN::Encode::domain_to_ascii($domainname);
-    my $addr = Email::Valid::->address( -address => $in
+    my $domainname = Net::IDN::Encode::domain_to_ascii($in);
+    my $fake = 'fake@'.$domainname;
+    my $addr = Email::Valid::->address( -address => $fake
                                       , -tldcheck => 1
                                       , -fqdn => 1 );
-    unless (defined $addr and $addr eq $in) {
+    unless (defined $addr and $addr eq $fake) {
         return if $options{'-nodie'};
         my $mesg = $options{'-die'} // "Invalid domain";
-        die $mesg." ‘".$domainname."’\n";
+        die $mesg." ‘".$in."’\n";
     }
     return $domainname;
 }
@@ -305,6 +245,11 @@ sub ldap_assert_absent {
            undef
 }
 
+
+sub escape_filter_nostar {
+  join '*', Net::LDAP::Util::escape_filter_value (split '\*', shift);
+}
+
 =head1 AUTHOR
 
 Guilhem Moulin C<< <guilhem at fripost.org> >>
-- 
cgit v1.2.3