aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Schema
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Schema')
-rw-r--r--lib/Fripost/Schema/Domain.pm164
-rw-r--r--lib/Fripost/Schema/List.pm7
-rw-r--r--lib/Fripost/Schema/Local.pm9
-rw-r--r--lib/Fripost/Schema/User.pm54
-rw-r--r--lib/Fripost/Schema/Util.pm5
5 files changed, 201 insertions, 38 deletions
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index e86822f..993d771 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -21,6 +21,13 @@ use Fripost::Schema::Util qw/concat get_perms explode must_attrs
email_valid canonical_dn/;
use Net::IDN::Encode qw/domain_to_ascii domain_to_unicode
email_to_ascii email_to_unicode/;
+use Encode;
+use Net::Domain::TLD 'tld_exists';
+use Net::DNS::Dig;
+use Net::Whois::Parser 'parse_whois';
+use String::Random;
+use Template;
+use MIME::Entity;
=head1 METHODS
@@ -44,7 +51,8 @@ sub search {
scope => 'one',
deref => 'never',
filter => 'objectClass=FripostVirtualDomain',
- attrs => [ qw/fvd description fripostIsStatusActive/ ]
+ attrs => [ qw/fvd description fripostIsStatusActive
+ fripostIsStatusPending/ ]
);
if ($domains->code) {
die $options{'-die'}."\n" if defined $options{'-die'};
@@ -52,6 +60,7 @@ sub search {
}
return map { { domain => domain_to_unicode($_->get_value('fvd'))
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
+ , ispending => defined $_->get_value('fripostIsStatusPending')
, description => concat($concat, $_->get_value('description'))
}
}
@@ -148,10 +157,158 @@ sub replace {
}
+sub list_postmasters {
+ my $self = shift;
+ my $hostname = shift;
+ my @postmasters;
+
+ my $tld = domain_to_ascii($hostname);
+ my $domain;
+ until ( tld_exists($tld) ) {
+ die "‘".$hostname."’ has an Invalid TLD.\n" unless $tld =~ /\./;
+ $domain = $tld;
+
+ my %mx = Net::DNS::Dig->new()->for( $domain, 'MX' )->rdata;
+ push @postmasters, 'postmaster@'.$domain # RFC 822, appendix C.6
+ if grep {!/\bfripost\.org$/} (values %mx);
+
+ $tld =~ s/^[^\.]*\.//;
+ }
+
+ my $info = parse_whois( domain => $domain );
+# die "Cannot WHOIS ‘".$domain."’.\n" unless defined $info;
+ # TODO: there is a bug with the encoding
+ if (defined $info) {
+ push @postmasters, @{$info->{emails}};
+ }
+
+ my %hash;
+ $hash{$_} = 1 for grep {email_valid($_ // '', -nodie => 1 )}
+ @postmasters;
+ sort keys %hash;
+}
+
sub add {
- die "TODO";
+ my $self = shift;
+ my $d = shift;
+ my %options = @_;
+
+ foreach (qw/description catchalls canAddAlias canAddList/) {
+ $d->{$_} = explode ($options{'-concat'}, $d->{$_})
+ if defined $d->{$_};
+ }
+
+ eval {
+ my $domain = $d->{domain};
+ Encode::_utf8_on($domain);
+ &_is_valid($d);
+
+ my $dn = canonical_dn( {fvd => $d->{domain}}, @{$self->suffix} );
+
+ my $mesg = $self->ldap->search(
+ base => $dn,
+ scope => 'base',
+ deref => 'never',
+ filter => 'objectClass=FripostVirtualDomain',
+ attrs => [] );
+ if ($mesg->code == 0) {
+ die "Domain ‘".$domain."’ already exists.\n";
+ }
+ elsif ($mesg->code != 32) {
+ die $mesg->error."\n";
+ }
+
+ return if $options{'-dry-run'};
+
+ my %attrs = ( objectClass => 'FripostVirtualDomain'
+ , fripostIsStatusActive => $d->{isactive} ?
+ 'TRUE' : 'FALSE'
+ );
+ $attrs{description} = $d->{description}
+ if defined $d->{description} and @{$d->{description}};
+ $attrs{fripostOptionalMaildrop} = $d->{catchalls}
+ if defined $d->{catchalls} and @{$d->{catchalls}};
+
+ if (defined $d->{owner}) {
+ $attrs{fripostOwner} = $self->_fvu2dn($d->{owner})
+ if $d->{owner} ne '';
+ }
+ else {
+ $attrs{fripostOwner} = $self->whoami;
+ }
+
+ my $token;
+ if (defined $d->{send_token_to}) {
+ $token = String::Random::->new->randregex('\w{32}');
+ $attrs{fripostIsStatusPending} = $token
+ }
+
+ $mesg = $self->ldap->add( $dn, attrs => [ %attrs ] );
+ die $mesg->error."\n" if $mesg->code;
+
+
+ if (defined $d->{send_token_to}) {
+ my $tt = Template->new({
+ INCLUDE_PATH => './templates', # TODO: use a config option
+ INTERPOLATE => 1,
+ }) or die $Template::ERROR."\n";
+
+ my $data;
+ my $vars = { domain => $domain, token => $token };
+ $vars->{unlockurl} = $options{'-domainurl'}.'?unlock='.$token
+ if defined $options{'-domainurl'};
+ $tt->process( 'new-domain.tt', $vars, \$data)
+ or die $tt->error."\n";
+
+ my $mail = MIME::Entity::->build(
+ From => 'Fripost Admin Panel <AdminWebPanel@fripost.org>',
+ To => $d->{send_token_to},
+ Subject => "Your new domain ".$d->{domain},
+ Encoding => 'quoted-printable',
+ Charset => 'utf-8',
+ Data => $data
+ );
+ $mail->send;
+ }
+
+ };
+ return $@;
+}
+
+sub unlock {
+ my $self = shift;
+ my $d = shift;
+ my $code = shift;
+
+ eval {
+ my $dn = canonical_dn({fvd => domain_to_ascii($d)}, @{$self->suffix});
+ my $domains = $self->ldap->search(
+ base => $dn,
+ scope => 'base',
+ deref => 'never',
+ filter => '(&(objectClass=FripostVirtualDomain)'.
+ '(fripostIsStatusPending=*))',
+ attrs => [ 'fripostIsStatusPending' ]
+ );
+ die $domains->error."\n" if $domains->code;
+
+ my $domain = $domains->pop_entry;
+ die "No such such domain: ‘".$d."’\n" unless defined $domain;
+
+ die "Wrong unlock code for ‘".$d."’\n"
+ unless $domain->get_value('fripostIsStatusPending') eq $code;
+ # TODO: a more secure option would be to add a 'userPassword'
+ # attribute to domains. We can bind as the domain to check the
+ # validity of the token and add an ACL rule to give =z rights on
+ # self and =0 for everyone else.
+
+ my $mesg = $self->ldap->modify( $dn, delete => 'fripostIsStatusPending' );
+ die $mesg->error."\n" if $mesg->code;
+ };
+ return $@;
}
+
=back
=head1 GLOBAL OPTIONS
@@ -179,6 +336,9 @@ sub _is_valid {
@{$d->{canAddAlias}} ];
$d->{canAddList} = [ map { email_valid($_, -prefix => 'fake') }
@{$d->{canAddList}} ];
+
+ $d->{send_token_to} = email_valid( $d->{send_token_to} )
+ if defined $d->{send_token_to};
}
diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm
index 18eeb29..2c4d1bc 100644
--- a/lib/Fripost/Schema/List.pm
+++ b/lib/Fripost/Schema/List.pm
@@ -42,7 +42,7 @@ sub search {
my $concat = $options{'-concat'};
my $filter = 'objectClass=FripostVirtualList';
- $filter = '(&('.$filter.')(!(fripostIsStatusPending=TRUE)))'
+ $filter = '(&('.$filter.')(!(fripostIsStatusPending=*)))'
if (defined $options{'-is_pending'}) and !$options{'-is_pending'};
my $lists = $self->ldap->search(
@@ -62,7 +62,7 @@ sub search {
, isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
, description => concat($concat, $_->get_value('description'))
, transport => $_->get_value('fripostListManager')
- , ispending => ($_->get_value('fripostIsStatusPending') // '') eq 'TRUE'
+ , ispending => defined $_->get_value('fripostIsStatusPending')
}
}
$lists->sorted('fvl')
@@ -144,8 +144,7 @@ sub add {
# Ask the list manager to create the list now.
my $member = email_valid( $self->_dn2fvu($self->whoami), -exact => 1);
- my $to = email_valid( 'mklist+'.$l->{transport}.'@fripost.org'
- , -exact => 1 );
+ my $to = email_valid( 'mklist+'.$l->{transport}.'@fripost.org' );
my $mail = MIME::Entity::->build(
From => 'Fripost Admin Panel <AdminWebPanel@fripost.org>',
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index 5ca833c..c342f23 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -141,10 +141,11 @@ sub exists {
foreach (@tests) {
my $dn = canonical_dn($_, {fvd => $d}, @{$self->suffix});
- my $mesg = $self->ldap->search( base => $dn,
- scope => 'base',
- deref => 'never',
- filter => 'objectClass=*'
+ my $mesg = $self->ldap->search( base => $dn
+ , scope => 'base'
+ , deref => 'never'
+ , filter => 'objectClass=*'
+ , attrs => []
);
return 1 unless $mesg->code; # 0 Success
unless ($mesg->code == 32) { # 32 No such object
diff --git a/lib/Fripost/Schema/User.pm b/lib/Fripost/Schema/User.pm
index 7d79e69..3b5cfca 100644
--- a/lib/Fripost/Schema/User.pm
+++ b/lib/Fripost/Schema/User.pm
@@ -72,23 +72,23 @@ Replace an existing account with the given one.
sub replace {
my $self = shift;
- my $m = shift;
+ my $u = shift;
my %options = @_;
foreach (qw/description forwards/) {
- $m->{$_} = explode ($options{'-concat'}, $m->{$_})
- if defined $m->{$_};
+ $u->{$_} = explode ($options{'-concat'}, $u->{$_})
+ if defined $u->{$_};
}
eval {
- my ($l,$d) = split_addr( $m->{user}, -encode => 'ascii' );
- &_is_valid($m);
+ my ($l,$d) = split_addr( $u->{user}, -encode => 'ascii' );
+ &_is_valid($u);
my $mesg = $self->ldap->modify(
canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
- replace => { fripostIsStatusActive => $m->{isactive} ?
+ replace => { fripostIsStatusActive => $u->{isactive} ?
'TRUE' : 'FALSE'
- , description => $m->{description}
- , fripostOptionalMaildrop => $m->{forwards}
+ , description => $u->{description}
+ , fripostOptionalMaildrop => $u->{forwards}
} );
die $mesg->error."\n" if $mesg->code;
};
@@ -126,30 +126,30 @@ Add the given account.
sub add {
my $self = shift;
- my $m = shift;
+ my $u = shift;
my %options = @_;
foreach (qw/description forwards/) {
- $m->{$_} = explode ($options{'-concat'}, $m->{$_})
- if defined $m->{$_};
+ $u->{$_} = explode ($options{'-concat'}, $u->{$_})
+ if defined $u->{$_};
}
eval {
- die "Missing user name\n" unless $m->{user} =~ /^.+\@.+$/;
- my ($l,$d) = split_addr( $m->{user}, -encode => 'ascii' );
- &_is_valid($m);
- die "‘".$m->{user}."’ already exists\n"
- if $self->local->exists($m->{user},%options);
+ die "Missing user name\n" unless $u->{user} =~ /^.+\@.+$/;
+ my ($l,$d) = split_addr( $u->{user}, -encode => 'ascii' );
+ &_is_valid($u);
+ die "‘".$u->{user}."’ already exists\n"
+ if $self->local->exists($u->{user},%options);
my %attrs = ( objectClass => 'FripostVirtualUser'
- , fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE'
- , userPassword => $m->{password}
+ , fripostIsStatusActive => $u->{isactive} ? 'TRUE' : 'FALSE'
+ , userPassword => $u->{password}
);
- $attrs{description} = $m->{description}
- if defined $m->{description} and @{$m->{description}};
- $attrs{fripostUserQuota} = $m->{quota} if defined $m->{quota};
- $attrs{fripostOptionalMaildrop} = $m->{forwards}
- if defined $m->{forwards} and @{$m->{forwards}};
+ $attrs{description} = $u->{description}
+ if defined $u->{description} and @{$u->{description}};
+ $attrs{fripostUserQuota} = $u->{quota} if defined $u->{quota};
+ $attrs{fripostOptionalMaildrop} = $u->{forwards}
+ if defined $u->{forwards} and @{$u->{forwards}};
my $mesg = $self->ldap->add(
canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ),
@@ -203,10 +203,10 @@ The B<-die> option, if present, overides LDAP croaks and errors.
# Ensure that the given user is valid.
sub _is_valid {
- my $m = shift;
- must_attrs( $m, qw/user isactive/ );
- $m->{user} = email_valid( $m->{user}, -exact => 1);
- $m->{forwards} = [ map { email_valid($_) } @{$m->{forwards}} ];
+ my $u = shift;
+ must_attrs( $u, qw/user isactive/ );
+ $u->{user} = email_valid( $u->{user}, -exact => 1);
+ $u->{forwards} = [ map { email_valid($_) } @{$u->{forwards}} ];
# TODO: match 'quota' against the Dovecot specifications
}
diff --git a/lib/Fripost/Schema/Util.pm b/lib/Fripost/Schema/Util.pm
index b26214b..2692421 100644
--- a/lib/Fripost/Schema/Util.pm
+++ b/lib/Fripost/Schema/Util.pm
@@ -116,7 +116,10 @@ sub email_valid {
-fqdn => 1 );
my $match = defined $addr;
$match &&= $addr eq $in if $options{'-exact'};
- die $mesg." ‘".$i."’\n" unless $match;
+ unless ($match) {
+ return if $options{'-nodie'};
+ die $mesg." ‘".$i."’\n";
+ }
$addr =~ s/^$options{'-prefix'}// if defined $options{'-prefix'};
return $addr;
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 03:15:42 +0000