diff options
Diffstat (limited to 'lib/Fripost/Schema/Domain.pm')
| -rw-r--r-- | lib/Fripost/Schema/Domain.pm | 164 |
1 files changed, 162 insertions, 2 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}; } |