#!/usr/bin/perl
#
# File: ldap-acl-access
# Description: display OpenLDAP access control information
# Author: Bill MacAllister <bill@ca-zephyr.org>
# Copyright 2011, 2013 Board of Trustees, Leland Stanford Jr. University
# Copyright 2016-2020, 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_MASTER;
my @LDAP_ACLS;
my %LDAP_ACLS_NORMALIZED;

my $opt_all;
my $opt_conf = '/etc/cz-ldaptools.conf';
my $opt_debug;
my $opt_example;
my $opt_expand;
my $opt_help;
my $opt_host;
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;
}

# --------------------------------------------------------------------
# Normalize a string by removing spaces and throwing away white space.

sub normalize_string {
    my @in_array = @_;
    my @out      = ();
    for my $in (@in_array) {
        my $t = "$in";
        $t =~ s{\s+}{}xmsg;
        push @out, lc $t;
    }
    return wantarray ? @out : $out[0];
}

# --------------------------------------------------------------------
# Take an array remove duplicate entries, sort it, and return the
# result

sub dedup_array {
    my @in = @_;
    # Now remove duplicates by normalizing the acl and using a hash
    my %dedup = ();
    for my $i (@in) { $dedup{ normalize_string($i) } = $i; }
    my @out = ();
    for my $o (sort keys %dedup) { push @out, $dedup{$o}; }
    return @out;
}

# --------------------------------------------------------------------
# Add the default realm to a principal.  For principals that should
# be FDQN's add the default domain if not present.

sub add_principal_defaults {
    my ($this_princ) = @_;

    # Create regex prefix for host base acls
    my $prefixes;
    if ($CONF->host_prefix) {
        $prefixes = join('|', @{ $CONF->host_prefix });
    }

    # Strip the realm if it was supplied
    my $realm_pat = $CONF->krb_realm;
    $realm_pat  =~ s{[.]}{[.]}xmsg;
    $this_princ =~ s{[@]$realm_pat$}{}xms;

    # Add the default domain for webauth and host principals
    if (   $prefixes
        && $this_princ !~ m{[.]}xms
        && $this_princ =~ m{^(?:webauth/|host/)}xms)
    {
        $this_princ .= q{.} . $CONF->default_domain;
    }

    # Add the realm back on
    $this_princ .= q{@} . $CONF->krb_realm;

    return $this_princ;
}

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

sub dir_connect {

    if ($CONF->ldap_bindtype eq 'simple') {
        $LDAP_MASTER = 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_MASTER = lt_ldap_connect(
            {
                host     => $CONF->ldap_host,
                port     => $CONF->ldap_port,
                bindtype => $CONF->ldap_bindtype,
                debug    => $opt_debug
            }
        );
    }
    return;
}

# --------------------------------------------------------------------
# Return the number of entries that match given search parameters.
# This is most useful for testing existence and uniqueness.

sub count_entries {
    my ($base, $filter) = @_;
    if ($opt_debug) {
        dbg("count entries using base=$base filter=$filter");
    }
    my $msg = $LDAP_MASTER->search_s(
        -basedn    => $base,
        -scope     => LDAP_SCOPE_SUBTREE,
        -filter    => $filter,
        -attrs     => ['objectclass'],
        -attrsonly => 0,
    );
    my $cnt = keys %{ $LDAP_MASTER->get_all_entries };
    if ($opt_debug) {
        dbg("entries found: $cnt");
    }
    return $cnt;
}

# --------------------------------------------------------------------
# Read all of the ACLs for a directory and store them in an array.

sub read_ldap_acls {
    my @acls   = ();
    my $base   = 'cn=config';
    my $filter = 'olcAccess=*';
    if ($opt_debug) {
        dbg("base=$base filter=$filter");
    }
    my $msg = $LDAP_MASTER->search_s(
        -basedn    => $base,
        -scope     => LDAP_SCOPE_SUBTREE,
        -filter    => $filter,
        -attrs     => ['olcAccess'],
        -attrsonly => 0
    );
    my %entries = %{ $LDAP_MASTER->get_all_entries };
    for my $dn (keys %entries) {
        for my $item (@{ $entries{$dn}{'olcAccess'} }) {
            push @acls, $item;
        }
    }
    return @acls;
}

# --------------------------------------------------------------------
# Accept a dn and display any acls using that dn.  The input DN is
# normalized.

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

    if ($opt_debug) {
        dbg("searching for $dn in the ACLs");
    }
    my @acls    = ();
    my $test_dn = normalize_string($dn);
    for my $a (keys %LDAP_ACLS_NORMALIZED) {
        if ($a =~ m{$test_dn}xms) {
            push @acls, $LDAP_ACLS_NORMALIZED{$a};
        }
    }
    return @acls;
}

# --------------------------------------------------------------------
# Take a dn and return a list of ACLs that either contain a direct
# reference to the dn or indirectly with a member= group reference.

sub find_dn_access {
    my ($this_dn) = @_;

    # Make sure the DN is in the directory and display a warning
    # if it is not there.
    if (count_entries($this_dn, 'objectClass=*') == 0) {
        msg("WARN: $this_dn not found in directory");
    }

    # Directly referenced
    my @acls        = ();
    my @direct_acls = find_acls($this_dn);
    for my $a (@direct_acls) {
        push @acls, $a;
    }

    # look up member= group
    my $filter = "member=$this_dn";
    if ($opt_debug) {
        dbg('base=' . $CONF->ldap_base . " filter=$filter");
    }
    my $msg = $LDAP_MASTER->search_s(
        -basedn    => $CONF->ldap_base,
        -scope     => LDAP_SCOPE_SUBTREE,
        -filter    => $filter,
        -attrs     => ['objectclass'],
        -attrsonly => 0
    );
    my %entries = %{ $LDAP_MASTER->get_all_entries };
    for my $dn (keys %entries) {
        my $display_dn = $dn;
        if ($opt_expand) {
            $display_dn = '# ' . $dn;
        }
        push @acls, $display_dn;
        my @this_acl_list = find_acls($dn);
        if (scalar(@this_acl_list) == 0) {
            push @acls, "WARN: $dn not found in ACLs";
        } else {
            if ($opt_expand) {
                my @expanded_acls = find_acls($dn);
                for my $a (@expanded_acls) {
                    push @acls, $display_dn . "\n" . $a;
                }
            }
        }
    }

    return dedup_array(@acls);
}

# --------------------------------------------------------------------
# Take a principal and return a list of ACLs that define the
# principal's access to the directory.

sub find_princ_access {
    my ($this_princ) = @_;
    my @acls = ();

    # look up the principals dn
    my $filter = "krb5principalname=$this_princ";
    if ($opt_debug) {
        dbg('base=' . $CONF->ldap_base . " filter=$filter");
    }
    my $msg = $LDAP_MASTER->search_s(
        -basedn    => $CONF->ldap_base,
        -scope     => LDAP_SCOPE_SUBTREE,
        -filter    => $filter,
        -attrs     => ['objectclass'],
        -attrsonly => 0
    );
    my %entries = %{ $LDAP_MASTER->get_all_entries };
    if (keys %entries > 1) {
        msg("WARN: $this_princ has multiple entries in the directory");
        for my $dn (keys %entries) {
            msg("INFO: $dn");
        }
    }
    for my $dn (keys %entries) {
        push @acls, find_dn_access($dn);
    }
    return dedup_array(@acls);
}

# --------------------------------------------------------------------
# Find an acl in the configuration by the weighting number used
# to order ACLs.

sub find_acl_by_number {
    my ($this_number) = @_;
    my @acls;

    my $base   = 'cn=config';
    my $filter = 'olcSuffix=' . $CONF->ldap_base;
    if ($opt_debug) {
        dbg("base=$base filter=$filter");
    }
    my $msg = $LDAP_MASTER->search_s(
        -basedn    => $base,
        -scope     => LDAP_SCOPE_SUBTREE,
        -filter    => $filter,
        -attrs     => ['olcAccess'],
        -attrsonly => 0
    );
    my %entries = %{ $LDAP_MASTER->get_all_entries };
    for my $dn (keys %entries) {
        for my $item (@{ $entries{$dn}{'olcAccess'} }) {
            if ($opt_all) {
                push @acls, $item;
            } elsif ($item =~ /^\{$this_number\}/xms) {
                push @acls, $item;
                last;
            }
        }
    }

    return (@acls);
}

# ----------------------------------------------------------------------
# Find the DN for a member given a principal.

sub find_member_dn {
    my ($princ) = @_;
    my @dn_list = ();

    my $full_princ;
    if ($princ =~ /@/xms) {
        $full_princ = $princ;
    } else {
        $full_princ = $princ . '@' . $CONF->krb_realm;
    }
    my $base   = $CONF->ldap_base;
    my $filter = "(krb5PrincipalName=$full_princ)";
    my $scope  = LDAP_SCOPE_SUBTREE;
    my $msg    = $LDAP_MASTER->search_s(
        -basedn    => $base,
        -scope     => $scope,
        -filter    => $filter,
        -attrs     => ['objectClass'],
        -attrsonly => 0
    );
    my %entries = %{ $LDAP_MASTER->get_all_entries };
    for my $dn (keys %entries) {
        push @dn_list, $dn;
    }
    return @dn_list;
}

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

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

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

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

if (defined($ARGV[0]) && $ARGV[0] eq 'acl') {
    shift;
}

if (!$opt_all) {
    if (defined($ARGV[0])) {
        if ($ARGV[0] eq 'help') {
            $opt_help = 1;
        }
        if ($ARGV[0] eq 'manual') {
            $opt_manual = 1;
        }
    } else {
        $opt_help = 1;
    }
}

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

# Read the configuration file
$CONF = lt_read_conf($opt_conf);

# -- Connect to the directory and read the ACLs
if (!$opt_host) {
    if ($CONF->ldap_host) {
        $opt_host = $CONF->ldap_host;
    } else {
        msg("ERROR: ldap_host not specified");
        exit 1;
    }
}
dir_connect();

# -- Read all of the ACLs in for a given suffix if we are not
#    displaying all ACLs
if (!$opt_all) {
    @LDAP_ACLS = read_ldap_acls();
    for my $a (@LDAP_ACLS) {
        $LDAP_ACLS_NORMALIZED{ normalize_string($a) } = $a;
    }
}

my @acls = ();
if ($ARGV[0] =~ m{=}xms) {
    my $this_dn = $ARGV[0];
    @acls = find_dn_access($this_dn);
    if (!@acls) {
        msg("DN $this_dn not referenced in $opt_host ACLs");
    }
} else {
    my $this_princ = $ARGV[0];
    if ($opt_all) {
        @acls = find_acl_by_number();
    } elsif ($this_princ > 0 || $this_princ eq '0') {
        @acls = find_acl_by_number($this_princ);
        if (!@acls) {
            msg("ACL $this_princ not found");
        }
    } elsif ($this_princ =~ m{=}xms) {
        @acls = dedup_array(find_db_access($this_princ));
        if (!@acls) {
            msg("DN $this_princ not referenced in $opt_host ACLs");
        }
    } else {
        $this_princ = add_principal_defaults($this_princ);
        msg('');
        msg("Access for principal: $this_princ");
        msg('-------------------------------------------------------');
        @acls = find_princ_access($this_princ);
        if (!@acls) {
            msg("Principal $this_princ not referenced in $opt_host ACLs");
        }
    }
}

for my $a (@acls) {
    msg(lt_format_acls($a) . "\n");
}

$LDAP_MASTER->unbind;

exit;

__END__

=head1 NAME

ldap-acl-access - display LDAP access controls, add members

=head1 SYNOPSIS

ldap-acl-access <dn>|<principal>|<acl-number>|help|manual
[<member DN>|<acl number>|<principal>] [--all]
[--expand] [--host=ldaphost] [--base=dn] [--help] [--manual] [--debug]

=head1 DESCRIPTION

This script queries OpenLDAP servers configured with directory access
control lists stored in the cn=config branch of the directory and
displays access details for a given principal or distinguished name.

Note, the script will swallow the string 'acl' if it is the first
command line argument assuming the the first arguement is a remctl
sub-command.

=head1 ACTIONS

=over 4

=item <dn>|<principal>|<acl-number>

Search the directory ACLs and return the access controls for the
given distinguished name or Kerberos principal or ACL number.

=item members <LDAP Group fragment>

Display the members of the given LDAP group.  This is a fuzzy
match and will display all groups that contain the cn fragment.

=back

=head1 OPTIONS

=over 4

=item --all

Display all ACLs.

=item --conf=file.conf

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

=item --example

Print an example configuration file to STDOUT.

=item --expand

If the principal or dn is a member of a group that is controlling
access to the directory, perform an ACL search for the group and
display the access control entries that contain the group
distinguished name.  The default is to only display the group name and
not to display the group access entries.

=item --host=ldaphost

The host name of the LDAP server to query.

=item --base=dn

The distinguished name to use as a base for searching
krb5PrincipalNames and access control groups.

=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 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.

Copyright (C) 2016, 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 2011, 2013 Board of Trustees, Leland Stanford Jr. University.
All rights reserved.

=cut
