view release on metacpan or  search on metacpan

lib/Net/LDAP/SPNEGO.pm  view on Meta::CPAN

    }
    while (my $entry = eval { $search->shift_entry }){
        push @groups, $entry;
    };
    if ($@) {
        warn "Problem fetching search entry $@";
    }
    if ($search->is_error) {
        warn "LDAP Search error: ".$search->error;
    }

    return {
     map {
         scalar $_->get_value('samaccountname') => {
             dn => $_->dn,
             description => scalar $_->get_value('description')
         }
     } @groups
    }
}

# AD LDAP helpers
#
sub _get_base_dn {
 my $self = shift;
 if (not $self->{baseDN}){
     my $rootDSE = $self->search(
         base => '',
         filter => '(objectclass=*)',
         scope => 'base',
         attrs => ['defaultNamingContext'],
     )->entry(0);
     $self->{baseDN} = $rootDSE->get_value('defaultnamingcontext');
 }
 return $self->{baseDN};
}

sub _get_ad_user {
 my $self = shift;
 my $sAMAccountName = shift // '';
 my $user = $self->search(
     base => $self->_get_base_dn,
     scope => 'sub',
     filter => "(sAMAccountName=".escape_filter_value($sAMAccountName).')',
     attrs => [],
 )->entry(0);

 return undef unless ref $user;

 return {
     map {
         lc($_) => scalar $user->get_value($_)
     } $user->attributes
 };
}

sub _ldap_quote {
    return join '', map { sprintf "\\%02x", $_ } unpack('C*',shift);
}
# with inspiration from
# https://github.com/josephglanville/posix-ldap-overlay/blob/master/lib/SID.pm

sub _unpack_sid {
    return unpack 'C Vxx C V*', shift;
}

sub _sid2string {
    my ($rev, $auth, $sa_cnt, @sa) = _unpack_sid(shift);
    return join '-', 'S', $rev, $auth, @sa;
}

sub _sid2rid {
    return [_unpack_sid(shift)]->[-1];
}

sub _rid2sid {
    my ($rev, $auth, $sacnt, @sa) = _unpack_sid(shift);
    $sa[-1] = shift;
    return pack 'C Vxx C V*', $rev, $auth, scalar @sa, @sa;
}


# wrap and send an spnego token
sub _send_spnego {
    my $self = shift;
    my $token = shift;
    my $mesg = Net::LDAP::Message->new($self);
    $mesg->encode(
        bindRequest => {
            name => '',
            version => $self->version,
            authentication => {
                sasl => {
                    mechanism => 'GSS-SPNEGO',
                    credentials => $token
                }
            }
        },
        controls => undef
    );
 $self->_sendmesg($mesg);
}

# our BER encoder and decoder

sub _ber_encoder {
    my $self = shift;
    return $self->{_ber_encoder} if $self->{_ber_encoder};
    my $enc = $self->{_ber_encoder} = Encoding::BER::DER->new( error => sub{ die "BER: $_[1]\n" } );
    $enc->add_implicit_tag('context', 'constructed', 'mechToken', 2,'octet_string');
    $enc->add_implicit_tag('context', 'constructed', 'supportedMech', 1,'oid');
    $enc->add_implicit_tag('context', 'constructed', 'negResult', 0,'enum');
    $enc->add_implicit_tag('application','constructed','spnego',0,'sequence');
};

# prepare the ntlm token for the SPNEGO request to the ldap server
sub _wrap_type1_token {
    my $self = shift;
       my $ntlm_token = shift;
    my $enc = $self->_ber_encoder;
    my $spnegoOID = '1.3.6.1.5.5.2';