#!/usr/bin/perl -T

# This is finger-ldap, a wrapper around finger for machines using LDAP
# Copyright (C) 2004,2005  Simon Law
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;
use warnings;
use English;

use Net::LDAP;

# Untaint the environment
$ENV{PATH} = '/bin:/usr/bin:/usr/X11R6/bin';
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};


# Global variables
my $program = $PROGRAM_NAME;	# This program's name
my $version = '1.3';		# This program's version
my $finger = '/usr/bin/finger.real';	# The finger binary
my $nss_ldap = '/etc/libnss-ldap.conf';	# The libnss-ldap configuration file

# ($base, $base_passwd, $uid_map, $cn_map, @servers) parse_conf ($filename)
#
# This function parses the libnss-ldap configuration file stored in
# $filename to extract the LDAP $base, the LDAP $base_passwd, the
# $uid_map attribute, the $cn_map attribute, and the LDAP @servers
# available to query.
sub parse_conf ($)
{
    my $filename = shift;

    # Open the configuration file
    open (my $fh, "<$filename") or die ("$program: Can't read $filename\n");

    my $base = '';
    my $base_passwd = '';
    my $uid_map = 'uid';
    my $cn_map = 'cn';
    my @servers;
    my @hosts;			# We need to append $port to these
    my $port;
    # Go through each line and try to parse out what we want
    while (<$fh>) {
	# Strip leading and tailing whitespace
	s/^\s*(.*?)\s*$/$1/;

	# Strip out any comments
	s/^\#.*//;
	s/([^\\])\#.*/$1/;

	# Get the base, stripping whitespace
	if (m/^base\s+(.*?)$/) {
	    $base = $1;
	}
	# Get the servers, using the URI
	elsif (m/^uri\s+(.*)/) {
	    push (@servers, split (/\s+/, $1));
	}
	# Get the hosts (deprecated)
	elsif (m/^host\s+(.*)/) {
	    push (@hosts, split (/\s+/, $1));
	}
	# Get the port number (deprecated)
	elsif (m/^port\s+(\d+)/) {
	    $port = $1;
	}
	# Get the base passwd, so we can resolve user entries
	elsif (m/^nss_base_passwd\s+([^?]*)/) {
	    $base_passwd = $1;
	}
	# Get the uid attribute map, if it exists
	elsif (m/^nss_map_attribute\s+uid\s+(.*)/) {
	    $uid_map = $1;
	}
	# Get the cn attribute map, if it exits
	elsif (m/^nss_map_attribute\s+cn\s+(.*)/) {
	    $cn_map = $1;
	}
    }

    # Now, the interesting thing about nss_base_* is that you can omit
    # the suffixes.
    unless ($base_passwd) {
	$base_passwd = $base;
    }
    elsif ($base_passwd =~ m/,$/) {
	$base_passwd .= "$base";
    }
    elsif ($base_passwd =~ m/^[^,]*$/) {
	$base_passwd .= ",$base";
    }

    # If we defined $port, let's tack that on to the end of our @hosts.
    if (defined ($port)) {
	grep {/:/ or $_ .= ":$port"} @hosts;
    }
    push (@servers, @hosts);

    return ($base, $base_passwd, $uid_map, $cn_map, @servers);
}

# \%usernames = get_usernames ($ldap, $arg)
#
# This function queries the $ldap server for userids, using $base as
# the base domain name.
#
# It first queries for an exact userid match.  If that fails, it will
# try to find the user's name.  When it's done, it will return a
# reference to a hash-table whose keys are the usernames that were
# found.
sub get_usernames ($$$$$$)
{
    my $ldap = shift;
    my $base = shift;
    my $base_passwd = shift;
    my $uid_map = shift;
    my $cn_map = shift;
    my $arg = shift;

    # Usernames that should be passed to finger -m
    my %usernames;

    # Net::LDAP::Message is returned for all queries
    my $mesg;

    # Search for the userid first
    $mesg = $ldap->search (base => $base_passwd,
			   filter => "($uid_map=$arg)");
    unless ($mesg->code ()) {
	for my $entry ($mesg->all_entries ()) {
	    if ($entry->get_value ($uid_map)) {
		$usernames{$arg} = 1;
	    }
	}
    }

    unless (scalar (%usernames)) {
	# Search for the user's name then
	$mesg = $ldap->search (base => $base_passwd,
			       filter => "($cn_map=*$arg*)");
	unless ($mesg->code ()) {
	    for my $entry ($mesg->all_entries ()) {
		if (my $result = $entry->get_value ($uid_map)) {
		    $usernames{$result} = 1;
		}
	    }
	}
    }

    return \%usernames;
}


# query_ldap (%usernames);
#
# Connect to the LDAP server, and for any key in %usernames that has a
# value of '2', ask the LDAP server for its username.  When this function
# returns, %usernames should contain strings that will be passed to the
# real finger command.
sub query_ldap(\%)
{
    # Get some information from the libnss-ldap configuration file.
    my ($base, $base_passwd, $uid_map, $cn_map, @servers) =
	parse_conf ($nss_ldap);

    my $usernames = shift;

    # Construct a new Net::LDAP query object
    my $ldap;
    my $error;
    for my $server (@servers) {
	$ldap = Net::LDAP->new ($server);
	unless ($ldap) {
	    $error = $EVAL_ERROR;
	    $error =~ s/^IO.*?: //; # Strip out IO::Foo errors
	}
	else {
	    undef ($error);

	    # Net::LDAP::Message is returned for all queries
	    my $mesg;

	    # Connect to the database
	    $mesg = $ldap->bind ();
	    if ($mesg->code ()) {
		$error = ("Could not bind to LDAP servers: " . $mesg->error ()
			  . "\n");
	    }
	    else {
		undef ($error);
		last;
	    }
	}
    }
    die ("$program: $error\n") if ($error);

    for my $user (keys %$usernames) {
	next unless ($usernames->{$user} == 2);

	# Query the database for usernames
	my $ref = get_usernames ($ldap, $base, $base_passwd, $uid_map,
				 $cn_map, $user);
	# Merge into the primary hash
	if (scalar (%$ref)) {
	    delete ($usernames->{$user});
	    for my $username (keys %$ref) {
		$usernames->{$username} = 1;
	    }
	}
    }

    # Disconnect from the database
    $ldap->unbind ();
}


# int main ()
#
# First, we parse the command-line arguments and decide if we need to
# contact the LDAP server.
#
# We query the usernames from the LDAP server as necessary by matching
# them against the full names.  We pass this information to `finger -m`
# which does the final resolution.
sub main
{
    # Array to store arguments for finger
    my @fingerargs;

    # Parse the command-line
    my %usernames;		# Keys are the usernames
    my $preventmatching = 1;	# Has -m been passed?
    for my $arg (@ARGV) {
	if ($arg =~ m/^-.*m/) {
	    # -m has been passed, we'll let finger do everything
	    $preventmatching = 2;
	    last;
	}
	elsif ($arg =~ m/@/) {
	    # If the userid is on a remote host, let finger deal with it
	    $usernames{$arg} = 1;
	}
	elsif ($arg =~ m/^(-.*)$/) {
	    # This is an argument passed to finger.
	    push (@fingerargs, $1);
	}
	else {
	    # Queue up this username for querying in LDAP
	    $usernames{$arg} = 2;
	    # We will want to contact the LDAP server
	    $preventmatching = 0 unless $preventmatching == 2;
	}
    }

    # Query for the usernames from the LDAP server
    query_ldap(%usernames) unless ($preventmatching);

    # Call finger -m
    my @command;
    if ($preventmatching) {
	@command = ($finger, map { m/^(.*)$/ and $1 } @ARGV);
    }
    else {
	@command = ($finger, '-m', @fingerargs, keys %usernames);
    }
    my $retval = system (@command);

    return $retval;
}
main ();
