#!/usr/bin/perl
#
# File: ldap-service-entry
# Description: Create an LDAP service entry
# Author: Bill MacAllister <whm@dropbox.com>
# Copyright 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 $opt_conf = '/etc/ldap-service-entry.conf';
my $opt_debug;
my $opt_example;
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_service_base',
        {
            DEFAULT  => 'ou=auth,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 configuratino file

sub print_example_config {

    msg('# /etc/ldap-service-entry.conf');
    msg('default_domain    = ldap.com');
    msg('krb_realm         = KRB.REALM');
    msg('ldap_base         = dc=ldap,dc=com');
    msg('ldap_bindtype     = gssapi');
    msg('ldap_service_base = ou=auth,dc=ldap,dc=com');
    msg('ldap_host         = localhost');
    msg('ldap_port         = 389');
    msg('ldap_master_host  = master.ldap.com');
    msg('ldap_password     = somepassword');
    msg('ldap_user         = cn=manager,dc=ldap,dc=com');

    return;
}

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

# --------------------------------------------------------------------
# Show service entry details

sub show_principal {
    my ($id) = @_;

    my $cn = $id;
    $cn =~ s/[@].*//xms;

    my $base   = $CONF->ldap_service_base();
    my $filter = "(&(cn=$cn)(objectclass=krb5Principal))";
    if ($opt_debug) {
        dbg("base:$base filter:$filter");
    }
    my $msg = $LDAP_MASTER->search_s(
        -basedn    => $base,
        -scope     => LDAP_SCOPE_SUBTREE,
        -filter    => $filter,
        -attrs     => [],
        -attrsonly => 0,
    );
    my @lines   = ();
    my %entries = %{ $LDAP_MASTER->get_all_entries };
    for my $dn (keys %entries) {
        msg("dn: $dn");
        for my $a (sort keys %{ $entries{$dn} }) {
            for my $v (@{ $entries{$dn}{$a} }) {
                push @lines, "$a: $v";
            }
        }
    }
    for my $l (sort @lines) {
        msg($l);
    }
    return;
}

# --------------------------------------------------------------------
# Find service entries that match an id fragment

sub find_principal {
    my ($frag) = @_;
    my $base   = $CONF->ldap_service_base();
    my $filter = "(&(cn=*$frag*)(objectclass=krb5Principal))";
    if ($opt_debug) {
        dbg("find_principal - base:$base filter:$filter");
    }
    my $msg = $LDAP_MASTER->search_s(
        -basedn    => $base,
        -scope     => LDAP_SCOPE_SUBTREE,
        -filter    => $filter,
        -attrs     => [],
        -attrsonly => 0,
    );
    if ($LDAP_MASTER->errno != 0) {
        msg('errno: ' . $LDAP_MASTER->errno) . ' errstring:' . $LDAP_MASTER->errstring;
        $LDAP_MASTER->perror(
            "ERROR: problem searching using base:$base filter:$filter\n");
    }

    my @lines   = ();
    my %entries = %{ $LDAP_MASTER->get_all_entries };
    for my $dn (keys %entries) {
        push @lines, $dn;
    }
    for my $l (sort @lines) {
        msg($l);
    }
    return;
}

# --------------------------------------------------------------------
# Add a service entry

sub add_principal {
    my ($id) = @_;

    my $cn = "$id";
    $cn =~ s/service\///xms;
    my $princ;
    if ($cn =~ s/[@](.*)//xms) {
        $princ = $1;
    } else {
        $princ = $CONF->krb_realm();
    }
    my $dn    = 'cn=' . $cn . ',' . $CONF->ldap_service_base();
    my $princ = 'service/' . $cn . '@' . $princ;
    if ($opt_debug) {
        dbg("dn:$dn princ:$princ");
    }

    my %service_entry = (
        'objectClass',       ['applicationProcess', 'krb5Principal'],
        'cn',                $cn, 'description', 'Service Principal Entry',
        'krb5PrincipalName', $princ
    );

    if ($LDAP_MASTER->add_s($dn, \%service_entry) != LDAP_SUCCESS) {
        my $msg = 'ERROR: ' . $LDAP_MASTER->errstring;
        $msg .= ' (' . $LDAP_MASTER->errno . ')';
        $msg .= "\nINFO: problem dn ($dn)";
        msg($msg);
    } else {
        msg("ADDED: $dn");
    }

    return;
}

# --------------------------------------------------------------------
# Delete a service entry

sub del_principal {
    my ($id) = @_;

    my $cn = $id;
    $cn =~ s/[@].*//xms;
    my $dn = "cn=$cn," . $CONF->ldap_service_base();

    if ($LDAP_MASTER->delete_s($dn) != LDAP_SUCCESS) {
        my $msg = 'ERROR: ' . $LDAP_MASTER->errstring;
        $msg .= ' (' . $LDAP_MASTER->errno . ')';
        msg($msg);
    } else {
        msg("DELETED: $dn");
    }

    return;
}

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

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

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

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

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

# Command line arguments
my $action = $ARGV[0];
my $id     = $ARGV[1];

$id =~ s{^service/}{}xms;

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

dir_connect();

if ($action eq 'add') {
    add_principal($id);
} elsif ($action =~ /^(del|delete)$/xms) {
    del_principal($id);
} elsif ($action eq 'show') {
    show_principal($id);
} elsif ($action eq 'find') {
    find_principal($id);
} else {
    msg("ERROR: unknown action ($action)");
    exit 1;
}

$LDAP_MASTER->unbind;

exit;

__END__

=head1 NAME

ldap-service-entry - maintain LDAP service entries

=head1 SYNOPSIS

ldap-service-entry add|delete|show|find|help <service id>|<fragment>
[--help] [--manual] [--debug]

=head1 DESCRIPTION

This script is for the maintenance of service/<service id> Kerberos
mapping entries in the directory.  The principals are assumed to be of
the form service/<service id>.

=head1 ACTIONS

=over 4

=item add <service id>

Add a service entry to the directory.

=item delete <service id>

Delete a service entry from the directory.

=item show <service id>

Dump all service entries in the directory that match cn=<service id>.

=item find <fragment>

Search for service entries in the directory. The filter used is of
the form "cn=*<fragment>*".

=back

=head1 OPTIONS

=over 4

=item --conf=file.conf

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

=item --example

Print an example configuration file to STDOUT.

=item --help

Display short help text.

=item --manual

Display the complete documentation.

=item --debug

Display debugging messages.

=back

=head1 AUTHOR

Bill MacAllister <bill@ca-zephyr.org>

=head1 COPYRIGHT

Copyright (C) 2020, 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
