#!/usr/bin/perl
#
# File: ldap-group-maint
# Description: Display and update group entries
# Author: Bill MacAllister <bill@ca-zephyr.org>
# Copyright 2019-2021, Dropbox, Inc.
# Copyright: 2023 CZ Software

use AppConfig qw(:argcount :expand);
use Carp;
use Getopt::Long;
use CZ::LDAPtools;
use Net::LDAPapi;
use Pod::Usage;
use strict;

my $CONF;
my $DEBUG_TIME = time();
my $LDAP;
my $opt_all;
my $opt_conf = '/etc/ldap-group-maint.conf';
my $opt_debug;
my $opt_description;
my $opt_example;
my $opt_host;
my $opt_help;
my $opt_manual;

##############################################################################
# Subroutines
##############################################################################

# ------------------------------------------------
# output debugging information

sub dbg {
    my ($tmp)   = @_;
    my $now     = time();
    my $elapsed = $now - $DEBUG_TIME;
    print {*STDOUT} "$now ($elapsed) $tmp \n"
      or croak("debugging print to STDOUT failed: $!");
    $DEBUG_TIME = $now;
    return;
}

#-------------------------------------------------------------------------
# standard output

sub msg {
    my ($msg) = @_;
    print {*STDOUT} "$msg\n" or croak("print to STDOUT failed: $!");
    return;
}

# ------------------------------------------------------------------------
# Read configuration properties

sub read_conf {
    my ($filename) = @_;

    if (!$filename) {
        $filename = $opt_conf;
    }

    my $conf = AppConfig->new({});
    $conf->define(
        'default_domain',
        {
            DEFAULT  => 'ca-zephyr.org',
            ARGCOUNT => ARGCOUNT_ONE
        }
    );
    $conf->define(
        'krb_realm',
        {
            DEFAULT  => 'CA-ZEPHYR.ORG',
            ARGCOUNT => ARGCOUNT_ONE
        }
    );
    $conf->define(
        'ldap_bindtype',
        {
            DEFAULT  => 'gssapi',
            ARGCOUNT => ARGCOUNT_ONE
        }
    );
    $conf->define(
        'ldap_base',
        {
            DEFAULT  => 'dc=ca-zephyr,dc=org',
            ARGCOUNT => ARGCOUNT_ONE
        }
    );
    $conf->define(
        'ldap_group_base',
        {
            DEFAULT  => 'ou=groups,dc=ca-zephyr,dc=org',
            ARGCOUNT => ARGCOUNT_ONE
        }
    );
    $conf->define(
        'ldap_host',
        {
            DEFAULT  => 'localhost',
            ARGCOUNT => ARGCOUNT_ONE
        }
    );
    $conf->define(
        'ldap_port',
        {
            DEFAULT  => '389',
            ARGCOUNT => ARGCOUNT_ONE
        }
    );
    $conf->define(
        'remctl_group_command',
        {
            DEFAULT  => 'group',
            ARGCOUNT => ARGCOUNT_ONE
        }
    );
    $conf->define('ldap_password', { ARGCOUNT => ARGCOUNT_ONE });
    $conf->define('ldap_user',     { ARGCOUNT => ARGCOUNT_ONE });

    if (-e $filename) {
        $conf->file($filename) or die "ERROR: problem reading $filename";
    }

    if ($conf->ldap_host() =~ /,/xms) {
        my $one_host = lt_pool_host($conf->ldap_host);
        $conf->ldap_host($one_host);
    }

    return $conf;
}

#------------------------------------------------------------------------
# Print example configuration file

sub print_example_config {

    msg('# /etc/ldap-group-maint.conf');
    msg('default_domain  = ca-zephyr.org');
    msg('krb_principal   = service/ldap');
    msg('krb_realm       = CA-ZEPHYR.ORG');
    msg('ldap_bindtype   = gssapi');
    msg('ldap_base       = dc=ca-zephyr,dc=org');
    msg('ldap_group_base = ou=groups,dc=ca-zephyr,dc=org');
    msg('ldap_host       = localhost');
    msg('# remctl_group_command is used to identify a remctl execution');
    msg('remctl_group_command = group');

    return;
}

# ----------------------------------------------------------------------
# Connect to the directory

sub dir_connect {

    if ($CONF->ldap_bindtype eq 'simple') {
        $LDAP = lt_ldap_connect(
            {
                host     => $CONF->ldap_host,
                port     => $CONF->ldap_port,
                bindtype => $CONF->ldap_bindtype,
                user_dn  => $CONF->ldap_user,
                user_pw  => $CONF->ldap_password,
                debug    => $opt_debug
            }
        );
    } else {
        $LDAP = lt_ldap_connect(
            {
                host     => $CONF->ldap_host,
                port     => $CONF->ldap_port,
                bindtype => $CONF->ldap_bindtype,
                debug    => $opt_debug
            }
        );
    }
    return;
}

# ----------------------------------------------------------------------
# Return the group DN given a group name

sub group_dn {
    my ($g)    = @_;
    my $base   = $CONF->ldap_group_base;
    my $filter = "(&(cn=$g)(objectClass=groupOfNames))";
    if ($opt_debug) {
        dbg("base=$base filter=$filter");
    }
    my $msg = $LDAP->search_s(
        -basedn    => $base,
        -scope     => LDAP_SCOPE_SUBTREE,
        -filter    => $filter,
        -attrs     => ['objectClass'],
        -attrsonly => 0
    );
    my %entries = %{ $LDAP->get_all_entries };
    if (scalar(keys %entries) == 0) {
        return;
    }
    my $err_flag = 0;
    if (scalar(keys %entries) > 1) {
        msg("ERROR: ambigious group");
        $err_flag = 1;
    }
    my $dn;
    for my $this_dn (keys %entries) {
        if ($err_flag) {
            msg($dn);
        } else {
            $dn = $this_dn;
        }
    }
    if ($err_flag) {
        exit 1;
    }
    return $dn;
}

# ----------------------------------------------------------------------
# Return a DN given either a principal or a DN

sub make_dn {
    my ($m) = @_;

    my $return_dn;
    if ($m =~ /=/xms) {
        $return_dn = $m;
        if (!dn_exists($return_dn)) {
            msg("WARN: dn not in directory ($m)");
        }
    } else {
        my $a_princ = $m;
        if ($a_princ !~ /@/xms) {
            $a_princ .= '@' . $CONF->krb_realm;
        }
        my $a_dn = princ_to_dn($a_princ);
        if ($a_dn) {
            $return_dn = $a_dn;
        } else {
            msg("WARN: principal not found ($a_dn)");
        }
    }
    return $return_dn;
}

# ----------------------------------------------------------------------
# Return a dn of for a given principal name

sub princ_to_dn {
    my ($m) = @_;

    my $base   = $CONF->ldap_base;
    my $filter = "(&(krb5PrincipalName=$m)(objectClass=krb5Principal))";
    if ($opt_debug) {
        dbg("base=$base filter=$filter");
    }
    my $msg = $LDAP->search_s(
        -basedn    => $base,
        -scope     => LDAP_SCOPE_SUBTREE,
        -filter    => $filter,
        -attrs     => ['objectClass'],
        -attrsonly => 0
    );
    my %entries = %{ $LDAP->get_all_entries };
    if (scalar(keys %entries) == 0) {
        msg("ERROR: member not found ($m)");
        return;
    }
    my $err_flag = 0;
    if (scalar(keys %entries) > 1) {
        msg("WARN: ambigious member ($m)");
        $err_flag = 1;
    }
    my $dn;
    for my $this_dn (keys %entries) {
        if ($err_flag) {
            msg("INFO: found $this_dn");
        } else {
            $dn = $this_dn;
        }
    }
    return $dn;
}

# ----------------------------------------------------------------------
# Check that a DN exists

sub dn_exists {
    my ($dn) = @_;

    my $base   = $dn;
    my $filter = "(objectClass=*)";
    if ($opt_debug) {
        dbg("base=$base filter=$filter");
    }
    my $msg = $LDAP->search_s(
        -basedn    => $base,
        -scope     => LDAP_SCOPE_BASE,
        -filter    => $filter,
        -attrs     => ['objectClass'],
        -attrsonly => 0
    );
    my %entries = %{ $LDAP->get_all_entries };
    if (scalar(keys %entries) == 0) {
        msg("INFO: DN not found ($dn)");
        return 0;
    }
    return 1;
}

# ----------------------------------------------------------------------
# add members to a group

sub add_members {
    my ($group, @members) = @_;

    my $dn = group_dn($group);
    if (!$dn) {
        msg("ERROR: group not found ($dn)");
        exit 1;
    }

    msg("Updating $dn ...");
    for my $m (@members) {
        my $member_dn = make_dn($m);
        if ($member_dn) {
            msg("Addding member $member_dn");
        } else {
            msg("ERROR: principal not found in directory ($m)");
            next;
        }
        my %mods = ('member', { 'a', [$member_dn] });
        if ($LDAP->modify_s($dn, \%mods) != LDAP_SUCCESS) {
            msg("ERROR: problem adding $member_dn to $dn");
            msg('ERROR: ' . $LDAP->errstring);
            exit 1;
        }
    }
    return;
}

# ----------------------------------------------------------------------
# create a group

sub create_group {
    my ($group, @members) = @_;

    my $dn = group_dn($group);
    if ($dn) {
        msg("ERROR: group already exists ($dn)");
        exit 1;
    }
    if (scalar(@members) == 0) {
        msg("ERROR: at least one member must be specified");
        exit 1;
    }
    if (!$opt_description) {
        msg("ERROR: --description=somestring is required");
        exit 1;
    }

    my $group_dn = "cn=$group," . $CONF->ldap_group_base;
    if (dn_exists($group_dn)) {
        msg("ERROR: group exists ($group_dn)");
        exit 1;
    }

    my @member_dns = ();
    for my $m (@members) {
        my $a_dn = make_dn($m);
        if ($a_dn) {
            msg("Adding $a_dn to update list");
            push @member_dns, $a_dn;
        } else {
            msg("WARN: skipping principal, not found ($m)");
        }
    }

    msg("Creating $group_dn ...");
    my %ldap_attributes = (
        'objectClass', 'groupOfNames',   'cn',     $group,
        'description', $opt_description, 'member', \@member_dns
    );

    if ($LDAP->add_s($group_dn, \%ldap_attributes) != LDAP_SUCCESS) {
        msg("ERROR: problem creating $dn");
        msg('ERROR: ' . $LDAP->errstring);
        exit 1;
    }
    return;
}

# ----------------------------------------------------------------------
# destroy a group

sub destroy_group {
    my ($group, @members) = @_;

    my $dn = group_dn($group);
    if (!$dn) {
        msg("ERROR: group not found ($dn)");
        exit 1;
    }
    msg("Deleting $dn ...");
    if ($LDAP->delete_s($dn) != LDAP_SUCCESS) {
        msg("ERROR: problem destroying $dn");
        msg('ERROR: ' . $LDAP->errstring);
        exit 1;
    }
    return;
}

# ----------------------------------------------------------------------
# Remove members from a group

sub remove_members {
    my ($group, @members) = @_;

    my $dn = group_dn($group);
    if (!$dn) {
        msg("ERROR: group not found ($dn)");
        exit 1;
    }

    msg("Updating $dn ...");
    for my $m (@members) {
        my $member_dn;
        if ($m =~ /=/xns) {
            $member_dn = $m;
        } else {
            $member_dn = make_dn($m);
        }
        if ($member_dn) {
            msg("Remove member $member_dn");
        } else {
            msg("ERROR: principal not found in directory ($m)");
            next;
        }
        my %mods = ('member', { 'd', [$member_dn] });
        if ($LDAP->modify_s($dn, \%mods) != LDAP_SUCCESS) {
            msg("ERROR: problem removing $member_dn from $dn");
            msg('ERROR: ' . $LDAP->errstring);
            exit 1;
        }
    }
    return;
}

# ----------------------------------------------------------------------
# Display all the members in a list of group

sub show_groups {
    my @groups = @_;

    for my $g (@groups) {
        my $base   = $CONF->ldap_base;
        my $filter = "(&(cn=$g)(objectClass=groupOfNames))";
        if ($opt_debug) {
            dbg("base=$base filter=$filter");
        }
        my $msg = $LDAP->search_s(
            -basedn    => $base,
            -scope     => LDAP_SCOPE_SUBTREE,
            -filter    => $filter,
            -attrs     => ['member'],
            -attrsonly => 0
        );
        my %entries = %{ $LDAP->get_all_entries };
        for my $dn (keys %entries) {
            msg($dn);
            for my $item (@{ $entries{$dn}{'member'} }) {
                msg("  $item");
            }
        }
    }
    return;
}

# ----------------------------------------------------------------------
# Find groups given a list of fragments

sub find_groups {
    my @fragments = @_;

    if ($opt_all) {
        @fragments = ('all');
    }
    for my $f (@fragments) {
        my $base = $CONF->ldap_base;
        my $filter;
        if ($opt_all) {
            $filter = "(&(cn=*)(objectClass=groupOfNames))";
        } else {
            $filter = "(&(cn=*$f*)(objectClass=groupOfNames))";
        }
        if ($opt_debug) {
            dbg("base=$base filter=$filter");
        }
        my $msg = $LDAP->search_s(
            -basedn    => $base,
            -scope     => LDAP_SCOPE_SUBTREE,
            -filter    => $filter,
            -attrs     => ['member'],
            -attrsonly => 0
        );
        my %entries = %{ $LDAP->get_all_entries };
        for my $dn (keys %entries) {
            msg($dn);
        }
    }
    return;
}

##############################################################################
# Main routine
##############################################################################

# -- get options
GetOptions(
    'all'           => \$opt_all,
    'conf=s'        => \$opt_conf,
    'debug'         => \$opt_debug,
    'description=s' => \$opt_description,
    'example'       => \$opt_example,
    'host=s'        => \$opt_host,
    'help'          => \$opt_help,
    'manual'        => \$opt_manual
);

# -- Flush output immediately
local $| = 1;

# Display an example configuration file
if ($opt_example) {
    print_example_config();
    exit;
}

# Display help if requested
if ($opt_help) {
    pod2usage(-verbose => 0);
}
if ($opt_manual) {
    pod2usage(-verbose => 2);
}

# Read the configuration file
$CONF = read_conf();
if ($opt_host) {
    $CONF->ldap_host($opt_host);
}

my $action;
if (defined($ARGV[0])) {
    if ($ARGV[0] eq $CONF->remctl_group_command) {
        shift(@ARGV);
    }
    $action = shift(@ARGV);
} else {
    if ($opt_all) {
        $action = 'find';
    } else {
        pod2usage(-verbose => 0);
    }
}

if ($action eq 'add') {
    dir_connect();
    my $this_group = shift @ARGV;
    add_members($this_group, @ARGV);
} elsif ($action eq 'create') {
    dir_connect();
    my $this_group = shift @ARGV;
    create_group($this_group, @ARGV);
} elsif ($action eq 'destroy') {
    dir_connect();
    my $this_group = shift @ARGV;
    if (scalar(@ARGV) > 0) {
        msg('ERROR: too many arguments');
        exit 1;
    }
    destroy_group($this_group);
} elsif ($action eq 'remove') {
    dir_connect();
    my $this_group = shift @ARGV;
    remove_members($this_group, @ARGV);
} elsif ($action eq 'show') {
    dir_connect();
    show_groups(@ARGV);
} elsif ($action eq 'find') {
    dir_connect();
    find_groups(@ARGV);
} else {
    msg("ERROR: unknown action ($action)");
    pod2usage(-verbose => 0);
}

exit;

__END__

=head1 NAME

ldap-group-maint - display and updates LDAP groups

=head1 SYNOPSIS

ldap-group-maint find|show|create|destroy|add|remove [<group>]
[<principal>|<dn> ...]  [--all] [--conf=<file>] [--host=<ldap master>]
[--description=<string>] [--help] [--manual] [--debug]

=head1 DESCRIPTION

The script displays, creates groups, adds members, and removes members
for groups defined in an LDAP directory.  The groups are used for
access controls within the LDAP server and are in the cn=groups branch
of the directory.

The group to be updated is specified by the cn for the group.  The DN
that the script constructs is of the form cn=<group>,<ldap_group_base>
where the <ldap_group_base> is defined in the configuration file.

=head1 ACTIONS

=head2 add <group> <principal> ...

Add members to an LDAP group.  Multiple principals can be specified on
the command line, and principals must exist in the directory as
krb5PrincipalName attributes in the directory.

=head2 create <group> <principal> ...

Create a group and add the principals to it. The group is specified as
the cn for the group.  At least one member is required.

Multiple principals can be specified on the command line, and principals
must exist in the directory as krb5PrincipalName attributes in the
directory.

=head2 destroy <group>

Delete a group.

=head2 find [<group fragment> ...]|[--all]

Search the directory display the DNs of groups using the filter
"cn=*fragment*".

=head2 remove <group> <principal>|<dn> ...

Remove members from a group.  The group is specified as the cn for
the group in the same way as the add action.

What to remove can be specified as either a principal or a dn.  If
a principal is specified it must be present in the directory as a
krb5PrincipalName attribute.  DNs to remove do not have to be entries
in the directory.  Multiple principals and DNs may be specified on
a single command line.

=head2 show [<group> ...]

Show the members in a group.  Multiple groups may be specified on the
command line.

=head1 OPTIONS

=over 4

=item --all

Display all groups.  This switch is valid for the find action only.

=item --conf=file.conf

The configuration file to us.  The default is /etc/ldaptools.conf.  Use
the "--example" option to display the properties used by the script.

=item --description=<string>

A text description of the purpose of the group.  A description is ignored
by all actions except 'add' where it is required.

=item --conf=file.conf

The configuration file.  The default is /etc/ldaptools.conf.

=item --example

Print an example configuration file to STDOUT.

=item --host=<ldap master>

The host name of the LDAP server to query and update.  The default
is localhost.

=item --help

Display short help text.

=item --manual

Display the complete documentation.

=item --debug

Display debugging messages.

=back

=head1 AUTHOR

Bill MacAllister <whm@dropbox.com>

=head1 COPYRIGHT

Copyright (C) 2019-2021 Dropbox Inc.

This code is free software; you can redistribute it and/or modify it
under the same terms as Perl. For more details, see the full
text of the at https://opensource.org/licenses/Artistic-2.0.

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.

Copyright 2023 CZ Software

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

=cut
