#!/usr/local/bin/perl -w
##############################################################################
# $Id: ldapcat_nl,v 1.2 2002/02/22 19:26:47 jheiss Exp $
##############################################################################
# Search LDAP for users or groups and print them out in standard UNIX
# format.
#
# TODO:
# - Fix sorting of output
# - Trap server cert verification failure and print a pretty message
##############################################################################
# $Log: ldapcat_nl,v $
# Revision 1.2  2002/02/22 19:26:47  jheiss
# Updated error message for generic failure with note about not having
# a kerb ticket.
#
# Revision 1.1  2002/02/22 00:45:12  jheiss
# Initial revision
#
##############################################################################

# Includes and such
use MIME::Base64;
use Net::LDAP;
use Authen::SASL;

# Constants
my $CONFIG = '/etc/openldap/ldap.conf';  # Config file for OpenLDAP tools

my $STARTTLS = 1;  # 0 for no, 1 for yes
my $VERIFY_SERVER_CERT = 1;  # 0 for no, 1 for yes
my $CA_CERT = '/etc/openldap/ca.pem';  # Path to CA cert file

# Passed to Authen::SASL->new(), unless you set it to 'NONE', which then
# causes an anonymous bind
my $SASL_TYPE = 'GSSAPI';
my $PRINCIPAL = $ENV{'USER'};

# The binddn doesn't matter given our current setup (where users are
# authorized based on their SASL id), it just gets logged by the server.
my $BINDDN = 'uid=ldapcat';

sub usage
{
	die "Usage: $0 {passwd|group}\n";
}

if (scalar @ARGV == 0)
{
	usage();
}

my $host;
my $base;
my $mesg;

open(CFG, "<$CONFIG") || die "Failed to open $CONFIG\n";
while(<CFG>)
{
	if (/^HOST/ || /^URI/)
	{
		(undef, $host) = split;
		if (/^URI/)
		{
			$host =~ m,ldaps?://(.+)/,;
			$host = $1;
		}
	}
	elsif (/^BASE/)
	{
		(undef, $base) = split;
	}
}
close(CFG);

if (! $host)
{
	die "No HOST or URI entry found in $CONFIG\n";
}
if (! $base)
{
	die "No BASE entry found in $CONFIG\n";
}

# Connect to the server
my $ldap = Net::LDAP->new($host, version => 3) || die "$@";

# Turn on TLS
# An error message like the following indicates the CA cert verification
# failed.  Nice and obvious...
#
# Can't call method "IO::Socket::SSL::get_context_handle" without a package
# or object reference at /usr/local/lib/perl5/site_perl/5.6.1/IO/Socket/SSL.pm
# line 602.
#
if ($STARTTLS)
{
	if ($VERIFY_SERVER_CERT)
	{
		$mesg = $ldap->start_tls(
			verify => 'require',
			cafile => $CA_CERT);
	}
	else
	{
		$mesg = $ldap->start_tls(verify => 'none');
	}
	$mesg->code && die $mesg->error;
}

# Create Authen::SASL object if necessary
my $sasl;
if ($SASL_TYPE eq 'GSSAPI')
{
	$sasl = Authen::SASL->new(
		'GSSAPI',
		'fqdn' => $host,
		'service' => 'ldap',
		'user' => $PRINCIPAL);
}
elsif ($SASL_TYPE ne 'NONE')
{
	die "No support for SASL_TYPE == $SASL_TYPE\n";
}

# Bind to the LDAP server with the appropriate authentication
#
# An error message like the following indicates that the $sasl object is undef
# 
# Can't call method "user" on an undefined value at
# /usr/local/lib/perl5/site_perl/5.6.1/Net/LDAP.pm line 236.
#
# An error message like the following indicates either:
#
# That you don't have a TGT for the principal you've specified.
#   or
# That you didn't specify something right when setting up the
# $sasl object.  Perhaps you specified ldap/$host for the service
# instead of just ldap?  (That one took me a couple of hours to
# figure out...)  It is actually a croak from within
# Authen::SASL::GSSAPI::initial().
#
# generic failure at /usr/local/lib/perl5/site_perl/5.6.1/Net/LDAP.pm line 238
#
if ($SASL_TYPE ne 'NONE')
{
	$mesg = $ldap->bind($BINDDN, sasl => $sasl);
}
else
{
	$mesg = $ldap->bind();
}
$mesg->code && die $mesg->error;

# Perform search
if ($ARGV[0] eq 'passwd')
{
	$mesg = $ldap->search(
		base => $base,
		filter => '(objectClass=posixAccount)',
		attrs => ['uid', 'userPassword', 'uidNumber', 'gidNumber', 'cn',
			'homeDirectory', 'loginShell']);
}
elsif ($ARGV[0] eq 'group')
{
	$mesg = $ldap->search(
		base => $base,
		filter => '(objectClass=posixGroup)',
		attrs => ['cn', 'userPassword', 'gidNumber', 'memberUid']);
}
else
{
	usage();
}

# Check for an error from the search
$mesg->code && die $mesg->error;

# Should sort both passwd and group right, since uidNumber is unique in
# passwd, and uidNumber doesn't exist in group.
# However, it doesn't seem to work...
#foreach my $entry ($mesg->sorted(['uidNumber', 'gidNumber']))
foreach my $entry ($mesg->sorted('uidNumber', 'gidNumber'))
{
	#$entry->dump;
	#next;

	if ($ARGV[0] eq 'passwd')
	{
		print $entry->get_value('uid') . ':';
		print extractpass($entry->get_value('userPassword')) . ':';
		#print "x:";  # Fake password
		print $entry->get_value('uidNumber') . ':';
		print $entry->get_value('gidNumber') . ':';
		print $entry->get_value('cn') . ':';
		print $entry->get_value('homeDirectory') . ':';
		print $entry->get_value('loginShell') . "\n";
	}
	elsif ($ARGV[0] eq 'group')
	{
		print $entry->get_value('cn') . ':';
		print extractpass($entry->get_value('userPassword')) . ':';
		#print "*:";  # Fake password
		print $entry->get_value('gidNumber') . ':';
		if ($entry->get_value('memberUid'))
		{
			print join(',', $entry->get_value('memberUid'));
		}
		print "\n";
	}
}

$ldap->unbind;
exit;

sub extractpass
{
	my $text = shift;

	# Common forms are:
	#
	# {crypt}*
	# {KERBEROS}user@REALM

	$text =~ /^{(\w+)}(.*)/;
	my $passtype = $1;
	my $password = $2;

	#print "passtype:  $1\n";
	#print "password:  $2\n";

	if ($passtype eq 'crypt')
	{
		# If it is a crypt'd password then put the crypt'd string
		# in just like a regular passwd/group file
		return $password
	}
	elsif ($passtype eq 'KERBEROS')
	{
		return '*K*';
	}
	else
	{
		# I don't know what other types there are, so just pass
		# them through
		return $text;
	}
}