#! /usr/bin/perl

# ldap-diff:

# Given two LDIF files, compares them, and generates LDIF output that
# can change the directory that generated the original LDIF file to
# match the target LDIF file, when used on that original machine with
# ldapmodify -f.

# Copyright (C) 2009  Nick Urbanik <nicku@nicku.org>

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# 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.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

use strict;
use warnings;

use Getopt::Long;
use Net::LDAP::LDIF;
use Net::LDAP::Entry;
use Net::LDAP::Util qw(canonical_dn);
use Data::Dumper;

$Data::Dumper::Indent = 1;
$Data::Dumper::Quotekeys = 0;

# A bit like the shell command comm, but doesn't require the
# arrays to be sorted.
# Will include duplicates, E.g.:
# my @a = ( 1, 2, 1000, 200, 1, 3, 7, 200, 50 );
# my ( $o, $n, $b ) = adiff [ @a, 1 ], [ @a, 8, 8 ];
# print "adiff [ \@a, 1 ], [ \@a, 8 ] = '@$o', '@$n', '@$b'\n";
# adiff [ @a, 1 ], [ @a, 8 ] = '', '8 8', '1 2 1000 200 1 3 7 200 50'

sub adiff {
    my @old = @{$_[0]};
    my @new = @{$_[1]};
    my ( %old, %new );
    @old{@old} = ();
    @new{@new} = ();
    my @only_new = grep { not exists $old{$_} } @new;
    my @only_old = grep { not exists $new{$_} } @old;
    my @both = grep { exists $old{$_} } @new;
    return ( \@only_old, \@only_new, \@both );
}

# Two array refs:
# Not equal if unequal lengths;
# equal if all elements of @$b are found in @$a, in any order, ignoring duplicates.
# aequal says these pairs are equal:
# ( 1, 1, 2 ) and ( 2, 1, 2 )
# ( 1, 2 ) and ( 2, 1 )
# This is okay for comparing lists of values for one LDAP attribute.

sub aequal {
    my ( $a, $b ) = @_;
    return if @$a != @$b;
    my %seen;
    @seen{@$a} = ();
    return ! grep { not exists $seen{$_} } @$b;
}

# Remove all duplicates from a list, keeping them in the order in
# which they were first seen.

sub uniq {
    my %seen;
    return grep { not $seen{$_}++ } @_;
}

# Bad for big files: slurps this into *all* memory in a *big* way.

sub parse_ldif {
    my ( $filename ) = @_;
    my %ldif;
    my $ldif = Net::LDAP::LDIF->new( $filename, 'r', onerror => 'undef' );
    while ( not $ldif->eof() ) {
	my $entry = $ldif->read_entry();
	if ( $ldif->error() ) {
            warn "Error msg: ", $ldif->error(), "\n";
            warn "Error lines:\n", $ldif->error_lines(), "\n";
	} else {
	    my $dn = canonical_dn( $entry->dn(), casefold => 'lower' );
	    warn "FOUND $ldif{$dn} MORE THAN ONCE IN '$filename'\n"
		if exists $ldif{$dn};
	    $ldif{$dn} = $entry;
	}
    }
    $ldif->done();
    return \%ldif;
}

# Return a string if arrayref of length 1 or 0.
# required to satisfy this in man Net::LDAP::Entry:
#   'Each "VALUE" should be a string if only a single value is wanted
#    in the attribute, or a reference to an array of strings if
#    multiple values are wanted.'

sub deref {
    my ( $val ) = @_;
    return $val unless ref $val;

    if ( ref $val eq 'ARRAY' ) {
	return shift @$val if @$val == 1;
	return q{} if @$val == 0;
	return $val;
    } else {
	warn "Expected a scalar or arrayref for '$val'\n";
	return $val;
    }
}

my $debug = 0;
my @system_attributes = qw( entryUUID entryCSN createTimestamp modifyTimestamp
    creatorsName modifiersName structuralObjectClass );
my $sys_re = join q{|}, @system_attributes;

# Both parameters are of type Net::LDAP::Entry.

# We produce a Net::LDAP::Entry that, if an update( $ldap ) method
# were called on it, where $ldap is a Net::LDAP connection to the
# original directory (the one that produced $old), would produce an
# entry like $new.

# Later we can use the Net::LDAP::LDIR::write_entry() method to
# produce LDIF with the changes that, when fed to ldapmodify, would
# make the entry $old change to look like $new.

sub change {
    my ( $old, $new, $system ) = @_;
    my @adds = my @deletes = my @replaces = ();
  ATTR:
    foreach my $attr ( $old->attributes() ) {
	next ATTR if not $system and $attr =~ m{^(?:$sys_re)$}io;
	if ( my @new = $new->get_value( $attr ) ) {
	    my @old = $old->get_value( $attr );
	    push @deletes, $attr, [] unless @new;
	    next ATTR if aequal \@old, \@new;
	    # Now we have at least one value in each, with at least
	    # one difference.
	    my ( $only_old, $only_new, $both ) = adiff \@old, \@new;
	    push @replaces, $attr => deref $only_new and next ATTR
		unless @$both;
	    push @deletes, $attr => deref $only_old if @$only_old;
	    push @adds, $attr => deref $only_new if @$only_new;
	}
    }

    # Any attributes left in $new that are not in $old need to be added:
  ATTR:
    foreach my $attr ( $new->attributes() ) {
	next ATTR if not $system and $attr =~ m{^(?:$sys_re)$}io;
	push @adds, $attr => deref [ $new->get_value( $attr ) ]
	    unless defined $old->get_value( $attr );
    }
    return unless @adds or @deletes or @replaces;
    my $entry = Net::LDAP::Entry->new( $new->dn() );
    print Data::Dumper->Dump( [ \@adds, \@deletes, \@replaces ],
			      [ qw(*adds *deletes *replaces) ] ) if $debug > 1;
    print STDERR "Length of adds = '", scalar @adds, "', langth of deletes = '",
	scalar @deletes, "', length of replaces = '",
	scalar @replaces, "\n"  if $debug;
    $entry->changetype( 'modify' );
    $entry->add( @adds ) if @adds;
    print 'entry after add: ', Dumper( $entry ) if $debug > 2 and @adds;
    $entry->delete( @deletes ) if @deletes;
    print 'entry after deletes: ', Dumper( $entry ) if $debug > 2 and @deletes;
    $entry->replace( @replaces ) if @replaces;
    print 'entry after replace: ', Dumper( $entry ) if $debug > 2 and @replaces;
    return $entry;
}

sub ldif_modify {
    my ( $old, $new, $system, $ldif ) = @_;
    my $entry = change( $old, $new, $system ) or return;
    return $ldif->write_entry( $entry );
}

sub ldif_add {
    my ( $entry, $system, $ldif ) = @_;
    $entry->changetype( 'add' );
    $entry->delete( map { $_ => [] } @system_attributes ) unless $system;
    return $ldif->write_entry( $entry );
}

sub ldif_delete {
    my ( $entry, $ldif ) = @_;
    $entry->changetype( 'delete' );
    return $ldif->write_entry( $entry );
}

sub usage {
    ( my $prog = $0 ) =~ s{.*/}{};
    print <<END;
Usage: $prog --orig=OLD-LDIF --target=TARGET-LDIF [--debug] [--system]
TARGET-LDIF is a file containing LDIF from the LDAP master
OLD-LDIF is the incorrect LDIF on the slave.

Produces LDIF suitable for feeding to ldapmodify on the master
authenticating using the updatedn.

multiple --debug options increase debugging level.

--system includes the system attributes in the LDIF:
@system_attributes
Without --system, these are excluded.

Currently reads *both* LDIF files into memory in a very over-the-top
manner, so only use this for small LDIF files or on a machine with
masses of RAM and swap.

TODO:
Read one LDIF file into a Berkeley DB_file, then iterate over the other,
Looking up the corresponding entry in the Berkeley DB file.

Can we really store Net::LDAP::Entry objects in the DB file and have them
come back to life as we read them?

Perhaps store the LDIF, then as we read them, convert to Net::LDAP::Entry
objects.  Will also reduce storage requirements, as an LDIF entry consumes
far less space than a Net::LDAP::Entry object.
END
    exit 1;
}

my ( $orig, $target, $system );

GetOptions (
    'orig=s' => \$orig,
    'target=s' => \$target,
    'system!' => \$system,
    'debug+' => \$debug,
    help => sub { usage },
) or usage;

usage unless $orig and $target;

my %orig = %{parse_ldif( $orig )};
my %target = %{parse_ldif( $target )};

print STDERR 'Found ', scalar keys %orig, " record(s) in $orig, ",
    scalar keys %target, " record(s) in $target.\n" if $debug;

print Data::Dumper->Dump( [ \%orig ], [ '*orig' ] ) if $debug > 1;
print Data::Dumper->Dump( [ \%target ], [ '*target' ] ) if $debug > 1;

# The change => 1 parameter causes the LDIF to be written in a form that
# you can give to ldapmodify to perform the operations required to change
# the entries in %orig to become those in %target.

my $ldif = Net::LDAP::LDIF->new( \*STDOUT, 'w', onerror => 'die', change => 1 );
foreach my $dn ( uniq keys %orig, keys %target ) {
    if ( $orig{$dn} and $target{$dn} ) {
	ldif_modify $orig{$dn}, $target{$dn}, $system, $ldif;
    } elsif ( $orig{$dn} ) {
	ldif_delete $orig{$dn}, $ldif;
    } else {
	ldif_add $target{$dn}, $system, $ldif;
    }
}
$ldif->done();