From 7076e66b79a98a3978b3a967fdea792b5b9d1cd5 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 1 Feb 2013 02:17:24 +0100 Subject: Make the whole configuration available through the library. --- lib/Fripost/Schema/Auth.pm | 67 ++++++++++++++++++++++++++++++-------------- lib/Fripost/Schema/Domain.pm | 19 +++---------- lib/Fripost/Schema/Local.pm | 2 +- lib/Fripost/Schema/Mail.pm | 2 +- 4 files changed, 52 insertions(+), 38 deletions(-) (limited to 'lib/Fripost/Schema') 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 (I, I) +=item B (I, I, I) Start a LDAP connection, and SASL-authenticate using proxy authentication for the given (fully qualified) user. -The following keys in the hash I are considered: +The following keys in the hash reference I 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 for details. =cut @@ -76,55 +76,58 @@ B 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 (I, I, I) +=item B (I, I, I, I) Start a LDAP connection, and simple authenticate the given I. An option B may be given to override I, which may then be left undefined. -The following keys in the hash I are considered: +The following keys in the hash reference I 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 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 ([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 with the unlocking token. -=item B - -The URL to send, together with the token, to provide instructions how to -unlock the domain. - -=item B - -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 ', # 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; } -- cgit v1.2.3