ldaptest

#!/usr/bin/perl
#
# Copyright (c) 2014 Evolveum
#
# 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.
#
# Author: Radovan Semancik
#
# Required packages:
#	Ubuntu: libnet-ldap-perl libauthen-sasl-perl

use strict;
use warnings;

use Net::LDAP;
use Net::LDAP::LDIF;
use Net::LDAP::Util qw(ldap_explode_dn);
use Net::LDAP::Control::VLV;
use Net::LDAP::Control::Sort;
use Net::LDAP::Constant qw( LDAP_CONTROL_VLVRESPONSE );
use Authen::SASL;
use Digest::SHA qw(sha1);
use MIME::Base64;
use Getopt::Long qw(:config bundling no_auto_abbrev pass_through);
use Pod::Usage;
use Data::Dumper;

my ($verbose,$optHelp);
my $hostname;
my $port;
my $uri;
my ($bindDn,$bindPassword,$bindSaslMechanism);

my $debug = 0;

# my $defaultTLSCipherSuite = "TLSv1+RSA:!EXPORT:!NULL"; # OpenSSL
my $defaultTLSCipherSuite = "NORMAL"; # GnuTLS
my $suffix = "dc=example,dc=com";
my $peopleContainer = "ou=people";
my $groupsContainer = "ou=groups";
my $defaultNamingAttribute="uid";
my $defaultNameFormat="u%08d";
my $defaultPasswordFormat="p%08d";
my $defaultObjectClasses = [ qw(top person organizationalPerson inetOrgPerson) ];
my $noPersonAttrs = 0;
my $continuous = 0;
my $quiet = 0;
my $numEntries = "100000";
my $cycles = "10000";

my $displayCountAfter = 1000;

$SIG{__DIE__} = sub { Carp::confess(@_) };

my $test;
if (defined $ARGV[0] && $ARGV[0] !~ /^-/) {
  $test = shift;
}

GetOptions (
  "hostname|h=s" => \$hostname,
  "port|p=i" => \$port,
  "uri|H=s" => \$uri,
  "bindDn|D=s" => \$bindDn,
  "bindPassword|w=s" => \$bindPassword,
  "saslMechanism|Y=s" => \$bindSaslMechanism,
  "suffix|s=s" => \$suffix,
  "continuous|c" => \$continuous,
  "entries|e=i" => \$numEntries,
  "cycles|C=i" => \$cycles,
  "quiet|q" => \$quiet,
  "verbose|v" => \$verbose,
  "help" => \$optHelp,
  ) or usage();
usage() if $optHelp;

if (!defined($test)) {
  $test = shift;
}

if (!$test) { usage(); }
if ($test eq "--help") { usage(); }

if (!$hostname && !$port && !$uri) {
  $uri = "ldapi:///";
} elsif ($hostname && !$port) {
  $port = 389;
} elsif (!$hostname && $port) {
  $hostname = "localhost";
}

if (!$bindDn && !$bindPassword && !$bindSaslMechanism) {
  $bindSaslMechanism = "EXTERNAL";
}

print("DEBUG: $test: hostname: $hostname, port: $port\n") if $debug;

run();

sub run {

  my $conn = ldapConnectBind();

  if ($test eq "searchBase") {
    runTest($conn,"base search",
      sub {
        my $index = int(rand($numEntries));
        my $name = sprintf($defaultNameFormat, $index);
        my $dn = "$defaultNamingAttribute=$name,$peopleContainer,$suffix";
        my $entry = ldapSeachSingle($conn,
          base => $dn,
          filter => "(objectclass=*)",
          scope => "base",
        );
        return $entry;
      }
    );

  } elsif ($test eq "searchUid") {
    runTest($conn,"search by uid",
      sub {
        my $index = int(rand($numEntries));
        my $name = sprintf($defaultNameFormat, $index);
        my $dn = "$peopleContainer,$suffix";
        my $entry = ldapSeachSingle($conn,
          base => $dn,
          filter => "($defaultNamingAttribute=$name)",
          scope => "sub",
        );
        return $entry;
      }
    );

  } elsif ($test eq "searchCnSubstr") {
    runTest($conn,"substring search by cn",
      sub {
        my $index = int(rand($numEntries));
        my $substr = sprintf("%07d", $index/10);
        my $dn = "$peopleContainer,$suffix";
        my $resp = ldapSeach($conn,
          base => $dn,
          filter => "(cn=*$substr*)",
          scope => "sub",
        );
        if ($resp->count < 10 || $resp->count > 11) {
          print STDERR "Got ".$resp->count.", expected 10 or 11: ".$substr."\n";
          return undef;
        }
        return $resp;
      }
    );

  } elsif ($test eq "searchUidVlv") {
    vlvSearch($conn, 'uid', 9);

  } elsif ($test eq "searchCnVlv") {
    vlvSearch($conn, 'cn', 9);

  } else {
    die("Unknown test $test\n");
  }

  ldapDisconnect($conn);
}

sub vlvSearch {
  my ($conn, $sortAttr, $after) = @_;
  my $vlv  = Net::LDAP::Control::VLV->new(
     before  => 0,
     after   => $after,
     content => 0,
     offset  => 1,
   );
  my $sort = Net::LDAP::Control::Sort->new( order => 'uid:2.5.13.3' );
  my $dn = "$peopleContainer,$suffix";
  
  runTest($conn,"VLV search by ".$sortAttr,
    sub {
      my $index = int(rand($numEntries));
      $vlv->offset($index);
      my $resp = ldapSeach($conn,
        base => $dn,
        filter => "(objectclass=inetorgperson)",
        scope => "sub",
        control => [ $sort, $vlv],
      );
      if ($resp->count < 1 || $resp->count > $after + 1) {
        print STDERR "Got ".$resp->count.", expected max ".($after+1).": ".$index."\n";
        return undef;
      }
      my $vlvresp = $resp->control( LDAP_CONTROL_VLVRESPONSE ) or die;
      $vlv->response($vlvresp);
      return $resp;
    }
  );
}

sub runTest {
  my ($conn,$testName,$searchClosure) = @_;

  if (!$quiet) {
    print "Staring $testName test, $cycles cycles\n";
  }

  my $startTime = time();
  my $try = 1;
  my $errors = 0;
  for (; $try <= $cycles; $try++) {

    my $testResult = &$searchClosure($try);

    if ($testResult) {
      # TODO: check entry
    } else {
      $errors++;
    }

    if (!$quiet && ( $try % $displayCountAfter == 0 )) {
      my $nowTime = time();
      my $durSec = $nowTime - $startTime;
      my $etaSec = ($durSec*($cycles-$try))/$try;
      my $rate = "INF";
      if ($durSec != 0) {
         $rate = $try/$durSec;
      }
      my $etaEnd = localtime($nowTime + $etaSec);
      print "$try ops in $durSec seconds ($rate ops per second). ETA in $etaSec sec ($etaEnd)\n";
    }
  }
  
  my $stopTime = time();
  my $durSec = $stopTime - $startTime;
  if (!$quiet) {
    my $rate = $try/$durSec;
    print "$try $testName ops in $durSec seconds\n";
    print "$rate ops per second\n";
    print "average op duration ".(($durSec/$try)*1000)."ms\n";
    print "errors: $errors\n";
  }
  
}

##### UTIL functions

####### LDAP functions

sub ldapConnect {
  my $conn;
  if ($uri) {
    $conn = Net::LDAP->new($uri) or die("Error connecting to $uri: ".$@."\n");
  } else {
   $conn = Net::LDAP->new($hostname,
              port => $port,
          ) or die("Error connecting to $hostname:$port: ".$@."\n");
  }
  return $conn;
}

sub ldapBind {
  my ($conn,$die) = @_;
  
  my $resp;
  my $desc;
  if ($bindDn) {
    $desc = "$bindDn (simple bind)";
    $resp = $conn->bind($bindDn,
      password => $bindPassword,
    );
  } elsif ($bindSaslMechanism) {
    $desc = "(SASL $bindSaslMechanism)";
    $resp = $conn->bind($bindDn,
      sasl => Authen::SASL->new(
        mechanism => $bindSaslMechanism,
      ),
    );
  } else {
    $desc = "(anonymous bind)";
    $resp = $conn->bind();
  }
  if ($die && $resp->code) {
    die("Error binding as $desc: ".$resp->error." (".$resp->code.")\n");
  }
  return ($resp,$desc);
}

sub ldapConnectBind {
    my $conn = ldapConnect();
  ldapBind($conn,1);
  return $conn;
}

sub ldapSeach {
  my ($conn,%params) = @_;

  my $resp = $conn->search(%params);

  if ($resp->code) {
    if ($continuous) {
      print STDERR "Error searching ".$params{base}.": ".$resp->error." (".$resp->code.")\n";
      return undef;
    } else {
      die("Error searching ".$params{base}.": ".$resp->error." (".$resp->code.")\n");
    }
  }
  
  return $resp;
}

sub ldapSeachSingle {
  my ($conn,%params) = @_;
  my $resp = ldapSeach($conn,%params);
  if ($resp->count == 0) {
    if ($continuous) {
      print STDERR "Error searching ".$params{base}.": no object found\n";
      return undef;
    } else {
      die("Error searching ".$params{base}.": no object found\n");
    }
  }
  if ($resp->count > 1) {
    if ($continuous) {
      print STDERR "Error searching ".$params{base}.": ".$resp->count." entries found, expected just one\n";
      return undef;
    } else {
      die("Error searching ".$params{base}.": ".$resp->count." entries found, expected just one\n");
    }    
  }
  return $resp->entry(0);
}

sub ldapDisconnect {
  my ($conn) = @_;
  
  my $resp = $conn->unbind;
  if ($resp->code) {
    die("Unbind: ERROR: ".$resp->error." (".$resp->code.")\n");
  }
  
  $conn->disconnect;  
}

### USAGE and DOCUMENTATION

sub usage {
  pod2usage(-verbose => 2);
  exit(1);
}

sub man {
  pod2usage(-verbose => 3);
  exit(0);
}

__END__

=head1 NAME

ldapgenerate - LDAP entry generator

=head1 SYNOPSIS

ldapgenerate [options] numentries


=head1 OPTIONS

=over 8

=item [ B<-h> | B<--hostname> ] I<hostname>

Specifies hostname of the LDAP server.

=item [ B<-p> | B<--port> ] I<portnumber>

Specifies port number of the LDAP server. Defaults to 389.

=item [ B<-H> | B<--uri> ] I<URI>

Specifies complete URI for LDAP server connection. ldap://, ldaps:// and ldapi:// URIs can be used.
Defaults to C<ldapi:///>

=item [ B<-D> | B<--bindDn> ] I<DN>

Specifies DN which will be used for LDAP Bind operation.

=item [ B<-w> | B<--bindPassword> ] I<password>

Specifies password which will be used for LDAP Bind operation.

=item [ B<-Y> | B<--saslMechanism> ] I<mech>

Specifies a SASL mechanism to used for LDAP Bind operation.

=item [ B<-v> | B<--verbose> ]

Increases verbosity.

=item B<--help>

Displays help message.

=back

=head1 DESCRIPTION

TODO

=head1 EXAMPLES

  ldapgenerate -h myserver.example.com -D "uid=admin,ou=people,dc=example,dc=com" -w secret 100
  
  slapdconf -Y EXTERNAL 1000

=head1 NOTES

This is still work in progress. Please feel free to contribute.

=head1 AUTHOR

Radovan Semancik

=cut