From 35c4ad13a52bdcaab251358e4b7df99dd852c76d Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 20 Jan 2013 03:04:17 +0100 Subject: New domains. --- lib/Fripost/Schema/Domain.pm | 164 ++++++++++++++++++++++++++++++++++++++++++- lib/Fripost/Schema/List.pm | 7 +- lib/Fripost/Schema/Local.pm | 9 +-- lib/Fripost/Schema/User.pm | 54 +++++++------- lib/Fripost/Schema/Util.pm | 5 +- 5 files changed, 201 insertions(+), 38 deletions(-) (limited to 'lib/Fripost/Schema') 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 ', + 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 ', 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; } -- cgit v1.2.3