#!/usr/bin/perl -w

# Copyright (c) 2003-2010, 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.

# $Id: ldapcat,v 1.9 2010/05/26 20:00:01 lile Exp $

use strict;
use Sys::Hostname;
use Net::LDAP;
use Getopt::Std;

my (%ldap_opt, $j, $sendmailMTACluster);

# Until we can find a better way.
$sendmailMTACluster = "internal-mta";
$j = "";

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

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',
			},
		hosts	=> {
				filter	=> 'objectclass=ipHost',
				routine	=> \&hosts,
				byaddr	=> 'ipHostNumber',
				byname	=> 'cn',
			},
		group	=> {
				filter	=> 'objectclass=posixGroup',
				routine	=> \&group,
				byname	=> 'cn',
				#bymember=> 'memberUid',	# XXX Yeah, right...
				bygid	=> 'gidNumber',
			},
		networks=> {
				filter	=> 'objectclass=ipNetwork',
				routine	=> \&networks,
				byaddr	=> 'ipNetworkNumber',
				byname	=> 'cn',
			},
		ethers=> {
				filter	=> 'objectclass=ieee802device',
				routine	=> \&ethers,
				byaddr	=> 'macAddress',
				byname	=> 'cn',
			},
		protocols=> {
				filter	=> 'objectclass=ipProtocol',
				routine	=> \&protocols,
				byname	=> 'cn',
				bynumber=> 'ipProtocolNumber',
				
			},
		rpc	=> {
				filter	=> 'objectclass=oncRpc',
				routine	=> \&rpc,
				byname	=> 'cn',
				bynumber=> 'oncRpcNumber',
			},
		netgroup=> {
				filter	=> 'objectclass=nisNetgroup',
				routine	=> \&netgroup,
			},
		services=> {
				filter	=> 'objectclass=ipService',
				routine	=> \&services,
				byname	=> 'cn',
			},
		mail2	=> {
				filter	=> '(|(objectclass=mailRecipient)(objectclass=mailGroup))',
				routine	=> \&aliases,
				aliases	=> 'cn',
				nomatchfilter => 1,
			},
		mail	=> {
				filter	=> "(&(objectClass=sendmailMTAAliasObject)(sendmailMTAAliasGrouping=aliases)" .
					    "(|(sendmailMTACluster=$sendmailMTACluster)(sendmailMTAHost=$j)))",
				routine	=> \&aliases2,
				aliases	=> 'sendmailMTAKey',
				nomatchfilter => 1,
			},
		);
{
	use File::Basename;
	my $name = basename($0, ".pl");

	getopts( 'ktd:xXwn' )
	    or exit !usage($name);

	exit nicknames() if $opt_x;

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

	# Set hostname for SendmailMTA queries
	$j = hostname();

	my ($ldap, $result);

	%ldap_opt = get_ldap_config();

	$ldap_opt{'base'} = $opt_d if $opt_d;

	foreach my $server (split(/\s+/, $ldap_opt{'host'})) {

		($server, my $port) = split(/:/, $server, 2);
		$port = $ldap_opt{'port'} if ! $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;

	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];
	}

	# XXX - I don't think -t is a good idea
	$mname = $nickname{$mname} if $nickname{$mname}; # and !$opt_t;
	$opt_t = $opt_t if $opt_t; # quiet warnings

	my ($map, $by) = (split(/\./, $mname, 2), undef, undef);

	if (!defined $maps{$map}) {
		$map = $mname;
		$by = undef;
		$maps{$map} = {
				filter => "(&(objectclass=nisObject)(nisMapName=$map))",
				routine => \&autofs,
				};
	}

	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"
	}

	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'};
	}

	$result = $ldap->search(
				base	=> $ldap_opt{'base'},
				filter	=> $filter,
		 		scope	=> 'sub',
				);

	$result->code and die $result->error;

	die "no such map in server's domain\n" if $result->count == 0;

	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 @bar;
	foreach ($result->entries) {
		my @foo = &{$maps{$map}{'routine'}}($map, $by, $_, @keys);
		push @bar, (@foo) if @foo;
	}
	print join("\n", @bar, "");

	$ldap->unbind();

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

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

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);

	my $key = $entry->get_value($maps{$map}{$by});
	return if @keys and ! grep { /^$key$/ } @keys;

	if ($opt_k) {
		$rc = join(" ", $key, $rc);
	} else {
		$rc;
	}
}

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);

	my $key = $entry->get_value($maps{$map}{$by});
	return if @keys and ! grep { /^$key$/ } @keys;

	if ($opt_k) {
		$rc = join(" ", $key, $rc);
	} else {
		$rc;
	}
}

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));

	my $key = $entry->get_value($maps{$map}{$by});
	return if @keys and ! grep { /^$key$/ } @keys;

	if ($opt_k) {
		$rc = join(" ", $key, $rc);
	} else {
		$rc;
	}
}

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);

	my @regkeys = $entry->get_value($maps{$map}{$by});
	my $key = join("|", @regkeys);
	return if @keys and ! grep { /^$key$/ } @keys;

	if ($opt_k) {
		my $key = $entry->get_value($maps{$map}{$by});
		$rc = join(" ", $key, $rc);
	} else {
		$rc;
	}
}

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(" ", $ether, @name);

	my @regkeys = $entry->get_value($maps{$map}{$by});
	my $key = join("|", @regkeys);
	return if @keys and ! grep { /^$key$/ } @keys;

	if ($opt_k) {
		my $key = $entry->get_value($maps{$map}{$by});
		$rc = join(" ", $key, $rc);
	} else {
		$rc;
	}
}

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);

	my @regkeys = $entry->get_value($maps{$map}{$by});
	my $key = join("|", @regkeys);
	return if @keys and ! grep { /^$key$/ } @keys;

	if ($opt_k) {
		my $key = $entry->get_value($maps{$map}{$by});
		$rc = join(" ", $key, $rc);
	} else {
		$rc;
	}
}

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);

	my @regkeys = $entry->get_value($maps{$map}{$by});
	my $key = join("|", @regkeys);
	return if @keys and ! grep { /^$key$/ } @keys;

	if ($opt_k) {
		my $key = $entry->get_value($maps{$map}{$by});
		$rc = join(" ", $key, $rc);
	} else {
		$rc;
	}
}

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');

	return if @keys and ! grep { /^$name$/ } @keys;

	my $rc = join(" ", sort @triples);
	if ($opt_k) {
		$rc = join(" ", $name, $rc);
	} else {
		$rc;
	}
}

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);

	return if @keys and ! grep { /^$port\/$protocol$/ } @keys;

	if ($opt_k) {
		$rc = join(" ", "$port/$protocol", $rc);
	} else {
		$rc;
	}
}

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;

	my $key = $entry->get_value('cn');
	return if @keys and ! grep { /^\Q$key\E$/ } @keys;

	if ($opt_k) {
		my $key = $entry->get_value('cn');
		$key = '*' if $key eq /\//;
		$rc = join(" ", $key, $rc);
	} else {
		$rc;
	}
}

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

	my @aliases;
	my @objectclasses = $entry->get_value('objectclass');
	@objectclasses = grep { /mailRecipient/i or /mailGroup/i } @objectclasses;

	if (lc $objectclasses[0] eq "mailrecipient" and
	    $entry->exists('mailroutingaddress')) {
		my $mail = $entry->get_value('mail');
		my @altaddresses = $entry->get_value('mailalternateaddress');
		my $mailrouting = $entry->get_value('mailroutingaddress');

		if ($mail) {
			$mail =~ s/\@\S+//; # Remove everything after the @ sign
			push @aliases, "$mail: $mailrouting";
		}

		foreach my $addr (@altaddresses) {
			$addr =~ s/\@\S+//; # Remove everything after the @ sign
			push @aliases, "$addr: $mailrouting";
		}

	} elsif (lc $objectclasses[0] eq "mailgroup") {
		my $mail = $entry->get_value('cn');
		$mail =~ s/\@\S+//; # Remove everything after the @ sign
		my @addresses = $entry->get_value('mgrprfc822mailmember');
		push @aliases, "$mail: " . join(",",sort @addresses);
	
	}
	if (@keys) {
		my @matched;
		foreach my $key (@keys) {
			my @foo = grep { /^\Q$key\E:/ } @aliases;
			push @matched, @foo if @foo;
		}
		return @matched;
	}
	@aliases;
}

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

	my @aliases;

	foreach my $addr ($entry->get_value('sendmailMTAKey'))
	{
		my @addresses = $entry->get_value('sendmailMTAAliasValue');
		push @aliases, "$addr: " . (@addresses ? join(",",sort @addresses) : '');
	}

	if (@keys) {
		my @matched;
		foreach my $key (@keys) {
			my @foo = grep { /^\Q$key\E:/ } @aliases;
			push @matched, @foo if @foo;
		}
		return @matched;
	}
	@aliases;
}

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

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

	my $fqdn;
	my $result;
	my $ldap;

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

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

	# Anonymous
	$result = $ldap->bind;

	return ($ldap, $result);
}

sub get_ldap_config
{
	# Location of the OpenLDAP config file
	my @conf = qw( /etc/openldap/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;
}
