#!/usr/bin/perl -w

# Copyright (c) 2003-2017, Larry Lile <lile@FreeBSD.org>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
#    notice unmodified, this list of conditions, and the following
#    disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

# $Header: svn+ssh://lile@svn.code.sf.net/p/ldap-yp-tools/code/tags/RELEASE-1_13/ldap-yp-tools/ldapcat/ldapcat.in 58 2020-09-11 15:36:35Z lile $

use strict;
use URI;
use Net::LDAP;
use Net::LDAP::Control::Sort;
use Net::LDAP::Control::Paged;
use Net::LDAP::Control::VLV;
use Net::LDAP::Constant qw(LDAP_CONTROL_VLVREQUEST LDAP_CONTROL_VLVRESPONSE LDAP_CONTROL_PAGED);
use Getopt::Std;

my (%ldap_opt, %nsswitch, %nss);

# Set this to 0 or undef to disable Paging and VLV support entirely
our $page_size = 1000;

use vars qw/$opt_d $opt_h $opt_k $opt_n $opt_t $opt_w $opt_x $opt_X/;
my @keys;

my $ldap_secret = "/etc/ldap.secret";

my %nickname = (
			passwd	=> "passwd.byname",
			group	=> "group.byname",
			networks=> "networks.byaddr",
			hosts	=> "hosts.byaddr",
			protocols=>"protocols.bynumber",
			services=> "services.byname",
			rpc	=> "rpc.bynumber",
			aliases	=> "mail.aliases",
			ethers	=> "ethers.byname",
		);

my %maps = (
		passwd => {
				filter	=> 'objectclass=posixAccount',
				routine	=> \&passwd,
				byuid	=> 'uidnumber',
				byname	=> 'uid',
				attrs	=> [ qw(uid userPassword uidNumber
					     gidNumber gecos homeDirectory
					     loginShell ) ],
			},
		hosts	=> {
				filter	=> 'objectclass=ipHost',
				routine	=> \&hosts,
				byaddr	=> 'ipHostNumber',
				byname	=> 'cn',
				attrs	=> [ qw(cn ipHostNumber) ],
			},
		group	=> {
				filter	=> 'objectclass=posixGroup',
				routine	=> \&group,
				byname	=> 'cn',
				bymember=> 'memberUid',
				bygid	=> 'gidNumber',
				attrs	=> [ qw(cn gidNumber memberUid ) ],
			},
		networks=> {
				filter	=> 'objectclass=ipNetwork',
				routine	=> \&networks,
				byaddr	=> 'ipNetworkNumber',
				byname	=> 'cn',
				attrs	=> [ qw(cn ipNetworkNumber) ],
			},
		ethers=> {
				filter	=> 'objectclass=ieee802device',
				routine	=> \&ethers,
				byname	=> 'macAddress',
				attrs	=> [ qw(cn macAddress) ],
				base	=> 'ou=ethers,',
			},
		protocols=> {
				filter	=> 'objectclass=ipProtocol',
				routine	=> \&protocols,
				byname	=> 'cn',
				bynumber=> 'ipProtocolNumber',
				attrs	=> [ qw(cn ipProtocolNumber) ],
			},
		rpc	=> {
				filter	=> 'objectclass=oncRpc',
				routine	=> \&rpc,
				byname	=> 'cn',
				bynumber=> 'oncRpcNumber',
				attrs	=> [ qw(cn oncRpcNumber) ],
			},
		netgroup=> {
				filter	=> 'objectclass=nisNetgroup',
				routine	=> \&netgroup,
				byname	=> 'cn',
				attrs	=> [ qw(cn nisNetgroupTriple memberNisNetgroup) ],
			},
		services=> {
				filter	=> 'objectclass=ipService',
				routine	=> \&services,
				byport	=> [ 'ipServicePort', 'ipServiceProtocol' ],
				byname	=> 'cn',
				attrs	=> [ qw(cn ipServicePort ipServiceProtocol) ],
			},
		mail => {
				filter	=> '|(objectClass=mailRecipient)(objectClass=mailGroup)',
				routine	=> \&aliases,
				aliases	=> 'mailalternateaddress',
				attrs   => [ qw(objectClass cn mail mailAlternateAddress
					     mailRoutingAddress mgrpRFC822MailMember) ],
			},
		);
{
	use File::Basename;
	my $name = basename($0, ".pl");

	getopts( 'd:h:kntwxX' )
	    or exit !usage($name);

	exit nicknames() if $opt_x;

	exit !usage($name) if !@ARGV;

	my ($ldap, $result);

	%ldap_opt = get_ldap_config();

	$ldap_opt{'base'} = $opt_d if $opt_d;
	$ldap_opt{'uri'} = $ldap_opt{'url'}
	    if defined $ldap_opt{'url'};

	my $mname;

	if ($name =~ m/ldapmatch/) {
		exit !usage($name) if @ARGV < 2;
		$mname = pop @ARGV;
		@keys = @ARGV;
	} else {
		exit !usage($name) if @ARGV != 1;
		$mname = $ARGV[0];
	}

	$mname = "netgroup.byname" if lc $mname eq "netgroup";
	$mname = $nickname{$mname} if $nickname{$mname} and !$opt_t;

	my ($map, $by) = (split(/\.(by[^\.]+|aliases)$/, $mname, 2), undef, undef);

	if (!defined $maps{$map} and $map =~ m/^(auto|amd)/ ) {
		$map = $mname;
		$by = 'byname';
		my $auto_filter = "&(objectclass=nisObject)(nisMapName=$map)";
		$auto_filter = "($auto_filter)" if $name !~ m/ldapmatch/;
		$maps{$map} = {
				filter => $auto_filter,
				routine => \&autofs,
				byname => 'cn',
				attrs	=> [ qw(cn nisMapEntry
					     nisMapName) ],
				};
	}

	if ($map =~ m/^ethers/ ) {
		$by = 'byname' if ! defined $by;
		$maps{$map} = {
				filter	=> $maps{'ethers'}{'filter'},
				routine	=> $maps{'ethers'}{'routine'},
				byname	=> $maps{'ethers'}{'byname'},
				attrs	=> $maps{'ethers'}{'attrs'},
				base	=> sprintf("ou=%s,", $map),
				};
	}

	if ($by and ! defined $maps{$map}{$by}) {
		print STDERR "Can't find key ", join(", ", @keys),
		    " in map $mname.  Reason: " if $name =~ m/ldapmatch/;
		die "no such map in server's domain\n"
	}

	die "No such map $map. Reason: No such map in server's domain\n"
	    if ! defined $by and ! defined $maps{$map};

	my $attrs = [ qw(*) ];;
	$attrs = $maps{$map}{'attrs'} if defined $maps{$map}{'attrs'};

	my $filter;
	if ($name =~ m/ldapmatch/ and !defined $maps{$map}{'nomatchfilter'} and $by) {
		$filter = "(&(" . $maps{$map}{'filter'} . ")(|";
		foreach (@keys) {
			$filter .= sprintf("(%s=%s)", $maps{$map}{$by}, $_);
		}
		$filter .= "))";
	} else {
		$filter = $maps{$map}{'filter'};
	}

	# The services.byport map uses a compound key ipPort/ipProtocol.
	if ($name =~ m/ldapmatch/ and $map eq "services" and $by eq "byport")
	{
		$filter = "(&(" . $maps{$map}{'filter'} . ")(|";
		foreach (@keys) {
			$filter .= "(&";
			my (@parms) = split(/\s*\/\s*/, $_);
			foreach (@{$maps{$map}{$by}})
			{
				$filter .= sprintf("(%s=%s)", $_, shift @parms);
			}
			$filter .= ")";
		}
		$filter .= "))";
	}

	%nsswitch = get_nsswitch_config();

	my $nss_ldap_conf = "/etc/ldap.conf";
	$nss_ldap_conf = "/etc/pam_ldap.conf" if -f "/etc/pam_ldap.conf";
	%nss = read_conf_s($nss_ldap_conf);

	my %sss;
	if ( ($map =~ /^(auto|amd)/ and defined $nsswitch{'automount'}{'sss'}) or
	     (defined $nsswitch{$map}{'sss'})) {
		%sss = read_ini("/etc/sssd/sssd.conf");
	}

	my %autofs = read_conf("/etc/default/autofs", "/etc/sysconfig/autofs", "/etc/autofs.conf");

	if (%sss) {
		my %service = map { lc $_ => $_ } split(/\s+|\s*,\s*/, $sss{'sssd'}{'services'});
		my @domain = split(/\s+|\s*,\s*/, $sss{'sssd'}{'domains'});

		if ( defined $service{'nss'} ) {
			foreach (@domain) {
				if ( $sss{"domain/$_"}{'id_provider'} eq "ldap" and
				     defined $sss{"domain/$_"}{'ldap_uri'} ) {
					$ldap_opt{'uri'} = $sss{"domain/$_"}{'ldap_uri'};
					$ldap_opt{'uri'} =~ s/\s*,\s*/ /g;
					$ldap_opt{'uri'} =~ s/\/$//g;
					last;
				}
			}
		}

		if (!defined $opt_d and $map =~ /^(auto|amd)/ and defined $service{'autofs'})
		{
			if (defined $sss{'autofs'}{'ldap_autofs_search_base'} ) {
				$ldap_opt{'base'} = $sss{'autofs'}{'ldap_autofs_search_base'};
			}
		}
	}

	if (!defined $opt_d and %autofs and $map =~ /^(auto|amd)/ and defined $autofs{'search_base'}) {
		$ldap_opt{'base'} = $autofs{'search_base'};
	}

	my @servers;

	@servers = split(/\s+/, $ldap_opt{'uri'}) if $ldap_opt{'uri'};

	if (defined $ldap_opt{'host'})
	{
		foreach my $host (split(/\s+/, $ldap_opt{'host'}))
		{
			if ($host =~ /^ldap:\/\//i)
			{
				push @servers, "ldap://$host";
			}
			else
			{
				push @servers, "ldap://$host";
			}
		}
	}

	if (defined $opt_h)
	{
		my @uri;
		foreach my $entry (split(/\s*,\s*|\s+/, $opt_h))
		{
			if ($entry =~ m!^ldaps?://!)
			{
				push @uri, $entry;
			} else {
				my ($host, $port) = split(/:/, $entry, 2);
				$port = 389 if ! defined $port;
				if ($port == 636) {
					push @uri, "ldaps://$host:$port";
				} else {
					push @uri, "ldap://$host:$port";
				}
			}
		}
		@servers = @uri if @uri;
	}

	foreach my $server (@servers) {

		my $uri = URI->new($server);
		$server = $uri->host;
		my $port = defined $uri->port ? $uri->port : $ldap_opt{'port'};

		($ldap, $result) = ldap_connect($server, $port);
		warn $@ and next if ! $ldap;

		if ($result and $result->code) {
			warn "Failed to bind $server: ", $result->error, "\n";
			next;
		} elsif ($result) {
			last;
		}
	}

	die "\n" if ! $ldap or ! $result;

	if(defined $opt_w) {
		print "# WARNING!  This file is now automatically generated with ldapcat.\n";
		print "# Please consult the crontabs before modifying this file.\n";
	}

	my $dse = $ldap->root_dse();
	my $paged_supported = $dse->supported_control(LDAP_CONTROL_PAGED)
	    if $page_size;
	my $vlv_supported = $dse->supported_control(LDAP_CONTROL_VLVREQUEST)
	    if ! defined $paged_supported and $page_size;

	my $sort = Net::LDAP::Control::Sort->new(order => 'uid cn');

	my $vlv = Net::LDAP::Control::VLV->new(
						before	=> 0,
						after	=> $page_size,
						content	=> 0,
						offset	=> 1,
						);

	my $page = Net::LDAP::Control::Paged->new(size => $page_size);
	my $cookie;

	# XXX Prefer paged over vlv as vlv indexes need to have been
	# built by the administrator to be efficient
	my @controls;
	@controls = ( $vlv, $sort ) if $vlv_supported;
	@controls = ( $page ) if $paged_supported;

	my $base = $ldap_opt{'base'};
	my $scope = 'sub';

	$base = $maps{$map}{'base'} if defined $maps{$map}{'base'};
	$base .= $ldap_opt{'base'} if $base =~ /,$/;

	my $nss_map_base = sprintf "nss_base_%s", $map;

	if (defined $nss{$nss_map_base})
	{
		my $uri = URI->new('ldap:///' . $nss{$nss_map_base});
		$base = $uri->dn;
		$scope = $uri->_scope if $uri->_scope;
		$filter = $uri->_filter if $uri->_filter;
	}

	my @args = (
			base	=> $base,
			filter	=> $filter,
	 		scope	=> $scope,
	 		attrs	=> $attrs,
			control	=> \@controls,
		);

	my @bar;
	while (1)
	{
		my $result = $ldap->search( @args );

		if ($vlv_supported) {
			my $vlv_resp = $result->control(LDAP_CONTROL_VLVRESPONSE)
			    or die "VLV error: ", $result->error, "\n";
			$vlv->response($vlv_resp);
		}

		die "no such map in server's domain\n"
		    if $result->code and $result->error =~ m/No such object/i;

		$result->code and die $result->error, ": ", $result->code;

		die "Can't find key ", join(", ", @keys),
		    " in map $mname.  Reason: key not found in map.\n"
			if $result->count == 0;

		foreach ($result->entries) {
			my @foo = &{$maps{$map}{'routine'}}($map, $by, $_, @keys);
			push @bar, (@foo) if @foo;
		}

		if ($vlv_supported) {
			$vlv->scroll_page(1);

			last if $vlv->after == 0;

			if ($vlv_supported and $vlv->before > 0) {
				$vlv->after($vlv->before);
				$vlv->before(0);
			}
		} elsif ($paged_supported) {
			my ($mesg) = $result->control(LDAP_CONTROL_PAGED) or last;
			$cookie = $mesg->cookie;
			last if (!defined($cookie) || !length($cookie));
			$page->cookie($cookie);
		} else {
			last;
		}
	}

	if ($paged_supported and defined $cookie) {
		$page->cookie($cookie);
		$page->size(0);
		$ldap->search(@args);
	}

	print join("\n", @bar), "\n"
	    if @bar;

	$ldap->unbind();

	die "Can't find key ", join(", ", @keys),
	    " in map $mname.  Reason: key not found in map.\n"
	    if !@bar and !$result->code and $name =~ m/ldapmatch/;
}

sub usage
{
	my $name = shift;
	print "Usage:\n";
	if ($name =~ m/ldapmatch/) {
		print "        $name [-ktwX] [ -d basedn ] [ -h hostname ] key ... mapname\n";
	} else {
		print "        $name [-ktwX] [ -d basedn ] [ -h hostname ] mapname\n";
	}
	print "        $name -x\n";
	return 0;
}

sub result_set
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my $rc  = shift;
	my @keys= (@_);
	my @rc;

	my %keys = map { lc $_ => $_ } @keys;

	my @aliases = $entry->get_value($maps{$map}{$by});

	# services.byport uses a compound key
	if (lc $map eq "services" and lc $by eq "byport")
	{
		my $port = $entry->exists('ipServicePort') ?
		    $entry->get_value('ipServicePort') : '';
		my $protocol = $entry->exists('ipServiceProtocol') ?
		    $entry->get_value('ipServiceProtocol') : '';
		undef @aliases;
		push @aliases, "$port/$protocol";
	}

	if (@keys)
	{
		foreach (sort @aliases)
		{
			if (exists $keys{lc $_})
			{
				if ($opt_k)
				{
					push @rc, join(" ", $_, $rc);
				} else {
					push @rc, $rc if length($rc) > 0;
				}
			}
		}
	} else {
		if ($opt_k)
		{
			foreach my $key (@aliases)
			{
				push @rc, join(" ", $key, $rc);
			}
		} else {
			push @rc, $rc if length($rc) > 0;
		}
	}
	@rc;
}

sub passwd
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);
	my @data;

	push @data, $entry->exists('uid') ? $entry->get_value('uid') : '';
	if ($entry->exists('userPassword') and
	    $entry->get_value('userPassword') =~ m/^{crypt}(.*)/i) {
		push @data, $1;
	} else {
		push @data, "x";
	}
	push @data, $entry->exists('uidNumber') ?
	    $entry->get_value('uidNumber') : '';
	push @data, $entry->exists('gidNumber') ?
	    $entry->get_value('gidNumber') : '';
	push @data, $entry->exists('gecos') ?
	    $entry->get_value('gecos') : '';
	push @data, $entry->exists('homeDirectory') ?
	    $entry->get_value('homeDirectory') : '';
	push @data, $entry->exists('loginShell') ?
	    $entry->get_value('loginShell') : '';

	my $rc = join(":", @data);

	result_set($map, $by, $entry, $rc, @keys);
}

sub hosts
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my $ip = $entry->exists('ipHostNumber') ?
	    $entry->get_value('ipHostNumber') : '';
	my @name = $entry->get_value('cn');
	@name = (shift @name, sort @name) if @name > 1;

	my $rc = join("\t", $ip, @name);

	result_set($map, $by, $entry, $rc, @keys);
}

sub group
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my $name = $entry->exists('cn') ?
	    $entry->get_value('cn') : '';
	my $gid = $entry->exists('gidNumber') ?
	    $entry->get_value('gidNumber') : '';
	my @members = $entry->exists('memberUid') ?
	    sort $entry->get_value('memberUid') : '';

	my $rc = join(":", $name, '*', $gid, join(",", @members));

	result_set($map, $by, $entry, $rc, @keys);
}

sub networks
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my $network = $entry->exists('ipNetworkNumber') ?
	    $entry->get_value('ipNetworkNumber') : '';
	my @name = $entry->get_value('cn');
	@name = (shift @name, sort @name) if @name > 1;

	my $rc = join(" ", shift @name, $network, @name);

	result_set($map, $by, $entry, $rc, @keys);
}

sub ethers
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my $ether = $entry->exists('macAddress') ?
	    $entry->get_value('macAddress') : '';
	my @name = $entry->get_value('cn');
	@name = (shift @name, sort @name) if @name > 1;

	my $rc = join(" ", @name);

	result_set($map, $by, $entry, $rc, @keys);
}

sub protocols
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my $protocol = $entry->exists('ipProtocolNumber') ?
	    $entry->get_value('ipProtocolNumber') : '';
	my @name = $entry->get_value('cn');
	@name = (shift @name, sort @name) if @name > 1;

	my $rc = join(" ", shift @name, $protocol, @name);

	result_set($map, $by, $entry, $rc, @keys);
}

sub rpc
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my $rpc = $entry->exists('oncRpcNumber') ?
	    $entry->get_value('oncRpcNumber') : '';
	my @name = $entry->get_value('cn');
	@name = (shift @name, sort @name) if @name > 1;

	my $rc = join(" ", shift @name, $rpc, @name);

	result_set($map, $by, $entry, $rc, @keys);
}

sub netgroup
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my $name = $entry->get_value('cn');
	my @triples;

	if ($opt_n)
	{
		foreach my $triple ($entry->get_value('nisNetgroupTriple'))
		{
			$triple =~ s/(^\s*\(|\)\s*$)//g;
			my ($host, $user, $domain) = split(/\s*,\s*/, $triple);
			my $addr = (gethostbyname($host))[4];
			$host = $addr ? join('.', unpack('C4', $addr)) : $host;
			$user = (getpwnam($user))[2] || $user;
			push @triples, "(" . join(",", $host, $user, $domain) . ")";
		}
	}
	else
	{
		push @triples, ($entry->get_value('nisNetgroupTriple'))
		    if $entry->exists('nisNetgroupTriple');
	}
	push @triples, ($entry->get_value('memberNisNetgroup'))
	    if $entry->exists('memberNisNetgroup');

	my $rc = join(" ", sort @triples);

	result_set($map, $by, $entry, $rc, @keys);
}

sub services
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my $port = $entry->exists('ipServicePort') ?
	    $entry->get_value('ipServicePort') : '';
	my $protocol = $entry->exists('ipServiceProtocol') ?
	    $entry->get_value('ipServiceProtocol') : '';
	my @name = $entry->get_value('cn');

	my $rc = join(" ", shift @name, "$port/$protocol", @name);

	result_set($map, $by, $entry, $rc, @keys);
}

sub autofs
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my $map_entry = $entry->exists('nisMapEntry') ?
	    $entry->get_value('nisMapEntry') : '';

	my $rc = $map_entry;
	$rc =~ s/(ldap:'{0,1}nismapname=([\w.\-&]+)\S*)/yp:$2/ if $opt_X;

	result_set($map, $by, $entry, $rc, @keys);
}

sub aliases
{
	my $map	= shift;
	my $by	= shift;
	my $entry=shift;
	my @keys= (@_);

	my @aliases;

	my @objectclasses = $entry->get_value('objectclass');
	my %objectclasses = map { lc $_ => $_ } @objectclasses;

	if (exists $objectclasses{"mailrecipient"} and
	    $entry->exists('mailroutingaddress'))
	{
		my @altaddresses = $entry->get_value('mailalternateaddress');
		my $mailrouting = $entry->get_value('mailroutingaddress');

		push @altaddresses, $entry->get_value('mail')
		    if $entry->exists('mail');

		# Calculate unique addresses, strip domains.
		my %altaddresses = map { $_ =~ s/\@\S+//;lc $_ => 1 } @altaddresses;

		foreach my $addr (sort keys %altaddresses) {
			my $rc = $mailrouting;
			@aliases = result_set($map, $by, $entry, $rc, @keys);
		}
	}
	if (exists $objectclasses{"mailgroup"} and
	    $entry->exists('cn'))
	{
		my $mail = $entry->get_value('cn');
		$mail =~ s/\@\S+//; # Remove everything after the @ sign
		my @addresses = $entry->get_value('mgrprfc822mailmember');
		my %addresses = map { lc $_ => 1 } @addresses;
		my $rc = join(",", sort keys %addresses);
		@aliases = result_set($map, $by, $entry, $rc, @keys);
	}
	@aliases;
}

sub nicknames
{
	foreach (keys %nickname) {
		print "Use \"$_\"\tfor map \"",$nickname{$_},"\"\n";
	}
	return 0;
}

sub ldap_connect
{
	my $server  = shift;
	my $port    = shift;

	my $fqdn;
	my $scheme = 'ldap';
	my ($ldap, $result);
	my ($binddn, $bindpw);

	# Use the bind credentials specified for NSS & PAM if found
	$binddn = $nss{'binddn'} if defined $nss{'binddn'};
	$bindpw = $nss{'bindpw'} if defined $nss{'bindpw'};

	# Use the root bind credentials specified for NSS & PAM if
	# they have been provided and we can access the password
	if (defined $nss{'rootbinddn'} and -r $ldap_secret)
	{
		$binddn = $nss{'rootbinddn'};
		if (open (SECRET, "<", $ldap_secret))
		{
			# Grab only the first line in the file
			my ($pw, undef) = split(/\n/, <SECRET>, 2);
			close SECRET;
			$bindpw = $pw;
		}
	}

	# Get our fqdn, we will need it if we authenticate
	if (!(($fqdn) = gethostbyname($server))) {
		$@ = "Unable to resolve host name $server\n";
		return undef;
	}

	$scheme = 'ldaps' if ($port != 389);

	# Simple authentication to LDAP
	if (!($ldap = new Net::LDAP(
				$server,
				port	=> $port,
				scheme	=> $scheme,
				version	=> 3,
				))) {
		$@ = "Unable to init for $server: $@\n";
		return;
	}

	if (eval "require Authen::SASL::Perl::GSSAPI")
	{
		require Authen::SASL;
		my $sasl = Authen::SASL->new(
				'GSSAPI',
				'service'=> 'ldap',
				'fqdn'	=> $server,
				'user'	=> '',
				);

		$result = $ldap->bind(sasl => $sasl);
		return ($ldap, $result) if ! $result->code;
	}

	# Bind with specified credentials and password
	if (defined $binddn and defined $bindpw)
	{
		$result = $ldap->bind($binddn, password => $bindpw);
		return ($ldap, $result) if ! $result->code;
	}

	# Bind with specified credentials but no password
	if (defined $binddn)
	{
		$result = $ldap->bind($binddn);
		return ($ldap, $result) if ! $result->code;
	}

	# Anonymous
	$result = $ldap->bind;

	return ($ldap, $result);
}

sub get_nsswitch_config
{
	my $conf = '/etc/nsswitch.conf';
	my %rc;

	return if ! -e $conf;

	open (FILE, "<", $conf) or warn "Failed to open $conf: $!\n";

	while (<FILE>) {
		chomp;
		s/#.*|^\s+|\s+$//;
		if (length $_) {
			my $pri = 1;
			my ($key, $value) = split(/\s*:\s*/, $_, 2);
			# Clear matching begin/end quotes on values
			$value =~ s/^(['"])(.*?)\1/$2/;
			my @value = split(/\s+/, $value);
			$rc{lc $key} = { map { lc $_ => $pri++ } @value };
		}
	}
	return %rc;
}

sub get_ldap_config
{
	# Location of the OpenLDAP config file
	my @conf = qw( /etc/openldap/ldap.conf /etc/ldap/ldap.conf ~/.ldaprc ./.ldaprc );
	my %opts;

	foreach my $file (@conf) {
		# Open the config file
		$file =~ s/\~/$ENV{HOME}/e if $ENV{HOME};
		open (FILE, "<$file") or next;

		# Parse out the values we are interested in
		# server, basedn and port
		while (<FILE>) {
			s/#.*//;
			$opts{lc $1} = $2 if (m/\b(\w+)\b\s+(.*)/);
		}

		# Close the file
		close FILE;
	}

	return %opts;
}

sub read_ini
{
	my $file = shift;

	my %rc;

	return if ! -e $file;

	open (FILE, "<", $file) or return; #warn "Failed to open $file: $!\n";

	my $section;

	while (<FILE>) {
		chomp;
		s/#.*|^\s+|\s+$//;
		if (length $_ and $_ =~ /^\[\s*(.*?)\s*\]/) {
			$section = $1;
			next;
		}
		if (length $_ and defined $section) {
			my ($key, $value) = split(/\s*=\s*/, $_, 2);
			# Clear matching begin/end quotes on values
			$value =~ s/^(['"])(.*?)\1/$2/;
			$rc{lc $section}{lc $key} = $value;
		}
	}
	return %rc;
}

sub read_conf_s
{
	my $file = shift;

	my %rc;

	return if ! -e $file;

	open (FILE, "<", $file) or warn "Failed to open $file: $!\n";

	while (<FILE>) {
		chomp;
		s/#.*|^\s+|\s+$//;
		if (length $_) {
			my ($key, $value) = split(/\s+/, $_, 2);
			# Clear matching begin/end quotes on values
			$value =~ s/^(['"])(.*?)\1/$2/;
			$rc{lc $key} = $value;
		}
	}
	return %rc;
}

sub read_conf
{
	# Location of the OpenLDAP config file
	my @conf = (@_);
	my %rc;

	foreach my $file (@conf) {

		next if ! -e $file;

		open (FILE, "<", $file) or warn "Failed to open $file: $!\n";

		while (<FILE>) {
			chomp;
			s/#.*|^\s+|\s+$//;
			if (length $_) {
				my ($key, $value) = split(/\s*=\s*/, $_, 2);
				# Clear matching begin/end quotes on values
				$value =~ s/^(['"])(.*?)\1/$2/ if defined $value;
				$rc{lc $key} = $value;
			}
		}
	}
	return %rc;
}
