Combination.pm 6.84 KB
Newer Older
Yadd's avatar
Yadd committed
1
package Lemonldap::NG::Portal::Auth::Combination;
Yadd's avatar
Yadd committed
2 3 4 5

use strict;
use Mouse;
use Lemonldap::NG::Common::Combination::Parser;
6
use Lemonldap::NG::Portal::Main::Constants qw(PE_OK PE_ERROR PE_FIRSTACCESS);
7
use Scalar::Util 'weaken';
Yadd's avatar
Yadd committed
8

Yadd's avatar
Yadd committed
9
our $VERSION = '2.1.0';
Yadd's avatar
Yadd committed
10

Yadd's avatar
Yadd committed
11
# TODO: See Lib::Wrapper
Yadd's avatar
Yadd committed
12
extends 'Lemonldap::NG::Portal::Main::Auth';
Yadd's avatar
Yadd committed
13
with 'Lemonldap::NG::Portal::Lib::OverConf';
Yadd's avatar
Yadd committed
14 15 16 17 18

# PROPERTIES

has stackSub => ( is => 'rw' );

19 20
has wrapUserLogger => (
    is      => 'rw',
21
    lazy    => 1,
22
    default => sub {
Yadd's avatar
Yadd committed
23
        Lemonldap::NG::Portal::Lib::Combination::UserLogger->new(
Yadd's avatar
Yadd committed
24
            $_[0]->userLogger );
25 26 27
    }
);

Yadd's avatar
Yadd committed
28 29 30
# INITIALIZATION

sub init {
Christophe Maudoux's avatar
Christophe Maudoux committed
31
    my $self = shift;
Yadd's avatar
Yadd committed
32 33

    # Check if expression exists
Yadd's avatar
Yadd committed
34
    unless ( $self->conf->{combination} ) {
Yadd's avatar
Yadd committed
35 36 37
        $self->error('No combination found');
        return 0;
    }
Yadd's avatar
Yadd committed
38 39

    # Load all declared modules
Yadd's avatar
Yadd committed
40
    my %mods;
Yadd's avatar
Yadd committed
41
    foreach my $key ( keys %{ $self->conf->{combModules} } ) {
Yadd's avatar
Yadd committed
42
        my @tmp = ( undef, undef );
Yadd's avatar
Yadd committed
43 44 45 46 47 48
        my $mod = $self->conf->{combModules}->{$key};

        unless ( $mod->{type} and defined $mod->{for} ) {
            $self->error("Malformed combination module $key");
            return 0;
        }
Yadd's avatar
Yadd committed
49

Yadd's avatar
Yadd committed
50 51 52 53
        # Override parameters

        # "for" key can have 3 values:
        # 0: this module will be used for Auth and UserDB
Christophe Maudoux's avatar
Christophe Maudoux committed
54 55
        # 1: this module will be used for Auth only
        # 2: this module will be used for UserDB only
Yadd's avatar
Yadd committed
56 57

        # Load Auth module
Yadd's avatar
Yadd committed
58
        if ( $mod->{for} < 2 ) {
Yadd's avatar
Yadd committed
59
            $tmp[0] = $self->loadPlugin( "::Auth::$mod->{type}", $mod->{over} );
Yadd's avatar
Yadd committed
60 61 62 63
            unless ( $tmp[0] ) {
                $self->error("Unable to load Auth::$mod->{type}");
                return 0;
            }
64 65
            $tmp[0]->{userLogger} = $self->wrapUserLogger;
            weaken $tmp[0]->{userLogger};
Yadd's avatar
Yadd committed
66
        }
Yadd's avatar
Yadd committed
67 68

        # Load UserDB module
Yadd's avatar
Yadd committed
69
        unless ( $mod->{for} == 1 ) {
Yadd's avatar
Yadd committed
70 71
            $tmp[1] =
              $self->loadPlugin( "::UserDB::$mod->{type}", $mod->{over} );
Yadd's avatar
Yadd committed
72 73 74 75
            unless ( $tmp[1] ) {
                $self->error("Unable to load UserDB::$mod->{type}");
                return 0;
            }
76 77
            $tmp[1]->{userLogger} = $self->wrapUserLogger;
            weaken $tmp[1]->{userLogger};
Yadd's avatar
Yadd committed
78
        }
Yadd's avatar
Yadd committed
79 80

        # Store modules as array
Yadd's avatar
Yadd committed
81
        $mods{$key} = \@tmp;
Yadd's avatar
Yadd committed
82
    }
Yadd's avatar
Yadd committed
83 84

    # Compile expression
Yadd's avatar
Yadd committed
85 86 87
    eval {
        $self->stackSub(
            Lemonldap::NG::Common::Combination::Parser->parse(
Yadd's avatar
Yadd committed
88
                \%mods, $self->conf->{combination}
Yadd's avatar
Yadd committed
89 90 91 92 93 94 95 96 97 98
            )
        );
    };
    if ($@) {
        $self->error("Bad combination: $@");
        return 0;
    }
    return 1;
}

Yadd's avatar
Yadd committed
99 100
# Each first method must call getStack() to get the auth scheme available for
# the current user
101 102 103

## Auth steps
#############
Yadd's avatar
Yadd committed
104
sub extractFormInfo {
Yadd's avatar
Yadd committed
105 106
    my $self = shift;
    return $self->try( 0, 'extractFormInfo', @_ );
Yadd's avatar
Yadd committed
107 108 109
}

sub authenticate {
Yadd's avatar
Yadd committed
110
    my $self = shift;
Yadd's avatar
Yadd committed
111
    return $self->try( 0, 'authenticate', @_ );
Yadd's avatar
Yadd committed
112 113 114
}

sub setAuthSessionInfo {
Yadd's avatar
Yadd committed
115
    my $self = shift;
Yadd's avatar
Yadd committed
116
    return $self->try( 0, 'setAuthSessionInfo', @_ );
Yadd's avatar
Yadd committed
117 118
}

Yadd's avatar
Yadd committed
119
sub getForm {
Yadd's avatar
Yadd committed
120 121
    my $self = shift;
    my ($req) = @_;
Yadd's avatar
Yadd committed
122
    return [ split /[, ]\s*/, $self->conf->{combinationForms} ]
Yadd's avatar
Yadd committed
123
      if ( $self->conf->{combinationForms} );
Christophe Maudoux's avatar
Christophe Maudoux committed
124

125
    my ( $nb, $stack ) = (
Yadd's avatar
Yadd committed
126 127
        $req->data->{dataKeep}->{combinationTry},
        $req->data->{combinationStack}
128
    );
Yadd's avatar
Yadd committed
129
    my ( $res, $name ) = $stack->[$nb]->[0]->( 'getForm', @_ );
Yadd's avatar
Yadd committed
130
    return $res;
Yadd's avatar
Yadd committed
131 132
}

Yadd's avatar
Yadd committed
133
sub authLogout {
Yadd's avatar
Yadd committed
134 135
    my $self = shift;
    my ($req) = @_;
Yadd's avatar
Yadd committed
136
    $self->getStack( $req, 'extractFormInfo' ) or return PE_ERROR;
Yadd's avatar
Tidy  
Yadd committed
137

Christophe Maudoux's avatar
Christophe Maudoux committed
138
    # Avoid warning msg at first access
Christophe Maudoux's avatar
Christophe Maudoux committed
139
    $req->userData->{_combinationTry} ||= 0;
Yadd's avatar
Yadd committed
140
    my ( $res, $name ) =
Yadd's avatar
Yadd committed
141
      $req->data->{combinationStack}->[ $req->userData->{_combinationTry} ]
Yadd's avatar
Yadd committed
142
      ->[0]->( 'authLogout', @_ );
Yadd's avatar
Yadd committed
143 144 145
    $self->logger->debug(qq'User disconnected using scheme "$name"');
    return $res;
}
Yadd's avatar
Yadd committed
146

147 148 149 150 151 152 153 154
sub authFinish {
    PE_OK;
}

sub authForce {
    return 0;
}

155 156 157 158
## UserDB steps
###############
# Note that UserDB::Combination uses the same object.
sub getUser {
Yadd's avatar
Yadd committed
159 160
    my $self = shift;
    return $self->try( 1, 'getUser', @_ );
161 162 163
}

sub setSessionInfo {
Yadd's avatar
Yadd committed
164 165
    my $self = shift;
    return $self->try( 1, 'setSessionInfo', @_ );
166 167 168
}

sub setGroups {
Yadd's avatar
Yadd committed
169 170
    my $self = shift;
    return $self->try( 1, 'setGroups', @_ );
171 172
}

Yadd's avatar
Yadd committed
173
sub getStack {
Yadd's avatar
Yadd committed
174
    my ( $self, $req, @steps ) = @_;
Yadd's avatar
Yadd committed
175 176
    return $req->data->{combinationStack}
      if ( $req->data->{combinationStack} );
Yadd's avatar
Yadd committed
177
    my $stack = $req->data->{combinationStack} = $self->stackSub->( $req->env );
Yadd's avatar
Yadd committed
178
    unless ($stack) {
Yadd's avatar
Yadd committed
179
        $self->logger->error('No authentication scheme for this user');
Yadd's avatar
Yadd committed
180
    }
Yadd's avatar
Yadd committed
181 182
    @{ $req->data->{combinationSteps} } = ( @steps, @{ $req->steps } );
    $req->data->{dataKeep}->{combinationTry} ||= 0;
Yadd's avatar
Yadd committed
183 184 185
    return $stack;
}

Yadd's avatar
Yadd committed
186
# Main running method: launch the next scheme if the current fails
Yadd's avatar
Yadd committed
187
sub try {
Yadd's avatar
Yadd committed
188
    my ( $self, $type, $subname, $req, @args ) = @_;
189 190

    # Get available authentication schemes for this user if not done
Yadd's avatar
Yadd committed
191
    unless ( defined $req->data->{combinationStack} ) {
192 193
        $self->getStack( $req, $subname ) or return PE_ERROR;
    }
194
    my ( $nb, $stack ) = (
Yadd's avatar
Yadd committed
195 196
        $req->data->{dataKeep}->{combinationTry},
        $req->data->{combinationStack}
197
    );
Yadd's avatar
Yadd committed
198 199

    # If more than 1 scheme is available
Yadd's avatar
Yadd committed
200
    my ( $res, $name );
201

Yadd's avatar
Yadd committed
202
    if ( $nb < @$stack - 1 ) {
Yadd's avatar
Yadd committed
203 204

        # TODO: change logLevel for userLog()
Yadd's avatar
Yadd committed
205
        ( $res, $name ) = $stack->[$nb]->[$type]->( $subname, $req, @args );
Yadd's avatar
Yadd committed
206 207 208

        # On error, restart authentication with next scheme
        if ( $res > PE_OK ) {
Yadd's avatar
Tidy  
Yadd committed
209
            $self->logger->info(qq'Scheme "$name" returned $res, trying next');
Yadd's avatar
Yadd committed
210 211
            $req->data->{dataKeep}->{combinationTry}++;
            $req->steps( [ @{ $req->data->{combinationSteps} } ] );
Yadd's avatar
Yadd committed
212
            $req->continue(1);
Yadd's avatar
Yadd committed
213 214 215
            return PE_OK;
        }
    }
Yadd's avatar
Yadd committed
216
    else {
Yadd's avatar
Yadd committed
217
        ( $res, $name ) = $stack->[$nb]->[$type]->( $subname, $req, @args );
Yadd's avatar
Yadd committed
218 219
    }
    $req->sessionInfo->{ [ '_auth', '_userDB' ]->[$type] } = $name;
220
    $req->sessionInfo->{_combinationTry} =
Yadd's avatar
Yadd committed
221
      $req->data->{dataKeep}->{combinationTry};
222
    if ( $res > 0 and $res != PE_FIRSTACCESS ) {
223 224 225
        $self->userLogger->warn( 'All schemes failed'
              . ( $req->user ? ' for user ' . $req->user : '' ) );
    }
Yadd's avatar
Yadd committed
226
    return $res;
Yadd's avatar
Yadd committed
227 228
}

Yadd's avatar
Yadd committed
229 230 231 232 233 234 235 236 237
# try() stores real Auth/UserDB module in sessionInfo
# This method reads them. It is called by getModule()
# (see Main::Run)
sub name {
    my ( $self, $req, $type ) = @_;
    return $req->sessionInfo->{ ( $type eq 'auth' ? '_auth' : '_userDB' ) }
      || 'Combination';
}

238 239
sub setSecurity {
    my ( $self, $req ) = @_;
240 241
    $self->try(0, 'setSecurity', $req);
    PE_OK;
242 243
}

Yadd's avatar
Yadd committed
244
package Lemonldap::NG::Portal::Lib::Combination::UserLogger;
245 246 247 248 249 250 251 252 253 254

# This logger rewrite "warn" to "notice"
sub new {
    my ( $class, $realLogger ) = @_;
    return bless { logger => $realLogger }, $class;
}

sub warn {
    my ($auth) = caller(0);
    $_[0]->{logger}->notice("Combination ($auth): $_[1]");
Yadd's avatar
Yadd committed
255 256
}

Yadd's avatar
Yadd committed
257 258 259 260 261 262
sub AUTOLOAD {
    no strict;
    return $_[0]->{logger}->$AUTOLOAD( $_[1] )
      if ( $AUTOLOAD =~ /^(?:notice|debug|error|info)$/ );
}

Yadd's avatar
Yadd committed
263
1;