1 files changed, 1 insertions, 129 deletions

diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
index 2e1cbef..7526077 100644
--- a/lib/Fripost/Schema.pm
+++ b/lib/Fripost/Schema.pm
@@ -18,6 +18,7 @@ use strict;
 use warnings;
 use utf8;
 
+use parent 'Fripost::Schema::Auth';
 use Net::LDAP;
 use Authen::SASL;
 use Fripost::Schema::Util qw/canonical_dn ldap_explode_dn split_addr/;
@@ -33,122 +34,6 @@ use Net::IDN::Encode 'email_to_ascii';
 
 =over 4
 
-=item B<SASLauth> (I<username>, I<CFG>)
-
-Start a LDAP connection, and SASL-authenticate (with the GSSAPI
-mechanism) using proxy authentication for the given (fully-qualified)
-user. I<CFG> should contain definitions for the LDAP suffix and the
-authentication ID.
-
-=cut
-
-sub SASLauth {
-    my $class = shift;
-    my ($l,$d) = split_addr(shift);
-    my %cfg = @_;
-
-    return unless defined $cfg{ldap_SASL_mechanism};
-    my $self = bless {}, $class;
-
-    $self->suffix( ldap_explode_dn(@{$cfg{ldap_suffix}}) );
-    $self->whoami( canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ));
-    $self->ldap( Net::LDAP::->new( $cfg{ldap_uri} // 'ldap://127.0.0.1:389/'
-                                 , async => 0 ));
-
-    my $callback;
-    if ($cfg{ldap_SASL_mechanism} eq 'DIGEST-MD5') {
-        $callback = { user => $cfg{ldap_authcID}
-                    , pass => $cfg{ldap_authcPW}
-                    , authname => 'dn:'.$self->whoami
-                    };
-    }
-    elsif ($cfg{ldap_SASL_mechanism} eq 'GSSAPI') {
-        $callback = { user => 'dn:'.$self->whoami };
-    }
-    else {
-        die "Unknown SASL mechanism: ".$cfg{ldap_SASL_mechanism};
-    }
-
-    my $sasl = Authen::SASL::->new( mechanism => $cfg{ldap_SASL_mechanism}
-                                  , callback => $callback );
-    my $host = $cfg{krb5_service_instance} // 'localhost';
-    my $conn = $sasl->client_new( 'ldap', $host );
-    die $conn->error if $conn->code;
-
-    my $mesg = $self->ldap->bind( undef, sasl => $conn );
-    # This is not supposed to happen.
-    die $mesg->error if $mesg->code;
-
-    return $self;
-}
-
-
-=item B<auth> (I<username>, I<password>, I<CFG>)
-
-Start a LDAP connection, and (simple-) binds the given user.
-I<CFG> should contain definitions for the LDAP suffix and URI.
-
-=cut
-
-sub auth {
-    my $class = shift;
-    my $id = shift;
-    my $pw = shift;
-    my %cfg = @_;
-
-    my $self = bless {}, $class;
-    $self->suffix( ldap_explode_dn(@{$cfg{ldap_suffix}}) );
-
-    if (not (defined $id) or defined $cfg{ldap_bind_dn}) {
-        $self->whoami( join ',', @{$cfg{ldap_bind_dn}} );
-    }
-    else {
-        my ($l,$d) = split_addr($id);
-        $self->whoami( canonical_dn( {fvu => $l}, {fvd => $d}, @{$self->suffix} ));
-    }
-
-    $self->ldap( Net::LDAP::->new( $cfg{ldap_uri} // 'ldap://127.0.0.1:389/'
-                                 , async => 0 ) );
-
-    my $mesg = $self->ldap->bind( $self->whoami, password => $pw );
-    if ($mesg->code) {
-        if (defined $cfg{'-die'}) {
-            return unless $cfg{'-die'};
-            die $cfg{'-die'}."\n";
-        }
-        die $mesg->error;
-    }
-    return $self;
-}
-
-
-
-# The DN of the authorization ID
-sub whoami { shift->_set_or_get('_whoami',@_); }
-
-# The LDAP object (of class Net::LDAP)
-sub ldap { shift->_set_or_get('_ldap',@_); }
-
-# The suffix under which virtual domains are.
-sub suffix { shift->_set_or_get('_suffix',@_); }
-
-
-# Set or get a key (the first argument), depending on whether a second
-# argument is given or not.
-sub _set_or_get {
-    my $self = shift;
-    my $what = shift;
-
-    if (@_) {
-        $self->{$what} = $_[0];
-    }
-    else {
-        return $self->{$what};
-    }
-}
-
-
-
 =item B<domain>
 
 Bless the object to C<Fripost::Schema::Domain>, to access
@@ -199,19 +84,6 @@ local-specific (users, aliases and lists) methods.
 sub local { bless shift, 'Fripost::Schema::Local'; }
 
 
-
-=item B<done>
-
-Unbinds from the LDAP server.
-
-=cut
-
-sub done {
-    my $self = shift;
-    $self->ldap->unbind if defined $self and defined $self->ldap;
-}
-
-
 =back
 
 =head1 AUTHOR