aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Fripost/Panel/Interface.pm17
-rw-r--r--lib/Fripost/Panel/Login.pm2
-rw-r--r--lib/Fripost/Schema/Auth.pm67
-rw-r--r--lib/Fripost/Schema/Domain.pm19
-rw-r--r--lib/Fripost/Schema/Local.pm2
-rw-r--r--lib/Fripost/Schema/Mail.pm2
6 files changed, 60 insertions, 49 deletions
diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index 675c9ba..f357b53 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -40,7 +40,7 @@ sub ListDomains : StartRunmode {
my $self = shift;
my %CFG = $self->cfg;
- my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+ my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG );
my @domains = $fp->domain->search( undef, -sort => 1,
-keys => [qw/name isActive isPending description/]);
my $canIAdd = $fp->domain->domain->canIAdd;
@@ -78,7 +78,7 @@ sub AddDomain : Runmode {
my $error; # Tells whether the change submission has failed.
if (defined $q->param('submit')) {
# Changes have been submitted: process them
- my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+ my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG );
if (defined $q->param('owner') and defined $session_param) {
# Ensure that the user didn't spoof the domain ownership.
@@ -93,9 +93,6 @@ sub AddDomain : Runmode {
, '-send-confirmation-token' => $q->param('owner') // undef
, '-dry-run' => not (defined $q->param('owner'))
, -error => \$error
- , webapp_url => $self->cfg('webapp_url')
- , tmpl_path => $self->cfg('tmpl_path')
- , email_from => $self->cfg('email_from')
);
$fp->done;
}
@@ -148,7 +145,7 @@ sub EditDomain : Runmode {
# Get the domain name from the URL.
my $domainname = ($self->split_path)[1];
- my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+ my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG );
my $error; # Tells whether the change submission has failed.
if (defined $q->param('submit')) {
@@ -193,7 +190,7 @@ sub ListLocals : Runmode {
# Get the domain name from the URL.
my $domainname = ($self->split_path)[1];
- my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+ my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG );
if (defined $q->param('unlock')) {
# Unlock the domain, and come back to the home page.
@@ -294,7 +291,7 @@ sub AddLocal : Runmode {
my $domainname = ($self->split_path)[1];
my $t = $q->param('t') or return $self->redirect('./');
return $self->redirect('./') unless grep { $t eq $_ } qw/user alias list/;
- my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+ my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG );
my $error; # Tells whether the change submission has failed.
if (defined $q->param('submit')) {
@@ -330,7 +327,7 @@ sub AddLocal : Runmode {
};
unless ($error) {
- my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+ my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG );
$fp->domain->search ($domainname, -filter => 'unlocked', -count => 1)
or die "404\n";
$fp->local->add( $local, %rest, -error => \$error );
@@ -372,7 +369,7 @@ sub EditLocal : Runmode {
# Get the domain name from the URL.
my ($localname,$domainname) = ($self->split_path)[2,1];
my $name = $localname.'@'.$domainname;
- my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
+ my $fp = Fripost::Schema::->SASLauth( $self->authen->username, \%CFG );
# Search for *the* matching user, alias or list.
$fp->domain->search ($domainname, -filter => 'unlocked', -count => 1)
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index 3b2846a..1fca602 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -59,7 +59,7 @@ sub cgiapp_init {
$CFG{default_realm} // return 0;
$u .= '@'.$CFG{default_realm};
}
- my $fp = Fripost::Schema::->auth($u, $p, %CFG, -error => undef)
+ my $fp = Fripost::Schema::->auth($u, $p, \%CFG, -error => undef)
// return 0;
$fp->done;
return $u;
diff --git a/lib/Fripost/Schema/Auth.pm b/lib/Fripost/Schema/Auth.pm
index 3bdda8f..bea6fc6 100644
--- a/lib/Fripost/Schema/Auth.pm
+++ b/lib/Fripost/Schema/Auth.pm
@@ -30,11 +30,11 @@ use Fripost::Schema::Util qw/canonical_dn ldap_explode_dn ldap_error
=over 4
-=item B<SASLauth> (I<username>, I<OPTIONS>)
+=item B<SASLauth> (I<username>, I<cfg>, I<OPTIONS>)
Start a LDAP connection, and SASL-authenticate using proxy
authentication for the given (fully qualified) user.
-The following keys in the hash I<OPTIONS> are considered:
+The following keys in the hash reference I<cfg> are considered:
=over 4
@@ -68,7 +68,7 @@ the virtual entries.
=back
-Errors can be caught with options B<-die> and B<-error>, see
+Errors can be caught with options B<-die> and B<-error>; See
B<Fripost::Schema::Util> for details.
=cut
@@ -76,55 +76,58 @@ B<Fripost::Schema::Util> for details.
sub SASLauth {
my $class = shift;
my $user = shift;
+ my $cfg = shift;
my %options = @_;
- return unless defined $options{ldap_SASL_mechanism};
+ return unless defined $cfg->{ldap_SASL_mechanism};
my $self = bless {}, $class;
- $self->suffix( ldap_explode_dn(@{$options{ldap_suffix}}) );
+ $self->suffix( ldap_explode_dn(@{$cfg->{ldap_suffix}}) );
$self->whoami( $self->mail2dn($user) );
- $self->ldap( Net::LDAP::->new( $options{ldap_uri}
+ $self->ldap( Net::LDAP::->new( $cfg->{ldap_uri}
// 'ldap://127.0.0.1:389/' ) );
assert( $self->ldap, -die => "Couldn't connect to the LDAP server." );
my $callback;
- if ($options{ldap_SASL_mechanism} eq 'DIGEST-MD5') {
- my ($id,$pw) = ($options{ldap_authcID}, $options{ldap_authcPW});
- delete $options{ldap_authcID};
- delete $options{ldap_authcPW}; # These are private options.
+ if ($cfg->{ldap_SASL_mechanism} eq 'DIGEST-MD5') {
+ my ($id,$pw) = ($cfg->{ldap_authcID}, $cfg->{ldap_authcPW});
$callback = { user => $id
, pass => $pw
, authname => 'dn:'.$self->whoami
};
}
- elsif ($options{ldap_SASL_mechanism} eq 'GSSAPI') {
+ elsif ($cfg->{ldap_SASL_mechanism} eq 'GSSAPI') {
$callback = { user => 'dn:'.$self->whoami };
}
else {
- softdie( "Unknown SASL mechanism: ".$options{ldap_SASL_mechanism},
+ softdie( "Unknown SASL mechanism: ".$cfg->{ldap_SASL_mechanism},
%options );
}
- my $sasl = Authen::SASL::->new( mechanism => $options{ldap_SASL_mechanism}
+ my $sasl = Authen::SASL::->new( mechanism => $cfg->{ldap_SASL_mechanism}
, callback => $callback );
- my $host = $options{ldap_SASL_service_instance} // 'localhost';
+ my $host = $cfg->{ldap_SASL_service_instance} // 'localhost';
my $conn = $sasl->client_new( 'ldap', $host );
ldap_error ($conn, %options) // return;
my $mesg = $self->ldap->bind( undef, sasl => $conn );
ldap_error ($mesg, %options) // return;
+ # These are private options, we don't want to pass them around.
+ delete $cfg->{$_} for qw/ldap_authcID ldap_authcPW/;
+ $self->{_cfg} = $cfg;
+
return $self;
}
-=item B<auth> (I<username>, I<password>, I<OPTIONS>)
+=item B<auth> (I<username>, I<password>, I<cfg>, I<OPTIONS>)
Start a LDAP connection, and simple authenticate the given I<username>.
An option B<ldap_bind_dn> may be given to override I<username>, which
may then be left undefined.
-The following keys in the hash I<OPTIONS> are considered:
+The following keys in the hash reference I<cfg> are considered:
=over 4
@@ -145,7 +148,7 @@ the virtual entries.
=back
-Errors can be caught with options B<-die> and B<-error>, see
+Errors can be caught with options B<-die> and B<-error>; See
B<Fripost::Schema::Util> for details.
=cut
@@ -154,26 +157,29 @@ sub auth {
my $class = shift;
my $user = shift;
my $pw = shift // return;
+ my $cfg = shift;
my %options = @_;
my $self = bless {}, $class;
- $self->suffix( ldap_explode_dn(@{$options{ldap_suffix}}) );
+ $self->suffix( ldap_explode_dn(@{$cfg->{ldap_suffix}}) );
- if (defined $options{ldap_bind_dn}) {
- $self->whoami( join ',', @{$options{ldap_bind_dn}} );
+ if (defined $cfg->{ldap_bind_dn}) {
+ $self->whoami( join ',', @{$cfg->{ldap_bind_dn}} );
}
else {
return unless email_valid($user, -nodie => 1, -exact => 1);
$self->whoami( $self->mail2dn($user) );
}
- $self->ldap( Net::LDAP::->new( $options{ldap_uri}
+ $self->ldap( Net::LDAP::->new( $cfg->{ldap_uri}
// 'ldap://127.0.0.1:389/' ) );
assert( $self->ldap, -die => "Couldn't connect to the LDAP server." );
my $mesg = $self->ldap->bind( $self->whoami, password => $pw );
ldap_error ($mesg, %options) // return;
+ $self->{_cfg} = $cfg;
+
return $self;
}
@@ -265,6 +271,25 @@ sub mail2dn {
}
+=item B<cfg> ([key1, [key2, ...]])
+
+Give the value of configuration options. Without arguments, returns the
+whole configuration (as a hash in array context, as a hash reference
+otherwise). Keys can be specify to fetch one value (or more) of the
+configuration; In that case, the list of the corresponding values are
+returned.
+
+=cut
+
+sub cfg {
+ my $self = shift;
+ return @{$self->{_cfg}}{@_} if @_;
+
+ return unless defined wantarray;
+ return wantarray ? %{$self->{_cfg}} : $self->{_cfg};
+}
+
+
# Set or get a key (the first argument), depending on whether or not a second
# argument is given. The value after optional assignation is returned.
sub _set_or_get {
diff --git a/lib/Fripost/Schema/Domain.pm b/lib/Fripost/Schema/Domain.pm
index 36194d8..11502ea 100644
--- a/lib/Fripost/Schema/Domain.pm
+++ b/lib/Fripost/Schema/Domain.pm
@@ -480,16 +480,6 @@ the directory.
When set, this option locks down the domain before inserting it, and
send a message to I<email> with the unlocking token.
-=item B<webapp_url>
-
-The URL to send, together with the token, to provide instructions how to
-unlock the domain.
-
-=item B<tmpl_path>
-
-Where to find the e-mail template with the instructions how to unlock
-the domain.
-
=back
Errors can be caught with options B<-die> and B<-error>; See
@@ -560,18 +550,17 @@ sub add {
# Send token
email_valid ($options{'-send-confirmation-token'});
- my $tt = Template->new({ INCLUDE_PATH => $options{tmpl_path}
+ my $tt = Template->new({ INCLUDE_PATH => $self->cfg('tmpl_path') // './'
, INTERPOLATE => 1 })
or die $Template::ERROR;
my $vars = { domain => $domainname, token => $token };
- $vars->{unlockurl} = $options{webapp_url}
+ $vars->{unlockurl} = ($self->cfg('webapp_url') // '')
.encodeURIComponent($domainname)
- .'/?unlock='.$token
- if defined $options{webapp_url};
+ .'/?unlock='.$token;
my $data;
$tt->process( 'new-domain.tt', $vars, \$data) or die $tt->error;
- Fripost::Schema::Mail::->new( From => $options{email_from} //
+ Fripost::Schema::Mail::->new( From => $self->cfg('email_from') //
$ENV{USER}.'@localhost'
, To => $options{'-send-confirmation-token'}
, Subject => "Your new domain ".$domain->{name}
diff --git a/lib/Fripost/Schema/Local.pm b/lib/Fripost/Schema/Local.pm
index 90c37ba..8a7b870 100644
--- a/lib/Fripost/Schema/Local.pm
+++ b/lib/Fripost/Schema/Local.pm
@@ -467,7 +467,7 @@ sub add {
# From => 'Fripost Admin Panel <AdminWebPanel@fripost.org>',
# To => $to,
# Subject => "New ".$local->{transport}." list",
-# Data => [ map { $_ . "\n"} ($local->{name}, $member, $pw) ]
+# Data => [ map { $_ . "\n"} ($local->{name}, $member, $pw) ]
# )->send(-sign => 1, -encrypt => 1);
}
else {
diff --git a/lib/Fripost/Schema/Mail.pm b/lib/Fripost/Schema/Mail.pm
index 3f9ec73..af3eed7 100644
--- a/lib/Fripost/Schema/Mail.pm
+++ b/lib/Fripost/Schema/Mail.pm
@@ -59,7 +59,7 @@ sub sign {
sub send {
my $self = shift;
my $msg = $self->{_msg};
- print STDERR $msg->as_string if $DEBUG;
+ print STDERR $msg->as_string;
# $msg->send;
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 16:29:01 +0000