#!/usr/bin/env perl
##
## Administration tool for the name servies by the LDAP server
##
## Copyright (c) 2006-2007 SATOH Fumiyas @ OSS Technology, Japan
##                         <http://www.osstech.co.jp/>
##
## Date: 2006-06-17, since 2006-04-20
##
## See also:
##	RFC 2307: An Approach for Using LDAP as a Network Information Service

use strict;
use warnings;
use English qw(-no_match_vars);
use Switch;
use Getopt::Long;
use Net::LDAP::Constant qw(LDAP_NO_SUCH_OBJECT);

## I don't like smbldap-tools, but this script depends on it. :-p
use smbldap_tools;

## Options
## ======================================================================

my $op = 'show-entry';
my $desc = '';
my $debug_ldap = 0;
my $key_splitter = '/';

my %db_info = (
    'aliases' => {
	'ou' =>			'ou=Aliases',
	'object_class' =>	'mailGroup',
	'object_class_sub' =>	[],
	'key_desc' =>		'Local name',
	'key_attr' =>		[ 'cn', ],
	'key_attr_clone' =>	[ 'mail', ],
	'key_regex' =>		qr/^\w[\w\-\.]*$/,
	'key_translator' =>	undef,
	'value_desc' =>		'E-mail address(es) and/or command-line(s)',
	'value_attr' =>		'mgrpRFC822MailMember',
	'value_regex' =>	undef,
	'has_many' =>		1,
	'has_description' =>	0,
	'need_description' =>	0,
	'description' =>	'Mail aliases',
    },
    'bootparams'  => {
	'ou' =>			'ou=Ethers',
	'object_class' =>	'bootableDevice',
	'object_class_sub' =>	[ 'device' ],
	'key_desc' =>		'Device\'s hostname',
	'key_attr' =>		[ 'cn' ],
	'key_attr_clone' =>	[],
	'key_regex' =>		qr/^(?:\w[\w\-]*|\*)$/,
	'key_translator' =>	undef,
	'value_desc' =>		'Boot parameter(s)',
	'value_attr' =>		'bootParameter',
	'value_regex' =>	qr/^\w+=\S*:\S*$/, ## FIXME: Correct?
	'has_many' =>		1,
	'has_description' =>	1,
	'need_description' =>	0,
	'description' =>	'Boot parameters for devices',
    },
    'ethers' => {
	'ou' =>			'ou=Ethers',
	'object_class' =>	'ieee802Device',
	'object_class_sub' =>	[ 'device' ],
	'key_desc' =>		'Hostname',
	'key_attr' =>		[ 'cn' ],
	'key_attr_clone' =>	[],
	'key_regex' =>		qr/^\w[\w\-]*$/,
	'key_translator' =>	undef,
	'value_desc' =>		'Ethernet MAC address',
	'value_attr' =>		'macAddress',
	'value_regex' =>	qr/^(?:[\da-f]{1,2})(?::[\da-f]{1,2}){5}$/i,
	'has_many' =>		0,
	'has_description' =>	1,
	'need_description' =>	0,
	'description' =>	'Ehternet MAC addresses to IP number',
    },
    'networks' => {
	'ou' =>			'ou=Networks',
	'object_class' =>	'ipNetwork',
	'object_class_sub' =>	[],
	'key_desc' =>		'Network number',
	'key_attr' =>		[ 'ipNetworkNumber' ],
	'key_attr_clone' =>	[],
	'key_regex' =>		undef,
	'key_translator' =>	sub {
	    my @dec = grep { /^\d+$/ && $_ >= 0 && $_ <= 255 } split(/\./, $_[0]);
	    return () if (@dec != 4);
	    my $network = sprintf('%d.%d.%d.%d', @dec);
	    return ($network);
	},
	'value_desc' =>		'Network name(s)',
	'value_attr' =>		'cn',
	'value_regex' =>	qr/^\w[\w\-\.]*$/,
	'has_many' =>		1,
	'has_description' =>	1,
	'need_description' =>	0,
	'description' =>	'IP network names',
    },
    'netmasks' => {
	'ou' =>			'ou=Networks',
	'object_class' =>	'ipNetwork',
	'object_class_sub' =>	[],
	'key_desc' =>		'Network number',
	'key_attr' =>		[ 'ipNetworkNumber', ],
	'key_attr_clone' =>	[ 'cn' ],
	'key_regex' =>		undef,
	'key_translator' =>	sub {
	    my @dec = grep { /^\d+$/ && $_ >= 0 && $_ <= 255 } split(/\./, $_[0]);
	    return if (@dec != 4);
	    return (sprintf('%d.%d.%d.%d', @dec));
	},
	'value_desc' =>		'Network mask',
	'value_attr' =>		'ipNetmaskNumber',
	'value_regex' =>	qr/^\d{1,3}(?:\.\d{1,3}){3}$/, ## FIXME: To be corrected
	'has_many' =>		0,
	'has_description' =>	1,
	'need_description' =>	0,
	'description' =>	'IP network masks',
    },
    'protocols' => { ## OK
	'ou' =>			'ou=Protocols',
	'object_class' =>	'ipProtocol',
	'object_class_sub' =>	[],
	'key_desc' =>		'Protocol number',
	'key_attr' =>		[ 'ipProtocolNumber' ],
	'key_attr_clone' =>	[],
	'key_regex' =>		qr/^\d+$/,
	'key_translator' =>	sub { return (sprintf('%d', $_[0])) },
	'value_desc' =>		'Protocol name(s)',
	'value_attr' =>		'cn',
	'value_regex' =>	qr/^\w[\w\-\.]*$/,
	'has_many' =>		1,
	'has_description' =>	1,
	'need_description' =>	1,
	'description' =>	'Protocol number and name on IP',
    },
    'rpc' => { ## OK
	'ou' =>			'ou=Rpc',
	'object_class' =>	'oncRpc',
	'object_class_sub' =>	[],
	'key_desc' =>		'Program number',
	'key_attr' =>		[ 'oncRpcNumber' ],
	'key_attr_clone' =>	[],
	'key_regex' =>		qr/^\d+$/,
	'key_translator' =>	sub { return (sprintf('%d', $_[0])) },
	'value_desc' =>		'Program name(s)',
	'value_attr' =>		'cn',
	'value_regex' =>	qr/^\w[\w\-\.]*$/,
	'has_many' =>		1,
	'has_description' =>	1,
	'need_description' =>	1,
	'description' =>	'RPC program names and numbers',
    },
    'services' => {
	'ou' =>			'ou=Services',
	'object_class' =>	'ipService',
	'object_class_sub' =>	[],
	'key_desc' =>		'Port number / udp or tcp',
	'key_attr' =>		[ 'ipServicePort', 'ipServiceProtocol' ],
	'key_attr_clone' =>	[],
	'key_regex' =>		qr#^\d+/\w[\w\-\.]*$#,
	'key_translator' =>	sub {
	    my ($port, $proto) = split(/\Q$key_splitter\E/, $_[0]);
	    return (sprintf('%d', $port), $proto);
	},
	'value_desc' =>		'Service name(s)',
	'value_attr' =>		'cn',
	'value_regex' =>	qr/^\w[\w\-\.]*$/,
	'has_many' =>		1,
	'has_description' =>	1,
	'need_description' =>	0,
	'description' =>	'IP Services',
    },
);

my $cmd_usage = "Usage: $0 DATABASE [OPTIONS] KEY [VALUE ...]

Options:
 -A, --add-entry
    Add new KEY entry with VALUE(s)
 -D, --delete-entry
    Delete existence KEY entry
 -s, --set-value
    Set VALUE(s) of KEY entry
 -a, --add-value
    Add VALUE(s) to KEY entry
 -d, --delete-value
    Delete VALUE(s) from KEY entry
 -c, --description DESC
    Set description about KEY entry

Arguments:
 DATABASE	Database name
 KEY		Key for an entry
 VALUE		Value(s) to add, delete or set for the entry

Databases:
";
for my $db_name (sort keys %db_info) {
    $cmd_usage .= sprintf(" %-15s%s\n\tKey\t%s\n\tValue\t%s\n",
	$db_name,
	$db_info{$db_name}->{'description'},
	$db_info{$db_name}->{'key_desc'},
	$db_info{$db_name}->{'value_desc'},
    );
}

## Parse command-line options
## ----------------------------------------------------------------------

if (@ARGV == 0) {
    print $cmd_usage;
    exit(0);
}

my $db_name = shift(@ARGV);

my $db = $db_info{$db_name};
if (!defined($db)) {
    die "unknown database: $db_name\n";
}

my $dn_base = $config{'suffix'};

{
    local($SIG{'__WARN__'}) = sub {
	err("\l$_[0]");
    };
    Getopt::Long::Configure('bundling');
    Getopt::Long::Configure('no_ignore_case');
    Getopt::Long::Configure('no_auto_abbrev');
    GetOptions(
	'debug-ldap=i' =>		\$debug_ldap,
	's|set-value' =>		sub { $op = 'set-value'; },
	'a|add-value' =>		sub { $op = 'add-value'; },
	'd|del-value|delete-value' =>	sub { $op = 'delete-value'; },
	'A|add-entry' =>		sub { $op = 'add-entry'; },
	'D|del-entry|delete-entry' =>	sub { $op = 'delete-entry'; },
	'c|desc|description=s' =>	sub {
	    $desc = $_[1];
	    $op = 'set-description' if ($op eq 'show-entry');
	},
    ) || die "option error\n";
}

if (@ARGV < 1) {
    ## List all entries
    my $ldap = connect_ldap_master;
    $ldap->debug($debug_ldap);

    my $filter = "(objectClass=$db->{'object_class'})";
    my $cope = 'sub';
    my $search_msg = $ldap->search(
	'base' =>	$dn_base,
	'filter' =>	$filter,
	'scope' =>	'sub',
    );
    if ($search_msg->code && $search_msg->code != LDAP_NO_SUCH_OBJECT) {
	die "LDAP error while searching entry: ". $search_msg->error . "\n";
    }

    for my $entry ($search_msg->entries) {
	my $key = join('/', map { $entry->get_value($_) } @{$db->{'key_attr'}});
	my $value = join(', ', $entry->get_value($db->{'value_attr'}));
	my $desc = $entry->get_value('description');
	if (!defined($desc) || $desc eq $key) {
	    $desc = '';
	}
	else {
	    $desc =~ s/^/ # /;
	}
	print "$key: $value$desc\n";
    }

    exit(0);
}

my $entry_key = shift(@ARGV);

if ($op eq 'add-entry') {
    if (defined($db->{'key_regex'}) && $entry_key !~ $db->{'key_regex'}) {
	die "invalid key format: $entry_key\n";
    }
}

my @key_attr_name = @{$db->{'key_attr'}};
my @key_attr_clone_name = @{$db->{'key_attr_clone'}};
my @key_attr_value = ref($db->{'key_translator'})
    ? $db->{'key_translator'}->($entry_key)
    : ($entry_key);
if (@key_attr_name != @key_attr_value) {
    die "invalid key format: $entry_key\n";
}

my %entry_node = my @entry_node = ();
for (my $i = 0; $i < @key_attr_name; $i++) {
    $entry_node{$key_attr_name[$i]} = $key_attr_value[$i];
    if (defined($key_attr_clone_name[$i])) {
	$entry_node{$key_attr_clone_name[$i]} = $key_attr_value[$i];
    }
    push(@entry_node, "$key_attr_name[$i]=$key_attr_value[$i]");
}

my $entry_node = join('+', @entry_node);
my $entry_dn = "$entry_node,$db->{'ou'},$dn_base";
my $attr_filter = join('', map("($_)", @entry_node));


## ======================================================================

if ($op eq 'add-entry' || $op eq 'add-value') {
    if (defined($db->{'value_regex'})) {
	for my $value (@ARGV) {
	    if ($value !~ $db->{'value_regex'}) {
		die "invalid value format: $value\n";
	    }
	}
    }
}

my $ldap = connect_ldap_master;
$ldap->debug($debug_ldap);

my $filter = "(&(objectClass=$db->{'object_class'})$attr_filter)";
my $search_msg = $ldap->search(
    'base' =>	$dn_base,
    'filter' =>	$filter,
    'scope' =>	'sub',
);
if ($search_msg->code && $search_msg->code != LDAP_NO_SUCH_OBJECT) {
    die "LDAP error while searching entry: ". $search_msg->error . "\n";
}
if ($search_msg->entries > 1) {
    die "multiple entries found: $entry_key\n";
}
if ($op eq 'add-entry') {
    if ($search_msg->entries == 1) {
	die "entry already exists: $entry_key\n";
    }
}
else {
    if ($search_msg->entries == 0) {
	die "entry does not exist: $entry_key\n";
    }
}

my $entry = ($search_msg->entries)[0];
my @value = $entry->get_value($db->{'value_attr'}) if (defined($entry));

my @change = ();
switch ($op) {
    case 'show-entry' {
	print "database: $db_name\n";
	print "key: $entry_key\n";
	for my $value (@value) {
	    print "value: $value\n";
	}

	my $desc = $entry->get_value('description');
	if (defined($desc) && $desc ne $entry_key) {
	    print "description: $desc\n";
	}

	exit(0);
    }
    case 'set-description' {
	## DO NOTHING HERE.
    }
    case 'set-value' {
	push(@change, 'replace' => [ $db->{'value_attr'} => \@ARGV ]);
    }
    case 'add-value' {
	if (!$db->{'has_many'}) {
	    die "cannot add a value\n";
	}

	## FIXME: Remove repeated value(s) from @value_add
	my @value_add = @ARGV;

	if (!$db->{'has_many'}) {
	    die "cannot add multiple values\n";
	}

	my @value_new = (@value, @value_add);

	## Check if the entry does NOT have the same value...
	my %counter = ();
	if (my @value_found = grep { $counter{$_}++ == 1 } @value_new) {
	    die "value already exists: @value_found\n";
	}

	## Some attributes are NOT searchable because those do NOT
	## support equality matching rule. We use the 'replace' operation
	## instead of the 'add' operation here.
	push(@change, 'replace' => [ $db->{'value_attr'} => \@value_new ]);
    }
    case 'delete-value' {
	my @value_delete = @ARGV;

	## Check if the entry has the same value...
	my %counter = ();
	map { $counter{$_}++ } @value;
	if (my @value_notfound = grep { !defined($counter{$_}) } @value_delete) {
	    die "value does not exist: @value_notfound\n";
	}

	map { $counter{$_}++ } @value_delete;
	my @value_new = grep { $counter{$_} == 1 } @value;
	if (@value_new == 0) {
	    die "cannot delete all values from the entry\n";
	}

	## Some attributes are NOT searchable because those do NOT
	## support equality matching rule. We use the 'replace' operation
	## instead of the 'delete' operation here.
	push(@change, 'replace' => [ $db->{'value_attr'} => \@value_new ]);
    }
    case 'add-entry' {
	my @value_new = @ARGV;

	if (@value_new == 0) {
	    die "cannot add an entry without value\n";
	}
	if (!$db->{'has_many'} && @value_new > 1) {
	    die "cannot add multiple values\n";
	}
	if ($db->{'need_description'} && !length($desc)) {
	    $desc = $entry_key;
	}
	my @attr = (
	    'objectClass' =>	[ $db->{'object_class'}, @{$db->{'object_class_sub'}} ],
	    %entry_node,
	    $db->{'value_attr'} =>	\@value_new,
	);
	push(@attr, 'description' => $desc) if (length($desc));
	my $add_msg = $ldap->add($entry_dn, 'attr' => \@attr);
	if ($add_msg->code) {
	    die "LDAP error while adding a entry: ". $add_msg->error . "\n";
	}

	exit(0);
    }
    case 'delete-entry' {
	my $delete_msg = $ldap->delete($entry->dn);
	if ($delete_msg->code) {
	    die "LDAP error while deleting the entry: ". $delete_msg->error . "\n";
	}

	exit(0);
    }
    else {
	die "Sorry, not implemented yet\n";
    }
}

if ($db->{'need_description'} && !length($desc)) {
    $desc = $entry_key;
}
if (length($desc)) {
    push(@change, 'replace' => [ 'description' => $desc ]);
}

my $modify_msg = $ldap->modify($entry->dn, 'changes' => \@change);
if ($modify_msg->code) {
    die "LDAP error while modifying the entry: ". $modify_msg->error . "\n";
}

exit(0);

## Sub routines
## ======================================================================

BEGIN {
    $SIG{'__DIE__'} = sub {
	die "$0: error: $_[0]";
    };
    $SIG{'__WARN__'} = sub {
	warn "$0: warning: $_[0]";
    };
}

sub err
{
    my ($msg) = @_;
    chomp($msg);
    print STDERR "$0: error: $msg\n";
}

=head1 名前

ldapnsadm - LDAP DIT 内のネームサービスデータベースの管理

=head1 概要

=over

=item エントリの一覧表示:

ldapnsadm I<データベース名>

=item エントリの表示:

ldapnsadm I<データベース名> I<キー>

=item エントリの追加・変更・削除:

ldapnsadm I<データベース名> I<オプション> I<キー> [I<値> [I<値> ...]]

=back

=head1 説明

F<ldapnsadm> は、
LDAP DIT に格納れているネームサービス用のデータエントリを管理するためのコマンドです。
LDAP DIT にエントリを追加したり、既存のエントリを表示・変更・削除することができます。

F<ldapnsadm> は以下のデータベースに対応しています。

=over

=item * aliases        メールエイリアス

=item * bootparams     デバイスの名前とブートパラメーター

=item * ethers         デバイスの名前と MAC アドレス

=item * netmasks       IP ネットワークのネットマスク値

=item * networks       IP ネットワークの名前

=item * protocols      IP 上のプロトコルのプロトコル番号と名前

=item * rpc            RPC のプログラム番号と名前

=item * services       IP 上のサービスのポート番号/プロトコル名と名前

=back

=head1 オプション

=over 4

=item -A

=item --add-entry

指定されたキーと値を持つエントリをデータベースに追加する。

=item -D

=item --delete-entry

指定されたキーを持つ既存のエントリをデータベースから削除する。

=item -s

=item --set-value

指定されたキーを持つ既存のエントリの値を指定されたものに置き換える。

=item -a

=item --add-value

指定されたキーを持つ既存のエントリに指定された値を追加する。

=item -d

=item --delete-value

指定されたキーを持つ既存のエントリから指定された値を削除する。

=item -c I<説明>

=item --description I<説明>

指定されたキーを持つ新規または既存のエントリの説明文 (コメント) を指定のものに設定する。

=back

=head1 データベース

データーベースごとにキーと値の意味が異なり、その形式も異なります。
データベースにより、説明文を設定できなかったり (aliases)、
複数の値を保持できないものがあります (ethers, netmasks)。

=head2 aliases

MTA が参照するメールエイリアス情報です。

=over

=item キー: メールアドレスのローカルパート (例: root, info)

=item 値:   転送先メールアドレスまたはコマンドライン
(例: satoh, suzuki@external.example.com, "|/usr/local/bin/somecommand args")

=item 備考: 説明文を保持することはできない

=back

=head2 bootparams

デバイス (主にディスクレスクライアント) のホスト名とブートパラメーターの対応表です。

=over

=item キー: デバイスのホスト名 (例: xterm1, color-printer)

=item 値:   ブートパラメーター (例: root=host:/export/xterm1/root)

=back

=head2 ethers

デバイス (イーサネット) のホスト名と MAC アドレスの対応表です。

=over

=item キー: デバイスのホスト名 (例: xterm1, color-printer)

=item 値:   イーサーネットの MAC アドレス (例: 10:00:00:ff:00:09)

=item 備考: 複数の値を持つことはできない。

=back

=head2 netmasks

IP ネットワークのネットワークアドレスとネットマスク値の対応表です。

=over

=item キー: ネットワークアドレス (例: 172.16.1.0, 192.168.25.128)

=item 値:   ネットマスク (例: 255.255.255.0, 255.255.255.128)

=item 備考: 複数の値を持つことはできない。

=back

=head2 networks

IP ネットワークのネットワークアドレスとネットワーク名の対応表です。

=over

=item キー: ネットワークアドレス (例: 172.16.1.0, 192.168.25.0)

=item 値:   ネットワーク名 (例: lan1, test-net)

=item 備考: ネットワークアドレス末尾の .0 を省略することはできない。

=back

=head2 protocols

IP 上のプロトコルのプロトコル番号とプロトコル名です。

=over

=item キー: プロトコル番号 (例: 0, 6)

=item 値:   プロトコル名 (例: ip, tcp)

=back

=head2 rpc

RPC サービスのプログラム番号とプログラム名です。

=over

=item キー: RPC プログラム番号 (例: 100000, 100003)

=item 値:   RPC プログラム名 (例: portmapper, nfs)

=back

=head2 services

IP 上のサービスのポート番号/プロトコル名とサービス名の対応表です。

=over

=item キー: ポート番号/プロトコル (例: 80/tcp, 123/udp)

=item 値:   サービス名 (例: http, ntp)

=back

=head1 実行例

=over

=item aliases のエントリを一覧表示

 # ldapnsadm aliases

=item bootparams の 1 エントリを表示

 # ldapnsadm bootparams color-printer

=item ethers に 1 エントリを追加

 # ldapnsadm ethers --add-entry xterm1 10:00:00:ff:00:18

=item netmasks の 1 エントリの値を設定

 # ldapnsadm netmasks --set-value 192.168.25.128 255.255.255.192

=item networks の 1 エントリに値を追加

 # ldapnsadm networks --add-value 192.168.25.128 test test-network

=item protocol の 1 エントリから値を削除

 # ldapnsadm networks --delete-value 0 ipv4

=item rpc の 1 エントリの説明文を設定

 # ldapnsadm rpc --description 100000 "RPC program number mapper"

=item service の 1 エントリを削除

 # ldapnsadm services --delete-entry 8088/tcp

=back

=head1 関連項目

L<nsswitch.conf(5)>, L<getent(1)>

=cut