LemonLDAP-NG customplugin to MergeFranceConnectInLdap

MergeFranceConnectInLdap.pm

# Use it with Combination auth module:
# if ($env->{QUERY_STRING} =~ /openidconnectcallback|&idp=FranceConnect$/) then [FranceConnect, FranceConnect and attrsLDAP] or [LDAP] else if($env->{HTTP_USER_AGENT} =~ /Firefox|Kerberos/) then [Kerberos, attrsLDAP] or [LDAP] else [LDAP]
#
# and lemonldap-ng.ini
# [Portal]
# ...
# customPlugins = Lemonldap::NG::Portal::MergeFranceConnectInLdap
# MergeFranceConnectInLdap_bindDN = cn=claExternalID,ou=admin,dc=univ-paris1,dc=fr
# MergeFranceConnectInLdap_bind_password = xxx


package Lemonldap::NG::Portal::MergeFranceConnectInLdap;

use Mouse;
use Lemonldap::NG::Portal::Main::Constants
    qw(PE_OK PE_ERROR PE_LDAPERROR PE_LDAPCONNECTFAILED PE_BADCREDENTIALS PE_IDPCHOICE PE_FIRSTACCESS);

extends 'Lemonldap::NG::Portal::Main::Plugin';

use constant afterData => 'myAfterData';
use constant hook => { oidcGotUserInfo => 'automaticMergeOrSaveForLater' };

has ott => (
    is      => 'rw',
    lazy    => 1,
    default => sub {
        my $ott = $_[0]->{p}->loadModule('Lemonldap::NG::Portal::Lib::OneTimeToken');
        $ott->timeout(5 * 60); 
        return $ott;
    }
);


# input format is YYYY-MM-DD
sub to_LDAP_generalizedTime {
    my ($birthdate) = @_;
    $birthdate =~ s/-//g;
    $birthdate . "000000Z";
}

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

    my $ldap = Lemonldap::NG::Portal::Lib::Net::LDAP->new(
        { p => $self->{p}, conf => $self->{conf} }
    ) or die PE_LDAPCONNECTFAILED;

    my $msg = $ldap->bind(
        $self->conf->{MergeFranceConnectInLdap_bindDN}, 
        password => $self->conf->{MergeFranceConnectInLdap_bind_password},
    );
    !$msg->code or die PE_LDAPERROR;

    return $ldap;
}

sub ldap_search_user {
    my ( $self, $ldap, $searchFilter, $attrs ) = @_;

    $self->logger->debug("searching user matching $searchFilter in LDAP");
    my $mesg = $ldap->search(
        base   => $self->conf->{ldapBase},
        scope  => 'sub',
        filter => $searchFilter,
        attrs => $attrs,
    );
    if ( $mesg->code() != 0 ) {
        $self->logger->error( 'LDAP Search error ' . $mesg->code . ": " . $mesg->error );
        die PE_LDAPERROR;
    }
    my $count = $mesg->count();
    if ($count > 1) {
        $self->logger->error('More than one entry returned by LDAP directory');
    }
    return { count => $count, entry => $count > 1 ? undef : $mesg->entry(0) };
}

sub add_supannFCSub {
    my ( $self, $ldap, $dn, $sub) = @_;

    my $result = $ldap->modify($dn, add => { supannFCSub => $sub } );
    unless ( $result->code == 0 ) {
        $self->logger->error( "LDAP modify Error adding supannFCSub $sub to $dn: " . $result->code );
        die PE_LDAPERROR;
    }
}

sub remove_supannFCSub {
    my ( $self, $ldap, $uid, $sub) = @_;
    my $dn = "uid=$uid," . $self->conf->{ldapBase};
    return $ldap->modify($dn, delete => { supannFCSub => $sub } );
}

sub _automaticMergeOrSaveForLater {
    my ( $self, $req, $op, $userinfo ) = @_;

    my $sub = $userinfo->{sub};
    $self->logger->warn("automaticMergeOrSaveForLater $sub");

    my $ldap = $self->ldap_connect();

    my $search = $self->ldap_search_user($ldap, "supannFCSub=$sub", ["uid"]);
    
    if ( $search->{count} > 1 ) {
        eval { $self->p->_authentication->setSecurity($req) }; # ??
        die PE_BADCREDENTIALS;
    } elsif ( $search->{entry} ) {
        $self->logger->debug("supannFCSub is in LDAP, UserDB::LDAP will succeed :-)");
        return;
    }

    $self->logger->debug("supannFCSub not found, trying to find a perfect match");

    my $birthdate = to_LDAP_generalizedTime($userinfo->{birthdate});
    my $searchFilter = "(&" . join('',
        "(up1BirthDay=$birthdate)",
        "(up1BirthName=$userinfo->{family_name})",
        "(givenName=$userinfo->{given_name})",
        "(|(mail=$userinfo->{email})(supannMailPerso=$userinfo->{email}))",
        $userinfo->{gender} =~ /MALE/i ?
            "(supannCivilite=M.)" :
            "(|(supannCivilite=Mlle)(supannCivilite=Mme))",
    ) . ")";

    $search = $self->ldap_search_user($ldap, $searchFilter, ["uid"]);

    if ( my $user = $search->{entry} ) {
        my $uid = $user->get_value("uid");
        $self->logger->info("LDAP exact match: add supannFCSub $sub to $uid");

        $self->add_supannFCSub($ldap, $user->dn(), $sub);
    } else {
        $self->logger->info("no user matching FranceConnect user " . JSON::to_json($userinfo));
        $req->pdata->{fc_saved_userinfo} = $self->ott->createToken($userinfo);
    }
}

sub removeTestsFcSub {
    my ( $self ) = @_;
    $self->logger->info("removeTestsFcSub");
    
    my $ldap = $self->ldap_connect();

    # NB: ignoring errors
    $self->remove_supannFCSub($ldap, "pldupont", "bb9efb98cd8d8dee7c1cfd7f3a2d7937fbbd09068b2ac4dce801abaa6eb8e6b4v1");
    $self->remove_supannFCSub($ldap, "pldupont", "ced88a7b04db5c2e2aefa09ac11966ce8f70502dcc40651b2d74e52fe49b97dfv1");
}

sub _myAfterData {
    my ( $self, $req ) = @_;

    if ($req->param('service') eq 'http://localhost/integration-tests-cas-server/cleanup') {
        $self->removeTestsFcSub();
    }

    my $fc_saved_userinfo = $req->pdata->{fc_saved_userinfo} or return;
    
    my $fc_userinfo = $self->ott->getToken($fc_saved_userinfo);
    unless ($fc_userinfo) {
        $self->logger->warn("Le login France Connect a été oublié, pas de fusion possible avec " . $req->user);
        return;
    }
    $self->logger->debug("Need to merge " . $req->user . " with " . JSON::to_json($fc_userinfo));

    my $ldap = $self->ldap_connect();

    my $search = $self->ldap_search_user($ldap, "uid=" . $req->user, ["up1BirthDay"]);
    my $ldap_user = $search->{entry} or die PE_ERROR;

    my $fc_birthdate = to_LDAP_generalizedTime($fc_userinfo->{birthdate});
    my $ldap_birthdate = $ldap_user->get_value("up1BirthDay");
    if ($fc_birthdate ne $ldap_birthdate) {
        $self->logger->warn("different birth dates $fc_birthdate != $ldap_birthdate");
        $req->info("Nom de famille et date de naissance provenant de France Connect ne correspondent pas à l'utilisateur");
        die PE_ERROR;
    }

    $self->logger->info("User logged both FC & LDAP: add supannFCSub $fc_userinfo->{sub} to " . $req->user);
    $self->add_supannFCSub($ldap, $ldap_user->dn(), $fc_userinfo->{sub});
}

sub myAfterData {
    my ( $self, $req ) = @_;
    eval {
        $self->_myAfterData($req);
    };
    if ($@) {
        return $1 if $@ =~ /^(\d+) at /;
        die $@;
    }
    return PE_OK;
}

sub automaticMergeOrSaveForLater {
    my ( $self, $req, $op, $userinfo ) = @_;
    eval {
        $self->_automaticMergeOrSaveForLater($req, $op, $userinfo);
    };
    if ($@) {
        return $1 if $@ =~ /^(\d+) at /;
        die $@;
    }
    return PE_OK;
}

1;