#!/usr/bin/perl
#
# krb5-sync-backend -- Manipulate Kerberos password and status change queue.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007, 2008, 2010, 2012
#     The Board of Trustees of the Leland Stanford Junior University
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation, and that the name of Stanford University not be used in
# advertising or publicity pertaining to distribution of the software without
# specific, written prior permission.  Stanford University makes no
# representations about the suitability of this software for any purpose.  It
# is provided "as is" without express or implied warranty.
#
# THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.

##############################################################################
# Declarations and site configuration
##############################################################################

use strict;
use Getopt::Long qw(GetOptions);
use Fcntl qw(LOCK_EX O_WRONLY O_CREAT O_EXCL);
use POSIX qw(EEXIST);

# Path to the krb5-sync binary.
our $SYNC   = '/usr/sbin/krb5-sync';

# Path to the directory that contains queued changes.
our $QUEUE  = '/var/spool/krb5-sync';

# Regexes of error messages to ignore when running in silent mode.
our @IGNORE =
    (qr/AD password change for \S+ failed \(3\):.*Connection timed out$/,
     qr/AD password change for \S+ failed \(3\):.*Authentication error$/,
     qr/AD password change for \S+ failed \(3\):.* for service_locator$/,
     qr/AD status change for \S+ failed \(1\): user .* not found in \S+$/);

##############################################################################
# Writing queue files
##############################################################################

# Lock the queue.  We have to do this around any change to the queue or any
# place where we need a consistent snapshot of the queue.  Note that we use
# flock locking; other callers will have to match.
sub lock_queue {
    open (LOCK, '+<', "$QUEUE/.lock")
        or die "$0: cannot open $QUEUE/.lock: $!\n";
    flock (LOCK, LOCK_EX);
}

# Unlock the queue.
sub unlock_queue {
    close LOCK;
}

# Generate a timestamp from the current time.  We want something that sorts
# even if time_t adds another digit (okay, this code won't last that long, but
# anyway...).
sub timestamp {
    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime;
    $mon++;
    $year += 1900;
    return sprintf("%04d%02d%02dT%02d%02d%02dZ", $year, $mon, $mday, $hour,
                   $min, $sec);
}

# Write out a new queue file.  Takes the username affected, the system, the
# action, a timestamp, and a list of additional lines.
sub queue {
    my ($username, $system, $action, $timestamp, @data) = @_;
    my $baseuser = $username;
    $baseuser =~ s%/%.%;
    my $type = $action;
    $type = 'enable' if $type eq 'disable';
    my $base = "$QUEUE/$baseuser-$system-$type-$timestamp";
    my $file;
    lock_queue;
    for (my $count = 0; $count < 100; $count++) {
        $file = "$base-" . sprintf ("%02d", $count);
        if (sysopen (QUEUE, $file, O_WRONLY | O_CREAT | O_EXCL, 0600)) {
            last;
        }
        die "$0: cannot create $file: $!\n" unless $! == EEXIST;
    }
    print QUEUE "$username\n$system\n$action\n";
    for (@data) {
        print QUEUE "$_";
        print QUEUE "\n" if $_ !~ /\n/;
    }
    close QUEUE or die "$0: cannot flush $file: $!\n";
    unlock_queue;
}

# Queue a password change.  Takes the username, password, and system (ad).
sub queue_password {
    my ($username, $system, $password) = @_;
    if ($system ne 'ad') {
        die "$0: invalid password change destination $system\n";
    }
    queue ($username, $system, 'password', timestamp, $password);
}

# Queue an account enable.  Takes the username.
sub queue_enable {
    my ($username) = @_;
    queue ($username, 'ad', 'enable', timestamp);
}

# Queue an account disable.  Takes the username.
sub queue_disable {
    my ($username) = @_;
    queue ($username, 'ad', 'disable', timestamp);
}

##############################################################################
# Queue listing
##############################################################################

# List the current queue.  Displays the user, the type of event, the
# destination service, and the timestamp.  Sort the events the same way
# they're read when processing the queue.
sub list {
    lock_queue;
    opendir (QUEUE, $QUEUE) or die "$0: cannot open $QUEUE: $!\n";
    my @files = sort grep { !/^\./ } readdir QUEUE;
    closedir QUEUE;
    unlock_queue;
    for my $file (@files) {
        my ($user, undef, undef, $timestamp) = split ('-', $file);
        $timestamp =~ s{^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)(\d\d)Z\z}
                       {$1-$2-$3 $4:$5:$6 UTC};
        open (FILE, '<', "$QUEUE/$file") or next;
        my @data = <FILE>;
        close FILE;
        chomp @data;
        next unless @data >= 3;
        printf "%-8s  %-8s  %-4s  %s\n", $user, $data[2], $data[1],
            $timestamp;
    }
}

##############################################################################
# Queue processing
##############################################################################

# Go through the queue and process each pending event using krb5-sync.
# krb5-sync will remove the files when the processing is successful.  If
# processing any of the queue files of a particular type fails, we skip all
# subsequent queue files of the same type.
sub process {
    my ($silent) = @_;
    chdir $QUEUE or die "$0: cannot chdir to $QUEUE: $!\n";
    lock_queue;
    opendir (QUEUE, '.') or die "$0: cannot open $QUEUE: $!\n";
    my @files = sort grep { !/^\./ } readdir QUEUE;
    closedir QUEUE;
    unlock_queue;
    my %skipped;
    for my $file (@files) {
        my ($id) = ($file =~ /^([^-]+-[^-]+-[^-]+)-/);
        $id ||= 'UNKNOWN';
        next if $skipped{$id};
        my $pid = open (SYNC, '-|');
        if (not defined $pid) {
            die "$0: cannot fork: $!\n";
        } elsif ($pid == 0) {
            if ($silent) {
                open (STDERR, '>&STDOUT') or die "$0: cannot dup STDOUT: $!\n";
            }
            exec ($SYNC, '-f', $file) or die "$0: cannot exec $SYNC: $!\n";
        } else {
            local $/;
            my $output = <SYNC>;
            close SYNC;
            my $ignore;
            for my $regex (@IGNORE) {
                $ignore = 1 if $output =~ /^krb5-sync: $regex/;
            }
            if (not $silent) {
                print $output if $output;
                warn "$0: krb5-sync failed on $file\n" unless $? == 0;
            } elsif (not $ignore and $? != 0) {
                warn $output;
                warn "$0: krb5-sync failed on $file\n";
            }
            unless ($? == 0) {
                $skipped{$id} = 1;
            }
        }
    }
}

##############################################################################
# Queue cleanup
##############################################################################

# Given a number of days, remove all queue files older than that number of
# days.
sub purge {
    my ($days) = @_;
    chdir $QUEUE or die "$0: cannot chdir to $QUEUE: $!\n";
    lock_queue;
    opendir (QUEUE, '.') or die "$0: cannot open $QUEUE: $!\n";
    my @files = sort grep { !/^\./ } readdir QUEUE;
    closedir QUEUE;
    for my $file (@files) {
        if (-M $file > $days) {
            unlink $file or warn "$0: cannot unlink $QUEUE/$file: $!\n";
        }
    }
    unlock_queue;
}

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

# Flush output and clean up the program name for error reporting.
$| = 1;
my $fullpath = $0;
$0 =~ s%.*/%%;

# Read command-line options.
my ($help, $silent) = @_;
Getopt::Long::config ('bundling', 'require_order');
GetOptions ('h|help'   => \$help,
            's|silent' => \$silent);
if ($help) {
    print "Feeding myself to perldoc, please wait....\n";
    exec ('perldoc', '-t', $fullpath);
}
my ($function, @args) = @ARGV;
die "$0: no function specified\n" unless $function;

# Take the appropriate action.
if ($function eq 'disable') {
    die "Usage: sync disable <username>\n" unless @args == 1;
    queue_disable (@args);
} elsif ($function eq 'enable') {
    die "Usage: sync enable <username>\n" unless @args == 1;
    queue_enable (@args);
} elsif ($function eq 'help') {
    print <<'EOH';
Kerberos status synchronization help:
  sync disable <user>                   Queue disable of <user> in AD
  sync enable <user>                    Queue enable of <user> in AD
  sync help                             This text
  sync list                             List pending queued actions
  sync password <user> ad <password>    Queue <user> password change in AD
  sync process                          Process pending queued actions
  sync purge <days>                     Delete queued actions older than <days>
EOH
} elsif ($function eq 'list') {
    die "Usage: sync list\n" unless @args == 0;
    list;
} elsif ($function eq 'process') {
    die "Usage: sync process\n" unless @args == 0;
    process ($silent);
} elsif ($function eq 'password') {
    if (@args == 2) {
        local $/;
        $args[2] = <STDIN>;
    }
    die "Usage: sync password <user> <system> <password>\n" unless @args == 3;
    queue_password (@args);
} elsif ($function eq 'purge') {
    die "Usage: sync purge <days>\n" unless @args == 1;
    purge (@args);
} else {
    die "$0: unknown function $function\n";
}

##############################################################################
# Documentation
##############################################################################

=for stopwords
krb5-sync-backend krb5-sync UTC Allbery timestamp username propagations

=head1 NAME

krb5-sync-backend - Manipulate Kerberos password and status change queue

=head1 SYNOPSIS

B<krb5-sync-backend> B<-h>

B<krb5-sync-backend> (disable|enable) I<user>

B<krb5-sync-backend> (help|list)

B<krb5-sync-backend> [B<-s>] process

B<krb5-sync-backend> password I<user> ad < I<password>

B<krb5-sync-backend> purge I<days>

=head1 DESCRIPTION

B<krb5-sync-backend> provides an interface to the queue of pending
password and account status changes written by either this utility or by
the synchronization plugin after failures.  It can queue account enables,
disables, or password changes for Active Directory, list the queued
actions, or process the queued actions with B<krb5-sync> (telling it to
take its action from a file).

The queue directory will contain files with names in the format:

    <username>-<domain>-<action>-<timestamp>-<count>

where <username> is the name of the affected account (C</> will be
replaced with C<.> in the file name and the realm will be removed),
<domain> is C<ad>, <action> is either C<enable> (used for both enabling
and disabling accounts) or C<password>, <timestamp> is a ISO 8601
timestamp in UTC, and <count> is a two-digit zero-padded number between 0
and 99 (so that we can handle multiple changes that arrive in the same
second).  Each file contains a queued change in the format described in
krb5-sync(8).

Supported arguments to B<krb5-sync-backend> are:

=over 4

=item disable I<user>

Queue a disable action (in Active Directory, as that's the only system
currently supported for enable and disable) for I<user>.

=item enable I<user>

Queue an enable action (in Active Directory, as that's the only system
currently supported for enable and disable) for I<user>.

=item help

List the supported commands.

=item list

List the current contents of the queue.

=item process

Process the queue.  All queued actions will be sorted alphanumerically
(which due to the timestamp means that all changes for a particular user of
a particular type will be done in the order queued).  B<krb5-sync> will be
called for each queued action, as long as it continues to succeed.  If it
fails for a queued action, all other actions sharing the same username,
domain, and action will be skipped and queue processing will continue with
the next action that differs in one of those three parameters.

=item password I<user> ad < I<password>

Queue a password change for I<user> in Active Directory, setting their
password to I<password>.  By default, I<password> is read from standard input.
It can also be passed as a command-line argument, but this is less secure
since the password is then readable by anyone on the system who can see the
command-line arguments of processes.

The entire standard input is taken as the password, including any trailing
newlines, so be careful how the password is provided.  If using something like
B<echo>, use C<echo -n> or the C<\c> flag, depending on your system.

=item purge I<days>

Delete all queued actions last modified longer than I<days> days ago.  This
can be used to clean up old failed change propagations in situations where
accounts may be created or have password changes queued that are later
removed and never created in other environments.

=back

=head1 OPTIONS

=over 4

=item B<-h>, B<--help>

Display this documentation (by running this script through C<perldoc -t> and
exit.  All other options and commands are ignored.

=item B<-s>, B<--silent>

When running the process command, filter out the output of B<krb5-sync> to
ignore common errors and success messages and only show uncommon errors.
This option will filter out all output when B<krb5-sync> is successful and
will filter out error messages matching:

    ^AD password change for \S+ failed \(3\):.*Authentication error$
    ^AD status change for \S+ failed \(1\): user .* not found in \S+$

even when it fails.  (This message generally means the account doesn't exist
in Active Directory.)  The regexes can be modified at the start of this
script.

=back

=head1 FILES

=over 4

=item F</usr/sbin/krb5-sync>

The path to the B<krb5-sync> utility.  This may be changed at the top of
this script.

=item F</var/spool/krb5-sync>

The default path to the queue.  This must match the queue_dir parameter in
F<krb5.conf> used by the plugin.  It can be changed at the top of this
script.

=item F</var/spool/krb5-sync/.lock>

An empty file used for locking the queue.  When writing to or querying the
queue, B<krb5-sync-backend> will open and lock this file with the Perl flock
function, which normally calls flock(2).  Any other queue writers need to
use the same locking mechanism for safe operation.

=back

=head1 SEE ALSO

krb5-sync(8)

The current version of this program is available from its web page at
L<http://www.eyrie.org/~eagle/software/krb5-sync/>.

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=cut
