#!/usr/bin/perl -w
# ldifconvert.pl -- konvertiere LDIF zw. Directories mit unterschiedl. Schemata
# erstellt: 30.07.2001, Peter Marschall
# letzte Änderung: $Date: 2002/07/20 14:55:46 $, $Author: amarscha $


## define used packages ##
use locale;
use Getopt::Long;
use Net::LDAP 0.26;
use Net::LDAP::LDIF;
use Net::LDAP::Schema;
use URI;
use URI::ldap;
use strict;

## declare functions ##
sub readPassword();
sub getSchema($$$$$);
sub intersect(\@@);
sub differ(\@@);
sub subset(\@@);
sub error($@);
sub usage($);


## initialize global variables ##
my $ETCDIR = '/usr/local/etc';
my $progname = $0;
   $progname =~ s#.*/(.*?)$#$1#  if ($^O =~ /(?:[iu]x\b|solaris)/i);
   $progname =~ s#.*\\(.*?)$#$1#  if ($^O !~ /(?:[iu]x\b|solaris)/i);
my $rcsid = '$Id: ldifconvert.pl,v 1.14 2002/07/20 14:55:46 amarscha Exp $';

my $LDAPServer = '';
my $LDAPUri = '';
my $LDAPPort = 0;
my $LDAPVersion = 3;
my $BindDN = '';
my $BindPW = '';
my $InputFile = '';
my $OutputFile = '';

# option variables #
my %opt;
my @optionNames = (
  'D|bindDN=s' => \$BindDN,
  'h|host|server=s' => \$LDAPServer,
  'H|URI|uri|URL|url=s' => \$LDAPUri,
  'p|port=s' => \$LDAPPort,
  'P|protocol=s' => \$LDAPVersion,
  'w|password=s' => \$BindPW,
  'W',
  'ldaps',
  'tls|ssl|Z',
  'x',
  'q|quiet',
  'help',
  'V|version',
);


##### initialisation #####
BEGIN {
  if (($^O =~ /[iu]x\b/i) || ($^O =~ /solaris/i))
  {
    # Turn off all warnings etc whilst initializing
    # IO::Socket::SSL and Net::SSLeay.
    local $^W = 0;
    no strict;
    require Net::SSLeay;
    # The /dev/urandom is a device on Linux that returns
    # random data.
    Net::SSLeay::randomize('/dev/urandom');
    require Net::LDAPS;

    # let URI::ldap also work on URLs with scheme ldaps:
    sub URI::ldap::_init_implementor
    {
      URI::_init_implementor(@_);
    }
    URI::implementor("ldaps", 'URI::ldap');
  }
}


##### main() function #####
my $inldif;
my $outldif;
my $schema;
my @objectclasses;

  # get options #
  Getopt::Long::Configure('bundling', 'require_order', 'no_ignore_case');
  if (GetOptions(\%opt, @optionNames) == 0)
  {
    usage(1);
  }
  if ($opt{V})
  {
  my $version = $rcsid;

    $version =~ s/^\S*\s\S*\s(\S*)\s.*/$1/;
    print STDERR $progname . ' version ' . $version . "\n";
    exit(0);
  }
  if ($opt{help})
  {
    usage(0);
  }

  # check options #
  error(1, 'option -H|--uri and -h|--host, -p|--port, --ldaps are mutually exclusive')
    if (($LDAPUri) && (($LDAPServer) || ($LDAPPort) || ($opt{ldaps})));

  error(1, 'illegal LDAP version; should be one of: 2, 3')
    if (($LDAPVersion) && ($LDAPVersion !~ /^[23]$/));

  error(1, 'TLS and LDAPS are mutually exclusive')
    if (($opt{tls}) && ($opt{ldaps}));

  error(1, 'TLS is only defined for LDAPv3')
    if (($opt{tls}) && ($LDAPVersion < 3));

   error(1, 'options -w|--password and -W are mutually exclusive')
    if (($BindPW) && ($opt{W}));

  # initialize uninitialized options
  foreach my $key (@optionNames)
  {
    if ($key !~ /[%@]$/)        # only with scalars
    {
    my $isString = ($key =~ /[:=]s[%@]?$/i);

      $key =~ s/^([^|=:+!]*)[|=:+!].*$/$1/;
      $opt{$key} = ($isString) ? '' : 0  if (($key) && (!$opt{$key}));
    }
  }

  # set values for options #
  if ($LDAPUri)
  {
  my $uri = URI->new($LDAPUri) ||
      error(1, 'illegal LDAP URI:', $LDAPUri);

    $opt{ldaps} = ($uri->scheme() =~ /^ldaps$/i) ? 1 : 0;
    $LDAPServer = $uri->host();
    $LDAPPort = $uri->_port()  if ($uri->_port());
  }
  $LDAPPort = (($opt{ldaps}) ? 636 : 389)  if ($LDAPPort == 0);
  $BindPW = readPassword()  if ($opt{W});  

  # check number of arguments #
  if (($#ARGV < 1) || ($#ARGV > 1))
  {
    usage(1);
  }

  # do the work #

  # read file names from comman line
  ($InputFile,$OutputFile) = @ARGV; 
  
  # load schema
  $schema = getSchema($LDAPServer, $LDAPPort, $LDAPVersion, $BindDN, $BindPW);
  @objectclasses = map { lc($_->{name}) } $schema->all_objectclasses();


  # open ldif files for reading and writing
  $inldif = Net::LDAP::LDIF->new($InputFile, 'r',
                                 onerror => 'undef', encode => 'base64')  or
    error(1, 'unable to open', $InputFile);
  $outldif = Net::LDAP::LDIF->new($OutputFile, 'w',
                                  onerror => 'undef', encode => 'base64')  or
    error(1, 'unable to open', $OutputFile);

  # loop over input entries
  while (! $inldif->eof())
  {
  my $entry = $inldif->read_entry();
  my @oc;

    error(1, $inldif->error())  if ($inldif->error());
   
    # calculate entry's legal objectclasses
    @oc = map { lc } $entry->get_value('objectclass');
    @oc = intersect(@oc, @objectclasses);
    
    # if any of the entry's objectclasses are legal ...
    if (@oc)
    {
    my @octypes = map { $schema->objectclass($_)->{structural}; } @oc;

      $entry->replace('objectclass', \@oc);

      # if at least one of the entry's objectclasses is structural ...
      if (grep(/1/, @octypes))
      {
      my @attributes = map { lc } $entry->attributes() ;
      my @musts = map { lc } map { $schema->must($_); } @oc ;
      my @mays = map { lc } map { $schema->may($_); } @oc ;

        # strip attributes that are illegal for the entry's legal objectclasses
        foreach my $name (differ(@attributes, @musts, @mays))
        {
          $entry->delete($name);
        }

        # if all must attributes are in the remaining attributes ...
        @attributes = map { lc } $entry->attributes();

        if (subset(@musts, $entry->attributes()))
        {
          # write the entry
          $outldif->write_entry($entry);

          error(1, $outldif->error())  if ($outldif->error());
        }
      }
    }

  }
  #close input and output LDIF file
  $inldif->done();
  $outldif->done();

exit(0);


##### function definitions #####

## read password from prompt ##
# Synopsis: $password = readPassword()
sub readPassword()
{
my $password;

  if (($^O =~ /[iu]x\b/i) || ($^O =~ /solaris/i))
  {
    if (eval{ require Term::ReadPassword })
    {
      $password = Term::ReadPassword::read_password('LDAP Password: ');
    }
    elsif (eval{ require Term::ReadLine })
    {
    my $term;
#    local *TTY;
#    local *NUL;
#
#      # open TTY for input and prompt and NULL for output
#      open(TTY, '+</dev/tty')  ||  error(1, 'unable to open', '/dev/tty');
#      open(NUL, '>/dev/null')  ||  error(1, 'unable to open', '/dev/null');
#
#      # make open files unbuffered (and re-select STDOUT for output)
#      select(TTY); $| = 1;
#      select(NUL); $| = 1;
#      select(STDOUT);
#
#      # create Term::ReadLine object
#      $term = Term::ReadLine->new($progname, *TTY, *NUL);
#
#      # prompt (DIY because $term writes to NUL) and read password
#      print TTY 'LDAP password: ';
#      $password = $term->readline('');
#      print TTY "\n";
#
#      # close opened files
#      close(TTY);
#      close(NUL);
      select(STDOUT); $| = 1;
      print 'LDAP password: ';
      $term = Term::ReadLine->new($progname, *STDIN, *STDIN);
      $password = $term->readline('');
    }
    else
    {
      # last resort: displays password on screen, but better than nothing
      select(STDIN); $| = 1;
      select(STDOUT); $| = 1;
      print STDOUT 'LDAP password: ';
      read(STDIN, $password, 1024);
    }
  }
  else
  {
    # last resort: displays password on screen, but better than nothing
    select(STDIN); $| = 1;
    select(STDOUT); $| = 1;
    print STDOUT 'LDAP password: ';
    read(STDIN, $password, 1024);
  }

  return($password || '');
}


## get schema info from directory ##
# Synopsis:  getSchema($server, $port, $version, $bindDN, $bindPW)
sub getSchema($$$$$)
{
my $server = shift || 'localhost';
my $port = shift || 389;
my $version = shift || 3;
my $bindDN = shift;
my $bindPW = shift;
my $schema;
my $ldap;
my $mesg;

  # connect to LDAP-Server
  if ($opt{ldaps})
  {
    $ldap = Net::LDAPS->new($server,
                            version => $version,
                            port => $port,
                            verify => 'none')  ||  error(1, $@);
  }
  else
  {
    $ldap = Net::LDAP->new($server,
                           version => $version,
                           port => $port)  ||  error(1, $@);

    if ($opt{tls})
    {
      $mesg = $ldap->start_tls(verify => 'none');

      # quit on error
      error(1, $mesg->error())  if ($mesg->code());
    }
  }

  # bind to LDAP-Server: either with user/password or anonymously
  $mesg = ($BindDN ne '') ?
           $ldap->bind($BindDN, password => $BindPW) :
           $ldap->bind();

  # quit on error
  error(1, $mesg->error())  if ($mesg->code());

  $schema = $ldap->schema();
  error(1, "unable to access schema")  if (!$schema);

  $ldap->unbind();

  return($schema);
}


## return intersection between two lists ##
# Synopsis:  @intersection = intersect(\@set1, @set2)
sub intersect(\@@)
{
my @array1 = @{+shift};
my @array2 = @_;
my @result;

  foreach my $elem (@array1)
  {
    push(@result, $elem)  if (grep(/^\Q$elem\E$/, @array2));
  }

  return(@result);
}


## return all elements of fist list that are not in second list ##
# Synopsis:  @difference = differ(\@set1, @set2)
sub differ(\@@)
{
my @array1 = @{+shift};
my @array2 = @_;
my @result;

  foreach my $elem (@array1)
  {
    push(@result, $elem)  if (! grep(/^\Q$elem\E$/, @array2));
  }

  return(@result);
}


## test if a list is a subset of another list ##
# Synopsis:  $result = subset(@part, @whole)
sub subset(\@@)
{
my $testref = shift;
my @allowed = @_;

  foreach my $elem (@$testref)
  {
    return(0)  if (! grep(/^\Q$elem\E$/, @allowed));
  }
  return(1);
}


## print out error message and eventually exit ##
# Synopsis:  error($status, $message)
sub error($@)
{
my $status = shift;
my @msg = @_;

  if (! $opt{q})
  {
    print STDERR $progname . ": " . join(" ", @msg) . "\n";
  }

  if ($status)
  {
    exit($status);
  }
}


## print out usage message and exit ##
# Synopsis:  usage($status)
sub usage($)
{
my $status = shift;

  print STDERR "Usage: $progname [<options>] <input-file> <output-file>\n";

  if (! $status)
  {
    print STDERR "  where <options> are\n" .
                 "    -D  --bindDN <bind-dn>     bind to server using <bind-dn>\n\n" . 
                 (($BindDN) ?
                   "                               (default: $BindDN)\n" : "") .
                 "    -h  --host <server>        connect to <server>\n" .
                 (($LDAPServer) ?
                   "                               (default: $LDAPServer)\n" : "") .
                 "    -H  --uri <uri>            connect to <uri>\n" .
                 (($LDAPUri) ?
                   "                               (default: $LDAPUri)\n" : "") .
                 "    -p  --port <port>          connect to server using <port>\n" .
                 (($LDAPPort) ?
                   "                               (default: $LDAPPort)\n" : "") .
                 "    -P  --protocol <version>   use LDAP protocol <version>\n" .
                 (($LDAPVersion) ?
                   "                               (default: $LDAPVersion)\n" : "") .
                 "    -w  --password <password>  bind to server using <password>\n" . 
                 "    -W                         prompt for bind password\n" .
                 "    -x                         (ignored; for compatibility)\n" .
                 ((($^O =~ /[iu]x\b/i) || ($^O =~ /solaris/i)) ?
                   "        --ldaps                use LDAPS\n" .
                   "    -Z  --tls  --ssl           use TLS with LDAPv3\n" : "") .
                 "    -q  --quiet                silent operation (no error messges)\n" . 
                 "        --help                 show this help page\n" . 
                 "    -V  --version              display version number\n"; 
  }  
  else
  {
    print STDERR "For help, type: $progname --help\n";
  }
  exit($status);
}

# EOF
