From c70ea95c7e2e07cccbff9b7cce26e7bb506d1db6 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 18 Jan 2013 21:21:17 +0100 Subject: Factorized split_addr. --- lib/Fripost/Panel/Interface.pm | 15 +++++++++------ lib/Fripost/Panel/Login.pm | 9 ++++++--- lib/Fripost/Schema.pm | 13 +++++++------ lib/Fripost/Schema/Alias.pm | 11 ++++++----- lib/Fripost/Schema/Domain.pm | 2 +- lib/Fripost/Schema/List.pm | 15 ++++++++------- lib/Fripost/Schema/Local.pm | 9 +++++---- lib/Fripost/Schema/Misc.pm | 24 ++++++++++++++++++++++-- lib/Fripost/Schema/User.pm | 13 +++++++------ misc/w3c-validator.pl | 6 +++--- 10 files changed, 74 insertions(+), 43 deletions(-) diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm index 02f3f4b..18b9a48 100644 --- a/lib/Fripost/Panel/Interface.pm +++ b/lib/Fripost/Panel/Interface.pm @@ -14,6 +14,7 @@ Interface.pm - use parent 'Fripost::Panel::Login'; use Fripost::Schema; +use Fripost::Schema::Misc 'split_addr'; use Fripost::Password; use HTML::Entities 'encode_entities'; use URI::Escape::XS 'encodeURIComponent'; @@ -37,7 +38,7 @@ sub ListDomains : StartRunmode { my $self = shift; my %CFG = $self->cfg; - my ($ul,$ud) = split /\@/, email_to_unicode($self->authen->username), 2; + my ($ul,$ud) = split_addr( $self->authen->username, -encoding => 'unicode' ); my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); my @domains = $fp->domain->search( -concat => "\n", -die => 403); @@ -61,7 +62,7 @@ sub ListLocals : Runmode { my $self = shift; my %CFG = $self->cfg; - my ($ul,$ud) = split /\@/, email_to_unicode($self->authen->username), 2; + my ($ul,$ud) = split_addr( $self->authen->username, -encoding => 'unicode' ); my $d = ($self->split_path)[1]; my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG ); @@ -155,7 +156,7 @@ sub EditDomain : Runmode { my $self = shift; my %CFG = $self->cfg; - my ($ul,$ud) = split /\@/, email_to_unicode($self->authen->username), 2; + my ($ul,$ud) = split_addr( $self->authen->username, -encoding => 'unicode' ); my $d = ($self->split_path)[1]; my $q = $self->query; @@ -457,11 +458,13 @@ sub mkLink { sub userInfo { my $self = shift; - my ($l,$d) = split /\@/, email_to_unicode($self->authen->username), 2; + my ($l,$d) = split_addr( $self->authen->username, -encoding => 'unicode' ); + my $root = $ENV{SCRIPT_NAME} // $self->cfg->{'cgi-bin'} // ''; + $root =~ s@/$@@s; ( user_localpart => encode_entities($l) , user_domainpart => encode_entities($d) - , userURI => &mkURL ($ENV{SCRIPT_NAME}, $d, $l) + , userURI => &mkURL ($root, $d, $l) ) } @@ -479,7 +482,7 @@ Guilhem Moulin C<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm index ccb4ca7..ef8474c 100644 --- a/lib/Fripost/Panel/Login.pm +++ b/lib/Fripost/Panel/Login.pm @@ -20,6 +20,7 @@ use CGI::Application::Plugin::Redirect; use CGI::Application::Plugin::ConfigAuto 'cfg'; use Fripost::Schema; +use Fripost::Schema::Misc 'split_addr'; use HTML::Entities 'encode_entities'; use URI::Escape::XS 'decodeURIComponent'; use Net::IDN::Encode 'email_to_ascii'; @@ -56,7 +57,7 @@ sub cgiapp_init { $self->authen->config( DRIVER => [ 'Generic', sub { my ($u,$p) = @_; - my $d = (split /\@/, $u, 2)[1]; + my $d = (split_addr($u))[1]; unless (defined $d) { $CFG{default_realm} // return 0; @@ -227,7 +228,9 @@ sub split_path { my $self = shift; my %options = @_; - my $script = $ENV{SCRIPT_NAME} // ''; + my $script = $ENV{SCRIPT_NAME} // $self->cfg->{'cgi-bin'} // ''; + $script =~ s@/$@@s; + my $uri = $self->query->request_uri; $uri =~ s/^$script//s; $uri =~ s/\?.*//s; @@ -243,7 +246,7 @@ Guilhem Moulin C<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm index 909a92c..9d6f4cb 100644 --- a/lib/Fripost/Schema.pm +++ b/lib/Fripost/Schema.pm @@ -19,7 +19,8 @@ use warnings; use utf8; use Net::LDAP; -use Authen::SASL 'Cyrus'; +use Authen::SASL; +use Fripost::Schema::Misc 'split_addr'; use Fripost::Schema::Domain; use Fripost::Schema::User; use Fripost::Schema::Alias; @@ -43,7 +44,7 @@ authentication ID. sub SASLauth { my $class = shift; - my ($l,$d) = split /\@/, shift, 2; + my ($l,$d) = split_addr(shift); my %cfg = @_; my $self = bless {}, $class; @@ -86,7 +87,7 @@ sub auth { $self->whoami( $cfg{ldap_bind_dn} ); } else { - my ($l,$d) = split /\@/, $id, 2; + my ($l,$d) = split_addr($id); $self->whoami( "fvu=$l,fvd=$d,".$self->suffix ); } @@ -202,7 +203,7 @@ Guilhem Moulin C<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE @@ -222,9 +223,9 @@ sub _dn2email { sub _email2dn { my $self = shift; my $email = shift; - my ($l,$d) = split /\@/, $email, 2; + my ($l,$d) = split_addr($email); die "Wrong usage: of _email2dn: $email" unless defined $d; - + my $dn = "fvd=$d,".$self->suffix; $dn = "fvu=$l,".$dn if $l ne ''; return $dn; diff --git a/lib/Fripost/Schema/Alias.pm b/lib/Fripost/Schema/Alias.pm index 7d729f0..f575b4c 100644 --- a/lib/Fripost/Schema/Alias.pm +++ b/lib/Fripost/Schema/Alias.pm @@ -17,7 +17,8 @@ use warnings; use utf8; use parent 'Fripost::Schema'; -use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/; +use Fripost::Schema::Misc qw/concat explode must_attrs email_valid + split_addr/; use Net::IDN::Encode qw/domain_to_ascii email_to_ascii email_to_unicode/; @@ -79,7 +80,7 @@ sub replace { } eval { - my ($l,$d) = split /\@/, email_to_ascii($a->{alias}), 2; + my ($l,$d) = split_addr( $a->{alias}, -encoding => 'ascii' ); &_is_valid($a); my $mesg = $self->ldap->modify( "fva=$l,fvd=$d,".$self->suffix, @@ -112,7 +113,7 @@ sub add { eval { die "Missing alias name\n" unless $a->{alias} =~ /^.+\@.+$/; - my ($l,$d) = split /\@/, email_to_ascii($a->{alias}), 2; + my ($l,$d) = split_addr( $a->{alias}, -encoding => 'ascii' ); &_is_valid($a); die "‘".$a->{alias}."’ already exists\n" if $self->local->exists($a->{alias},%options); @@ -144,7 +145,7 @@ Delete the given alias. sub delete { my $self = shift; - my ($l,$d) = split /\@/, email_to_ascii(shift), 2; + my ($l,$d) = split_addr( shift, -encoding => 'ascii' ); my %options = @_; my $mesg = $self->ldap->delete( "fva=$l,fvd=$d,".$self->suffix ); @@ -186,7 +187,7 @@ Guilhem Moulin C<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm index 80810e5..0e1de49 100644 --- a/lib/Fripost/Schema/Domain.pm +++ b/lib/Fripost/Schema/Domain.pm @@ -196,7 +196,7 @@ Guilhem Moulin C<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE diff --git a/lib/Fripost/Schema/List.pm b/lib/Fripost/Schema/List.pm index ad06b50..e6605f0 100644 --- a/lib/Fripost/Schema/List.pm +++ b/lib/Fripost/Schema/List.pm @@ -17,7 +17,8 @@ use warnings; use utf8; use parent 'Fripost::Schema'; -use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/; +use Fripost::Schema::Misc qw/concat explode must_attrs email_valid + split_addr/; use Net::IDN::Encode qw/domain_to_ascii email_to_ascii email_to_unicode/; use Mail::GnuPG; @@ -116,7 +117,7 @@ sub add { eval { die "Missing list name\n" unless $l->{list} =~ /^.+\@.+$/; - my ($l2,$d) = split /\@/, email_to_ascii($l->{list}), 2; + my ($l2,$d) = split_addr ( $l->{list}, -encoding => 'ascii' ); must_attrs( $l, 'transport' ); &_is_valid($l); die "‘".$l->{list}."’ already exists\n" @@ -171,7 +172,7 @@ the ListCreator entity, and the list is not known by the list manager. sub is_pending { my $self = shift; - my ($l,$d) = split /\@/, email_to_ascii(shift), 2; + my ($l,$d) = split_addr( shift, -encoding => 'ascii' ); my %options = @_; my $mesg = $self->ldap->search( @@ -202,7 +203,7 @@ Add the lists commands, and remove the pending status. sub add_commands { my $self = shift; - my ($l,$d) = split /\@/, email_to_ascii(shift), 2; + my ($l,$d) = split_addr( shift, -encoding => 'ascii' ); my $cmds = shift; my %options = @_; @@ -234,7 +235,7 @@ disk, but merely delete the list entry in the LDAP directory. sub delete { my $self = shift; - my ($l,$d) = split /\@/, email_to_ascii(shift), 2; + my ($l,$d) = split_addr( shift, -encoding => 'ascii' ); my %options = @_; my $mesg = $self->ldap->delete( "fvl=$l,fvd=$d,".$self->suffix ); @@ -267,7 +268,7 @@ sub _is_valid { must_attrs( $l, qw/list isactive/ ); $l->{list} = email_valid( $l->{list}, -exact => 1 ); - my ($l2,$d) = split /\@/, $l->{list}, 2; + my ($l2,$d) = split_addr( $l->{list} ); foreach ( qw/admin bounces confirm join leave owner request subscribe unsubscribe bounce sendkey/ ){ die "Invalid list name: ‘".$l->{list}."’\n" if $l2 =~ /-$_$/; } @@ -286,7 +287,7 @@ Guilhem Moulin C<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm index 400b4e5..e2e7a4b 100644 --- a/lib/Fripost/Schema/Local.pm +++ b/lib/Fripost/Schema/Local.pm @@ -17,8 +17,9 @@ use warnings; use utf8; use parent 'Fripost::Schema'; -use Fripost::Schema::Misc 'concat'; +use Fripost::Schema::Misc qw/concat split_addr/; use Net::IDN::Encode qw/email_to_ascii email_to_unicode/; +use Net::LDAP::Util 'escape_filter_value'; =head1 METHODS @@ -39,7 +40,7 @@ sub get { my %options = @_; my $concat = $options{'-concat'}; - my ($l,$d) = split /\@/, email_to_ascii($loc), 2; + my ($l,$d) = split_addr( $loc, -encoding => 'ascii' ); my $locals = $self->ldap->search( base => "fvd=$d,".$self->suffix, scope => 'one', @@ -147,7 +148,7 @@ sub exists { die $options{'-die'}."\n" if defined $options{'-die'}; die $mesg->error."\n"; } - + } return 0; } @@ -171,7 +172,7 @@ Guilhem Moulin C<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE diff --git a/lib/Fripost/Schema/Misc.pm b/lib/Fripost/Schema/Misc.pm index 114e01b..9ae8cdc 100644 --- a/lib/Fripost/Schema/Misc.pm +++ b/lib/Fripost/Schema/Misc.pm @@ -13,7 +13,8 @@ use utf8; use Exporter 'import'; our @EXPORT_OK = qw /concat get_perms explode - must_attrs email_valid/; + must_attrs email_valid + split_addr/; use Email::Valid; use Net::IDN::Encode; use Encode; @@ -115,6 +116,25 @@ sub email_valid { return $addr; } +sub split_addr { + my $addr = shift; + my %options = @_; + + if (defined $options{'-encoding'}) { + if ($options{'-encoding'} eq 'ascii') { + $addr = Net::IDN::Encode::email_to_ascii($addr); + } + elsif ($options{'-encoding'} eq 'unicode') { + $addr = Net::IDN::Encode::email_to_unicode($addr); + } + else { + die "Unknown encoding: ". $options{'-encoding'}; + } + } + + split /\@/, $addr, 2; +} + =head1 AUTHOR @@ -122,7 +142,7 @@ Guilhem Moulin C<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE diff --git a/lib/Fripost/Schema/User.pm b/lib/Fripost/Schema/User.pm index 11f5e28..c1d559a 100644 --- a/lib/Fripost/Schema/User.pm +++ b/lib/Fripost/Schema/User.pm @@ -17,7 +17,8 @@ use warnings; use utf8; use parent 'Fripost::Schema'; -use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/; +use Fripost::Schema::Misc qw/concat explode must_attrs email_valid + split_addr/; use Net::IDN::Encode qw/domain_to_ascii email_to_ascii email_to_unicode/; @@ -81,7 +82,7 @@ sub replace { } eval { - my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2; + my ($l,$d) = split_addr( $m->{user}, -encoding => 'ascii' ); &_is_valid($m); my $mesg = $self->ldap->modify( "fvu=$l,fvd=$d,".$self->suffix, @@ -105,7 +106,7 @@ may want to hash it before hand. sub passwd { my $self = shift; - my ($l,$d) = split /\@/, email_to_ascii(shift), 2; + my ($l,$d) = split_addr( shift, -encoding => 'ascii' ); my $pw = shift; my %options = @_; @@ -135,7 +136,7 @@ sub add { eval { die "Missing user name\n" unless $m->{user} =~ /^.+\@.+$/; - my ($l,$d) = split /\@/, email_to_ascii($m->{user}), 2; + my ($l,$d) = split_addr( $m->{user}, -encoding => 'ascii' ); &_is_valid($m); die "‘".$m->{user}."’ already exists\n" if $self->local->exists($m->{user},%options); @@ -170,7 +171,7 @@ but merely delete its entry in the LDAP directory. sub delete { my $self = shift; - my ($l,$d) = split /\@/, email_to_ascii(shift), 2; + my ($l,$d) = split_addr( shift, -encoding => 'ascii' ); my %options = @_; my $mesg = $self->ldap->delete( "fvu=$l,fvd=$d,".$self->suffix ); @@ -213,7 +214,7 @@ Guilhem Moulin C<< >> =head1 COPYRIGHT -Copyright 2012 Guilhem Moulin. +Copyright 2012,2013 Guilhem Moulin. =head1 LICENSE diff --git a/misc/w3c-validator.pl b/misc/w3c-validator.pl index 76355ac..1947401 100755 --- a/misc/w3c-validator.pl +++ b/misc/w3c-validator.pl @@ -22,7 +22,7 @@ # sudo ./bin/fripost-panel restart # # Every HTML page will now be dumped into /tmp/fpanel/. Once you are done -# browsing the RunModes, +# browsing the RunModes, # sudo chmod -R +r /tmp/fpanel/ # ./misc/w3c-validator.pl /tmp/fpanel/*.html # @@ -45,7 +45,7 @@ foreach my $html (@ARGV) { if (defined $v->errors) { my @errors = @{$v->errors}; foreach (@errors) { - printf STDERR ( "line: %s, col: %s\n\terror: %s\n", + printf STDERR ( "line: %s, col: %s\n\terror: %s\n", $_->line, $_->col, $_->msg ); } @@ -54,7 +54,7 @@ foreach my $html (@ARGV) { elsif (@{$v->warnings}) { my @warnings = @{$v->warnings}; foreach (@warnings) { - printf STDERR ( "line: %s, col: %s\n\twarning: %s\n", + printf STDERR ( "line: %s, col: %s\n\twarning: %s\n", $_->line, $_->col, $_->msg ); } -- cgit v1.2.3