#! /usr/bin/perl -w
#
# @(#)mkgroup-sshlpk (2025 edition)
# Requires perl >= version 5.6 (since it uses 'our')
#
#
use strict;
use Getopt::Long qw(:config no_ignore_case bundling);
use Net::LDAP;
use Net::LDAP::Util qw(ldap_error_name
                       ldap_error_text); # for error handling
use File::Temp      qw(tempfile);
require ConfigTiny and import ConfigTiny unless defined &ConfigTiny::new;

our $verb=0;
our $force=0;
our $quiet=0;
our $exit_on_error=0;
our $uid=0;
our $commentuid=0;
our $configfile="/usr/local/etc/mkgroup-sshlpk.conf";
our $ldapurl="ldaps://ldap.nikhef.nl/";
our $ldapbase="dc=farmnet,dc=nikhef,dc=nl";
our $outputfile;
our $commandprefix;
our $uidldapfilter;
our $groupldapfilter;
our $ldapfilter;
our $def_ldapfilter = '(objectclass=*)';
our $def_groupldapfilter = '(objectclass=*)';
our $def_uidldapfilter = '(objectclass=*)';
our $ldapbinddn="";
our $ldapbindpw="";
our $ldapbindpwfile="";
our $ldapbindsssd_config="";
our $ldapbindsssd_domain="domain/default";

sub display_help {
  print <<EOF;

Generate a list of all unique sshPublicKeys for all members of the
directory groups or uids specified on the command line.

Usage: $0 [-h] [-c|--comand strin] [-H uri] [-b DITbase] [-o file]
          [-f] [-v[v]] RDN [RDN ...]
  -h         Display this help text
  --uid|-u   Retrieve also sshPublicKeys for uids besides also groups
  --filter=s Use an LDAP filter to limit results (applies recursively)
               (default: $def_ldapfilter)
               NOTE: explicitly listed entries must all match filter
  -H uri     Connect to LDAP server at <uri>
               (default: $ldapurl)
  -b base    Search base DIT for groups
               (default: $ldapbase)
  -c prfx    Prefix pre-pended to each line written. Any text in the
             original sshPublicKey attribute before the tokens " ssh-.sa "
             or " \\d+ \\d+ " is replaced. In the prefix itself, \@UID\@, 
             \@GID\@, \@UIDNUMBER\@ are replaced
  -o file    Writing list of sshPublicKeys to <file>
             (only when at least one sshPublicKey is retrieved, unless
             -f is also specified)
  -f         Force writing even if the list of keys is empty
  -q         Quiet: do not warn about missing entries
  -U         Add uidName and uidNumber as comment at and of each line
  -C cfgfile Config file (default: $configfile)
             file should be in-line perl syntax
  -D binddn
             bind as <binddn> (set to _NSS to read from sssd.conf)
  -y bindpwfile
        read the bind password from the file <bindpwfile>
        (it can also be set in config file with '\$ldapbindpw=""'
         but then protect the config file!)
  --sssd-config|S <file>
        Read LDAP bindDN and password (plaintext) from sssd config <file>
        SSSD parsing is only used when option is set (in config or argument)
  --sssd-domain <domain>
        Within the sssd config file, read data from domain <domain>


  RDN   name of groups (or uids) to traverse for members (list)
             NOTE: it will search through the whole directory for these
             group names or uids (provided there are keys there)

Example:
  $0 systemAdministrators nDPFPrivilegedUsers
  $0 systemAdministrators nDPFPrivilegedUsers z66
  $0 -c 'command="svnserve -t -r /project/srv/svn --tunnel-user=\@UID\@",no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty' -o ~svn/.ssh/authorized_keys nDPFSubversionUsers

Dependencies:
  perl-LDAP, and perl-IO-Socket-SSL & perl-Net-SSLeay for ldaps

EOF
  exit (0);
};

sub configfile_handler {
    my ($opt_name, $opt_value) = @_;
    die "Internal error: invalid option $opt_name assigned to configfile_handler\n"
        unless $opt_name eq "configfile" or $opt_name eq "";

    if ( defined $configfile and -r $opt_value ) {
        print "# parsing configuration $opt_value\n" if $verb > 1;
        open CFG,"<$configfile" or die "Cannot open config $configfile: $!\n";
        my $config = do { local $/; <CFG> };
        close CFG;
        $SIG{'__WARN__'} = sub { }; eval($config); $SIG{'__WARN__'} = 'DEFAULT';
        die "Invalid statement in config $configfile: $@\n" if $@;
    }
    # clear the default config file since we already read one
    $configfile=undef;
}

&GetOptions(
  'verbose|v+' => \$verb,
  'url|H=s' => \$ldapurl,
  'base|b=s' => \$ldapbase,
  'uid|u+' => \$uid,
  'output|o=s' => \$outputfile,
  'command|c=s' => \$commandprefix,
  'filter=s' => \$ldapfilter,
  'ufilter=s' => \$uidldapfilter,
  'gfilter=s' => \$groupldapfilter,
  'binddn|D=s' => \$ldapbinddn,
  'bindpwfile|y=s' => \$ldapbindpwfile,
  'sssd-config|S=s' => \$ldapbindsssd_config,
  'sssd-domain=s' => \$ldapbindsssd_domain,
  'help|h' => \&display_help,
  'quiet|q' => \$quiet,
  'exit-on-error' => \$exit_on_error,
  "force|f" => \$force,
  "uidc|U" => \$commentuid
);

if ( defined $configfile ) { &configfile_handler("",$configfile); }

defined $ARGV[0] or die "groupRDN or UID is a required argument\n";

# determine necessity for reading sssd config (which can be used
# for binding credentials and for localaccounts)
if ( $ldapbindsssd_config and $ldapbindsssd_domain ) {
    if ( ! -r $ldapbindsssd_config ) {
        die "Cannot read $ldapbindsssd_config\n";
    }
    my $sssd = ConfigTiny->new();
    if ( ! $sssd->read($ldapbindsssd_config) ) {
        die "Invalid sssd config syntax in $ldapbindsssd_config\n";
    }
    if ( $ldapurl eq '_NSS' and
            defined $sssd->{$ldapbindsssd_domain} and
            defined $sssd->{$ldapbindsssd_domain}->{'ldap_uri'} ) {
        $ldapurl = (split ',',$sssd->{$ldapbindsssd_domain}->{'ldap_uri'})[0];
        print "# set LDAP URL from sssd to $ldapurl\n" if $verb > 0;
    }
    if ( $ldapbase eq '_NSS' and
            defined $sssd->{$ldapbindsssd_domain} and
            defined $sssd->{$ldapbindsssd_domain}->{'ldap_search_base'} ) {
        $ldapbase = $sssd->{$ldapbindsssd_domain}->{'ldap_search_base'};
        print "# set LDAP BaseDN from sssd to $ldapbase\n" if $verb > 0;
    }
    if ( $ldapbinddn eq '_NSS' and
            defined $sssd->{$ldapbindsssd_domain} and
            defined $sssd->{$ldapbindsssd_domain}->{'ldap_default_bind_dn'} ) {
        $ldapbinddn = $sssd->{$ldapbindsssd_domain}->{'ldap_default_bind_dn'};
        print "# set LDAP bindDN from sssd to $ldapbinddn\n" if $verb > 0;
    }
    if ( $ldapbindpw eq '_NSS' and
            defined $sssd->{$ldapbindsssd_domain} and
            defined $sssd->{$ldapbindsssd_domain}->{'ldap_default_authtok'} ) {
        $ldapbindpw = $sssd->{$ldapbindsssd_domain}->{'ldap_default_authtok'};
        print "# set LDAP bind password from sssd\n" if $verb > 2;
    }
}

# connect to LDAP
my $ldap = Net::LDAP->new( $ldapurl, timeout=>10 );
if ( ! defined $ldap or ! $ldap ) {
    die "Cannot contact remote server at $ldapurl: $!\n";
};

# we need to bind explicitly to search, indicated by ldapbinddn being set
if ( $ldapbinddn ) {
    if ( !$ldapbindpw and -r $ldapbindpwfile ) {
        # obtain password from protected file
        if ( open my $pwfilehandle,'<',$ldapbindpwfile ) {
            $ldapbindpw=<$pwfilehandle>;
            close $pwfilehandle;
            chomp($ldapbindpw);
            if ( ! $ldapbindpw ) {
                die "LDAP bind password from $ldapbindpwfile is empty\n"
            } elsif ( length($ldapbindpw) < 8 )  {
                warn "LDAP bind password from $ldapbindpwfile is rather short\n";
            }
        } else {
            die "Cannot open LDAP bind password file $ldapbindpwfile: $!\n";
        }
    }
    # attempt binding, even with an empty password (who knows!)
    #
    my $ldap_status = $ldap->bind($ldapbinddn, 'password' => $ldapbindpw);
    if ( $ldap_status->code ) {
        die "Cannot bind to LDAP $ldapurl as $ldapbinddn: ".$ldap_status->error."\n";
    }
}

# start collecting ssh keys from all users in all groups requested
my @keys = ();
defined $ldapfilter or $ldapfilter = $def_ldapfilter;
defined $groupldapfilter or $groupldapfilter = $def_groupldapfilter;
defined $uidldapfilter or $uidldapfilter = $def_uidldapfilter;

my $lsfilter="";

foreach my $groupRDN ( @ARGV ) {

  if ( $uid ) {
    $lsfilter="(&
      $ldapfilter
      (| (&(cn=$groupRDN)(|(objectclass=groupOfUniqueNames)(objectclass=groupOfNames))$groupldapfilter)
         (&(uid=$groupRDN)(objectclass=ldapPublicKey)$uidldapfilter)
      )
    )";
  } else {
    $lsfilter="(&
      $ldapfilter
      (&(cn=$groupRDN)(|(objectclass=groupOfUniqueNames)(objectclass=groupOfNames))$groupldapfilter)
    )";
  }

  $verb>1 and print STDERR "Base: $ldapbase\n";
  $verb>1 and print STDERR "Filter: $lsfilter\n";
  my $groupresults=$ldap->search(
		base=>$ldapbase,
		scope=>"sub",
		filter=>$lsfilter
		);
  # one must die here, since its an explicitly requested group in ARGV
  $groupresults->code and die "Search failed: ".$groupresults->error."\n";
  $groupresults->count() or die "No entries found matching $groupRDN, exiting\n";

  # list of entries for all groups matching this groupRDN
  my @grouplistentries=$groupresults->entries;

  # groups need to be recursively matched, uids are leaf entries
  # but groups may have some explicit sshPublicKey attributes
  #
  foreach my $groupentry ( @grouplistentries ) {
    &walkDN($groupentry->dn());
  }
}

# when writing to file, there must be at least one key to indicate
# sanity, unless -f has been specified and you don't care
# otherwise, an LDAP search error or typo may accidentally wipe
# a authorized_keys file

( defined $outputfile ) and ($#keys < 0) and 
  die "Empty key list will not be written to $outputfile (use \"-f\" to force)\n";

# print each key only once
my %uniqueKeys;
foreach ( @keys ) { $uniqueKeys{$_}=2; }

if ( defined $outputfile ) {

  # first write to temporary file to ensure file content can be written 
  # and there is enough space available
  my ($temp_fh,$temp_fn) = tempfile("$outputfile.nw_XXXXXXXX", UNLINK => 0);

  # preserve file mode if outputfile exists
  my $outputfile_mode;
  if ( -e $outputfile ) {
    my @stat_outputfile;
    @stat_outputfile = stat($outputfile);
    die "Cannot retrieve mode of $outputfile: $!\n" if ( $#stat_outputfile < 0 );
    $outputfile_mode = ($stat_outputfile[2]) & 07777;
  } else {
    # default mode is 0644
    $outputfile_mode = 0644;
  }
  # try to fchmod first, fallback to chmod on filename on error
  if ( ! chmod $outputfile_mode, $temp_fh and 
       ! chmod $outputfile_mode, $temp_fn ) {
    die "Cannot set target mode on $temp_fn: $!\n";
  }

  # write new data to temporary file 
  die "Cannot open temporary output file $temp_fn: $!\n" unless $temp_fh;
  print $temp_fh "# Generated by $0 on ".gmtime(time())." UTC\n";
  print $temp_fh "# from ".($uid?"groups and uids":"groups")." @ARGV\n";
  foreach ( keys %uniqueKeys ) { print $temp_fh "$_\n"; }
  die "Cannot create temporary output file ($temp_fn): $!\n" unless close $temp_fh;

  # by construction the temp_fn and outputfile are in the same directory
  # and rename(2) is atomic even if the target file exists
  if ( ! rename $temp_fn, $outputfile ) {
    die "Cannot install new $outputfile from $temp_fn: $!\n";
  }

} else {
  # just write to stdout
  foreach ( keys %uniqueKeys ) { print "$_\n"; }
}


##############################################################################
# recursively resolve sshPublicKey attributes from entries
#
sub walkDN($$) {
  my ($dn) = @_;

  my $results=$ldap->search(
                base=>$dn,
                scope=>"base",
                filter=>$ldapfilter
                );
  # one may continue here, since it's an implicit result match
  if ( $results->code ) { 
    &do_warn("Search failed for $dn: ".$results->error.": no entry\n");
  } else {
    $results->count() or &do_warn("No entries found matching $dn - entry disappeared\n");
  }

  # list of entries for all groups matching this groupRDN
  my @entries=$results->entries;
  
  # groups need to be recursively matched, uids are leaf entries
  # but groups may have some explicit sshPublicKey attributes
  #
  foreach my $entry ( @entries ) {

    my @classes = $entry->get_value("objectclass");

    if ( grep /ldapPublicKey/,@classes ) {
      push @keys, &writeUidLines($entry);
    }

    if ( grep(/groupOfUniqueNames/,@classes) || grep(/groupOfNames/,@classes) ) {
      foreach my $subdn ( $entry->get_value("uniqueMember") ) {
        &walkDN($subdn);
      }
      foreach my $subdn ( $entry->get_value("Member") ) {
        &walkDN($subdn);
      }
    }

  }
  return;
}


##############################################################################
# fill an array with ssh keys for a (list of) uid DNs
#
sub writeUidLines($$) {
      my ( $uidentry, $basename ) = @_;
      my @lines;

      return () if ( ! defined $uidentry->get_value("sshPublicKey") );

      foreach my $keyAttrib ( $uidentry->get_value("sshPublicKey") ) {
            defined $commandprefix and $commandprefix ne "" and do {
              my ($val,$cmd) = ("",$commandprefix);
              $val = $uidentry->get_value('uid');
              $cmd=~s/\@UID\@/$val/g;
              $val = $uidentry->get_value('cn');
              $cmd=~s/\@CN\@/$val/g;
              $val = $uidentry->get_value('uidNumber');
              $cmd=~s/\@UIDNUMBER\@/$val/g;
              $val = $uidentry->get_value('gidNumber');
              $cmd=~s/\@GIDNUMBER\@/$val/g;
              $keyAttrib=~s/^.* (ssh-\wsa\s+)/$1/;
              $keyAttrib=~s/^.* (\d+\s+\d+\s+)/$1/;
              $keyAttrib="$cmd $keyAttrib";
            };
            $commentuid and $keyAttrib=$keyAttrib." ## ".$uidentry->get_value('uid')." (".$uidentry->get_value('uidNumber').")";
            push @lines,$keyAttrib;
      };

      return @lines;
}

# support routines
sub do_warn(@) {
  die "@_" if ($exit_on_error);
  printf STDERR "@_" unless $quiet;
}

# ###########################################################################
# ConfigTiny is imported here in-line since it is an unusual dependency
# but we may need it to parse sssd.conf
#
package ConfigTiny;

# derived from Config::Tiny 2.12, but with some local mods and
# some new syntax possibilities

# If you thought Config::Simple was small...

use strict;
BEGIN {
        require 5.004;
        $ConfigTiny::VERSION = '2.12';
        $ConfigTiny::errstr  = '';
}

# Create an empty object
sub new { bless {}, shift }

# Create an object from a file
sub read {
        my $class = ref $_[0] ? shift : ref shift;

        # Check the file
        my $file = shift or return $class->_error( 'You did not specify a file name' );
        return $class->_error( "File '$file' does not exist" )              unless -e $file;
        return $class->_error( "'$file' is a directory, not a file" )       unless -f _;
        return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;

        # Slurp in the file
        local $/ = undef;
        open CFG, $file or return $class->_error( "Failed to open file '$file': $!" );
        my $contents = <CFG>;
        close CFG;

        return $class->read_string( $contents );
}

# Create an object from a string
sub read_string {
        my $class = ref $_[0] ? shift : ref shift;
        my $self  = $class;
        #my $self  = bless {}, $class;
        #my $self  = shift;
        return undef unless defined $_[0];

        # Parse the file
        my $ns      = '_';
        my $counter = 0;
        my $content = shift;
        $content =~ s/\\(?:\015{1,2}\012|\015|\012)\s*//gm;
        foreach ( split /(?:\015{1,2}\012|\015|\012)/, $content ) {
                $counter++;

                # Skip comments and empty lines
                next if /^\s*(?:\#|\;|$)/;

                # Remove inline comments
                s/\s\;\s.+$//g;

                # Handle section headers
                if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
                        # Create the sub-hash if it doesn't exist.
                        # Without this sections without keys will not
                        # appear at all in the completed struct.
                        $self->{$ns = $1} ||= {};
                        next;
                }

                # Handle properties
                if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
                        $self->{$ns}->{$1} = $2;
                        next;
                }

                # Handle settings
                if ( /^\s*([^=]+?)\s*$/ ) {
                        $self->{$ns}->{$1} = 1;
                        next;
                }

                return $self->_error( "Syntax error at line $counter: '$_'" );
        }

        return $self;
}

# Save an object to a file
sub write {
        my $self = shift;
        my $file = shift or return $self->_error(
                'No file name provided'
                );

        # Write it to the file
        open( CFG, '>' . $file ) or return $self->_error(
                "Failed to open file '$file' for writing: $!"
                );
        print CFG $self->write_string;
        close CFG;
}

# Save an object to a string
sub write_string {
        my $self = shift;

        my $contents = '';
        foreach my $section ( sort { (($b eq '_') <=> ($a eq '_')) || ($a cmp $b) } keys %$self ) {
                my $block = $self->{$section};
                $contents .= "\n" if length $contents;
                $contents .= "[$section]\n" unless $section eq '_';
                foreach my $property ( sort keys %$block ) {
                        $contents .= "$property=$block->{$property}\n";
                }
        }

        $contents;
}

# Error handling
sub errstr { $ConfigTiny::errstr }
sub _error { $ConfigTiny::errstr = $_[1]; undef }

1;

