aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Schema/Auth.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Fripost/Schema/Auth.pm')
-rw-r--r--lib/Fripost/Schema/Auth.pm67
1 files changed, 46 insertions, 21 deletions
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 {