aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/Fripost/Panel/Interface.pm15
-rw-r--r--lib/Fripost/Panel/Login.pm9
-rw-r--r--lib/Fripost/Schema.pm13
-rw-r--r--lib/Fripost/Schema/Alias.pm11
-rw-r--r--lib/Fripost/Schema/Domain.pm2
-rw-r--r--lib/Fripost/Schema/List.pm15
-rw-r--r--lib/Fripost/Schema/Local.pm9
-rw-r--r--lib/Fripost/Schema/Misc.pm24
-rw-r--r--lib/Fripost/Schema/User.pm13
-rwxr-xr-xmisc/w3c-validator.pl6
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<< <guilhem at fripost.org> >>
=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<< <guilhem at fripost.org> >>
=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<< <guilhem at fripost.org> >>
=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<< <guilhem at fripost.org> >>
=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<< <guilhem at fripost.org> >>
=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<< <guilhem at fripost.org> >>
=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<< <guilhem at fripost.org> >>
=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<< <guilhem at fripost.org> >>
=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<< <guilhem at fripost.org> >>
=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 );
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 00:42:50 +0000