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/Panel/Interface.pm | 157 +++++++++++++++++++++++++++++---------- lib/Fripost/Panel/Login.pm | 9 +-- 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 +- 7 files changed, 324 insertions(+), 81 deletions(-) (limited to 'lib') diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm index d04fa3a..e4724d1 100644 --- a/lib/Fripost/Panel/Interface.pm +++ b/lib/Fripost/Panel/Interface.pm @@ -18,7 +18,8 @@ use Fripost::Schema::Util 'split_addr'; use Fripost::Password; use HTML::Entities 'encode_entities'; use URI::Escape::XS 'encodeURIComponent'; -use Net::IDN::Encode qw/email_to_unicode email_to_ascii/; +use Net::IDN::Encode qw/email_to_unicode email_to_ascii domain_to_ascii/; +use Encode; # This method is called right before the 'setup' method below. It @@ -38,8 +39,6 @@ sub ListDomains : StartRunmode { my $self = shift; my %CFG = $self->cfg; - my ($ul,$ud) = split_addr( $self->authen->username, -encode => 'unicode' ); - my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); my @domains = $fp->domain->search( -concat => "\n", -die => 403); $fp->done; @@ -49,6 +48,7 @@ sub ListDomains : StartRunmode { $template->param( $self->userInfo ); $template->param( domains => [ map { { &mkLink( domain => $_->{domain}) , isactive => $_->{isactive} + , ispending => $_->{ispending} , description => $_->{description} } } @domains ] ); @@ -62,10 +62,16 @@ sub ListLocals : Runmode { my $self = shift; my %CFG = $self->cfg; - my ($ul,$ud) = split_addr( $self->authen->username, -encode => 'unicode' ); my $d = ($self->split_path)[1]; my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); + my $q = $self->query; + if (defined $q->param('unlock') and $q->param('unlock') ne '') { + $fp->domain->unlock( $d, $q->param('unlock') ); + $fp->done; + return $self->redirect('../'); + } + # Query *the* matching domain my %domain = $fp->domain->get( $d, -die => 404 ); @@ -156,7 +162,6 @@ sub EditDomain : Runmode { my $self = shift; my %CFG = $self->cfg; - my ($ul,$ud) = split_addr( $self->authen->username, -encode => 'unicode' ); my $d = ($self->split_path)[1]; my $q = $self->query; @@ -169,11 +174,11 @@ sub EditDomain : Runmode { # Changes have been submitted: process them $error = $fp->domain->replace({ domain => $d, - isactive => $q->param('isactive'), - description => $q->param('description'), - catchalls => $q->param('catchalls'), - canAddAlias => $q->param('canAddAlias'), - canAddList => $q->param('canAddList') + isactive => $q->param('isactive') // 1, + description => $q->param('description') // undef, + catchalls => $q->param('catchalls') // undef, + canAddAlias => $q->param('canAddAlias') // undef, + canAddList => $q->param('canAddList') // undef }, -concat => "(\n|\x{0D}\x{0A})"); } my %domain = $fp->domain->get( $d, -die => 404 ); @@ -186,11 +191,11 @@ sub EditDomain : Runmode { , isPostmaster => $domain{permissions} eq 'p'); if ($error) { # Preserve the (incorrect) form - $template->param( isactive => $q->param('isactive') - , description => $q->param('description') - , catchalls => $q->param('catchalls') - , canAddAlias => $q->param('canAddAlias') - , canAddList => $q->param('canAddList') + $template->param( isactive => $q->param('isactive') // 1 + , description => $q->param('description') // undef + , catchalls => $q->param('catchalls') // undef + , canAddAlias => $q->param('canAddAlias') // undef + , canAddList => $q->param('canAddList') // undef , error => encode_entities ($error) ); } else { @@ -241,11 +246,11 @@ sub EditLocal : Runmode { my %entry; if ($t eq 'user') { $entry{user} = $l.'@'.$d; - $entry{forwards} = $q->param('forwards'); + $entry{forwards} = $q->param('forwards') // undef; - if ($q->param('oldpw') ne '' or - $q->param('newpw') ne '' or - $q->param('newpw2') ne '') { + if (($q->param('oldpw') // '') ne '' or + ($q->param('newpw') // '') ne '' or + ($q->param('newpw2') // '') ne '') { # If the user tries to change the password, we make her # bind first, to prevent an attacker from setting a # custom password and accessing the emails. @@ -263,13 +268,13 @@ sub EditLocal : Runmode { my $u = email_to_unicode($self->authen->username); $fp = Fripost::Schema::->auth( $u, - $q->param('oldpw'), + $q->param('oldpw') // '', %CFG, -die => "Wrong password (for ‘".$u."’)." ); }; $error = $@ || $fp->user->passwd( $entry{user}, - Fripost::Password::hash($q->param('newpw')) + Fripost::Password::hash($q->param('newpw') // '') ); $fp->done if defined $fp; } @@ -277,14 +282,14 @@ sub EditLocal : Runmode { } elsif ($t eq 'alias') { $entry{alias} = $l.'@'.$d; - $entry{maildrop} = $q->param('maildrop'); + $entry{maildrop} = $q->param('maildrop') // undef; } elsif ($t eq 'list') { $entry{list} = $l.'@'.$d; - $entry{transport} = $q->param('transport'); + $entry{transport} = $q->param('transport') // undef; } - $entry{isactive} = $q->param('isactive'); - $entry{description} = $q->param('description'); + $entry{isactive} = $q->param('isactive') // 1; + $entry{description} = $q->param('description') // undef; $error = $fp->$t->replace( \%entry, -concat => "(\n|\x{0D}\x{0A})") unless $error; } @@ -297,17 +302,17 @@ sub EditLocal : Runmode { # Preserve the (incorrect) form, except the passwords if ($t eq 'user') { $template->param( user => encode_entities($l) - , forwards => $q->param('forwards') ); + , forwards => $q->param('forwards') // undef ); } elsif ($t eq 'alias') { $template->param( alias => encode_entities($l) - , maildrop => $q->param('maildrop') ); + , maildrop => $q->param('maildrop') // undef ); } elsif ($t eq 'list') { $template->param( list => encode_entities($l) ); } - $template->param( isactive => $q->param('isactive') - , description => $q->param('description') ); + $template->param( isactive => $q->param('isactive') // 1 + , description => $q->param('description') // undef ); } else { %local = $fp->local->get ($l.'@'.$d, -die => 404, @@ -339,6 +344,82 @@ sub EditLocal : Runmode { return $template->output; } +sub AddDomain : Runmode { + my $self = shift; + my %CFG = $self->cfg; + + my $q = $self->query; + return $self->redirect('./') if defined $q->param('cancel'); # Cancellation + + my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); + my $domain = $q->param('domain'); + Encode::_utf8_on($domain) if defined $domain; + my $session_param; + $session_param = 'AddDomain-Postmasters-' . domain_to_ascii($domain) + if defined $domain; + + my $error; # Tells whether the change submission has failed. + if (defined $q->param('submit')) { + # Changes have been submitted: process them + + if (defined $q->param('postmaster') and defined $session_param) { + my @postmasters = split /\s*,\s*/, $self->session->param($session_param); + $error = "‘".$q->param('postmaster')."’ was not listed among the domain owners." + unless defined $self->session->param($session_param) + and grep { $q->param('postmaster') eq $_ } @postmasters; + } + + $error = $fp->domain->add({ + domain => $domain, + send_token_to => $q->param('postmaster') // undef, + isactive => $q->param('isactive') // 1, + description => $q->param('description') // undef, + catchalls => $q->param('catchalls') // undef }, + -concat => "(\n|\x{0D}\x{0A})", + '-dry-run' => not (defined $q->param('postmaster')), + -domainurl => $q->url.'/'.encode_entities($domain).'/' # TODO: try that in nginx + ) unless $error; + } + $fp->done; + + return $self->redirect('./') # Confirmation token sent, everything OK + if ($error // '') eq '' and defined $q->param('postmaster'); + + my $tmpl_file; + my @postmasters; + + if (($error // '') ne '' or not (defined $domain)) { + # Something went wrong, or the domain is unknown + $tmpl_file = 'add-domain-1.html'; + } + else { + $tmpl_file = 'add-domain-2.html'; + @postmasters = Fripost::Schema::Domain::->list_postmasters($domain); + } + + 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; + + $template->param( isactive => $q->param('isactive') // 1 + , description => $q->param('description') // undef + , catchalls => $q->param('catchalls') // undef + ); + $template->param( domain => encode_entities($domain) ) + if defined $domain; + + if (@postmasters) { + # Store it, to ensure the user doesn't send back a bogus email + $self->session->param( $session_param, join(',', @postmasters) ); + $self->session->flush; + + $template->param( postmasters => [ map {{postmaster => $_}} @postmasters ] ) + } + + return $template->output; +} + # In this Run Mode authenticated users can add users, aliases and lists # (if they have the permission). @@ -400,8 +481,8 @@ sub AddLocal : Runmode { # Unknown type return $self->redirect('./'); } - $entry{isactive} = $q->param('isactive'); - $entry{description} = $q->param('description'); + $entry{isactive} = $q->param('isactive') // 1; + $entry{description} = $q->param('description') // undef; unless ($error) { my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); @@ -417,23 +498,23 @@ sub AddLocal : Runmode { if ($error) { # Preserve the (incorrect) form, except the passwords if ($t eq 'user') { - $template->param( user => $q->param('user') - , forwards => $q->param('forwards') ); + $template->param( user => $q->param('user') // undef + , forwards => $q->param('forwards') // undef ); } elsif ($t eq 'alias') { - $template->param( alias => $q->param('alias') - , maildrop => $q->param('maildrop') ); + $template->param( alias => $q->param('alias') // undef + , maildrop => $q->param('maildrop') // undef ); } elsif ($t eq 'list') { - $template->param( list => $q->param('list') + $template->param( list => $q->param('list') // undef , isenc => $q->param('transport') eq 'schleuder' ); } else { # Unknown type return $self->redirect('./'); } - $template->param( isactive => $q->param('isactive') - , description => $q->param('description') + $template->param( isactive => $q->param('isactive') // 1 + , description => $q->param('description') // undef , error => encode_entities ($error) ); } else { diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm index 12b0294..b0906b3 100644 --- a/lib/Fripost/Panel/Login.pm +++ b/lib/Fripost/Panel/Login.pm @@ -105,13 +105,12 @@ sub setup { # /domain/{user,alias,list}/?query_url my ($null,$domain,$local,$crap) = $self->split_path; - return 'ListDomains' unless (defined $null) and $null eq ''; + return 'ListDomains' if (defined $null) and $null ne ''; unless (defined $domain and $domain ne '') { - # TODO -# if (defined $a) { -# return 'AddDomain' if $a eq 'add'; -# } + if (defined $a) { + return 'AddDomain' if $a eq 'add'; + } return 'ListDomains'; } 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