liblemonldap-ng-portal-perl 1.9.16-2 / usr / share / perl5 / Lemonldap / NG / Portal / AuthKerberos.pm

This file is indexed.

/usr/share/perl5/Lemonldap/NG/Portal/AuthKerberos.pm is in liblemonldap-ng-portal-perl 1.9.16-2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
package Lemonldap::NG::Portal::AuthKerberos;

use strict;
use GSSAPI;
use MIME::Base64;
use Lemonldap::NG::Portal::Simple;

our $VERSION = '1.9.16';

# INITIALIZATION

sub authInit {
    my ($self) = @_;
    my $file;
    unless ( $file = $self->{krbKeytab} ) {
        $self->lmLog( 'Keytab not defined', 'error' );
        return PE_ERROR;
    }
    $self->{_keytab} = "FILE:$file";
    return PE_OK;
}

sub extractFormInfo {
    my ($self) = @_;

    # Return if Kerberos ticket already validated
    if ($self->{_krbUser}) {
        $self->lmLog("Kerberos ticket already validated, found user ".$self->{_krbUser}, 'debug');
	return PE_OK;
    }

    if ( $self->{krbUseModKrb} and $self->{_krbUser} = $ENV{REMOTE_USER} ) {
        $self->userNotice(
            "$self->{_krbUuser} authentified by Web Server Kerberos module");
        $self->{user} = $self->{_krbUser};
        if ( $self->{krbRemoveDomain} ) { $self->{user} =~ s/^(.*)@.*$/$1/; }
        return PE_OK;
    }

    my $auth = $ENV{HTTP_AUTHORIZATION};
    unless ($auth) {

        # Case 1: simple usage or first Kerberos Ajax request
        #         => return 401 to initiate Kerberos
        if ( !$self->{krbByJs} or $self->param('kerberos') ) {
            $self->lmLog( 'Initialize Kerberos dialog', 'debug' );

            # HTML request: display error and initiate Kerberos
            # dialog
            print $self->header(
                -status             => '401 Unauthorizated',
                '-WWW-Authenticate' => 'Negotiate'
            );
            $self->quit;
        }

        # Case 2: Ajax Kerberos request has failed, and javascript has reloaded
        # page with "kerberos=0". Return an error to be able to switch to
        # another backend (Multi)
        # switch to another backend
        elsif ( defined $self->param('kerberos') ) {
            $self->userNotice(
                'Kerberos authentication has failed, back to portal');
            $self->setHiddenFormValue( 'kerberos', 0, '', 0 );
            return PE_BADCREDENTIALS;
        }

        # Case 3: Display kerberos auth page (with javascript)
        else {
            $self->lmLog( 'Send Kerberos javascript', 'debug' );
            $self->setHiddenFormValue( 'kerberos', 0, '', 0 );
            return PE_FIRSTACCESS;
        }
    }

    # Case 4: an "Authorization header" has been sent
    if ( $auth !~ /^Negotiate (.*)$/ ) {
        $self->userError('Bad authorization header');
        return PE_BADCREDENTIALS;
    }

    # Case 5: Kerberos ticket received
    $self->lmLog( "Kerberos ticket received: $1", 'debug' );
    my $data;
    eval { $data = MIME::Base64::decode($1) };
    if ($@) {
        $self->userError( 'Bad authorization header: ' . $@ );
        return PE_BADCREDENTIALS;
    }
    $ENV{KRB5_KTNAME} = $self->{_keytab};
    $self->lmLog( "Set KRB5_KTNAME env to " . $ENV{KRB5_KTNAME}, 'debug' );
    my $status = GSSAPI::Context::accept(
        my $server_context,
        GSS_C_NO_CREDENTIAL,
        $data,
        GSS_C_NO_CHANNEL_BINDINGS,
        my $gss_client_name,
        undef,
        my $gss_output_token,
        my $out_flags,
        my $out_time,
        my $gss_delegated_cred
    );
    unless ($status) {
        $self->lmLog( 'Unable to accept security context', 'error' );
        return PE_ERROR;
    }
    my $client_name;
    $status = $gss_client_name->display($client_name);
    unless ($status) {
        $self->lmLog( 'Unable to display KRB client name', 'error' );
        foreach ( $status->generic_message(), $status->specific_message() ) {
            $self->lmLog( $_, 'error' );
        }
        return PE_ERROR;
    }
    $self->userNotice("$client_name authentified by Kerberos");
    $self->{_krbUser} = $client_name;
    $self->{user}     = $self->{_krbUser};
    if ( $self->{krbRemoveDomain} ) { $self->{user} =~ s/^(.*)@.*$/$1/; }
    return PE_OK;
}

sub authenticate {
    PE_OK;
}

sub authLogout {
    PE_OK;
}

sub setAuthSessionInfo {
    my ($self) = @_;
    $self->{sessionInfo}->{authenticationLevel} = $self->{krbAuthnLevel};
    $self->{sessionInfo}->{_krbUser}            = $self->{_krbUser};
    $self->{sessionInfo}->{_user}               = $self->{user};
    PE_OK;
}

sub getDisplayType {
    return "kerberos";
}

1;

APT Browse - Built by Thomas Orozco.