#!/usr/bin/perl -w

#Author: Aaron Burgemeister (ab@novell.com)                                                                                                                                                                
#Version: 0.1.20090626140000Z
#License: GPL v3 http://www.gnu.org/licenses/gpl.html
#Description: A little script to test LDAP VLV controls as mentioned on this page:
# http://search.cpan.org/~gbarr/perl-ldap-0.39/lib/Net/LDAP/Control.pm

use Term::ReadKey;
use Net::LDAP;
use Net::LDAP::Control::VLV;
use Net::LDAP::Control::Sort;
use Net::LDAP::Constant qw( LDAP_CONTROL_VLVRESPONSE );
use Net::LDAP::Constant qw(LDAP_CONTROL_SORTRESULT);

my($bindServer) = '';
my($bindDN) = '';
my($bindPassword) = '';

#Check for variables.
if(scalar(@ARGV) < 2){usage();}
else
{
  $bindServer = shift(@ARGV);
  $bindDN = shift(@ARGV);
}

#Get the password one way or another.
if(scalar(@ARGV) == 0)
{
  print 'Please enter a password: ';
  ReadMode('noecho');
  $bindPassword = <STDIN>;
  print "\n";
  ReadMode(0);
}
else
{
  $bindPassword = shift(@ARGV);
}
chomp($bindPassword);

#Connect to the server and bind as the user specified.
my($ldap) = Net::LDAP->new($bindServer) or die "Can't bind to ldap: $!\n";

my($mesg) = $ldap->bind(
            dn       => $bindDN,
            password => $bindPassword
        );

#Initial VLV setup.
my($vlv) = Net::LDAP::Control::VLV->new(
    after   => 1,        # No entries from after target entry
    before   => 0,       # 0 entries before target entry
    content => 0,        # List size unknown
    offset  => 1,        # Target entry is the first
);

#SSS Setup
my($sort) = Net::LDAP::Control::Sort->new( order => 'cn' );

#Query Arguments
my(@args) = ( base => '',
    scope => 'subtree',
    attrs => ['dn'],
    filter => '(objectClass=inetOrgPerson)',
    #callback => \&process_entry, # Call this sub for each entry
    control => [ $sort, $vlv ],
);

#Run the search
$mesg = $ldap->search( @args );



# Get VLV response control
($ctrlResp)  = $mesg->control( LDAP_CONTROL_VLVRESPONSE ) or die('Unable to set control response: ' . $!);
$vlv->response( $ctrlResp );

#Dump the results.
foreach $entry ($mesg->entries) { $entry->dump; }

print 'NEW QUERY' . "\n";



# Get new data.
#$vlv->end;
$vlv->scroll(3);
$vlv->before(1);

#Query again.
$mesg = $ldap->search( @args );

# Get VLV response control
($ctrlResp)  = $mesg->control( LDAP_CONTROL_VLVRESPONSE ) or die('Unable to set control response: ' . $!);
$vlv->response( $ctrlResp );

#Dump the results.
foreach $entry ($mesg->entries) { $entry->dump; }

print 'NEW QUERY' . "\n";



# Get new data.
#$vlv->end;
$vlv->scroll(3);
$vlv->before(1);

#Query again.
$mesg = $ldap->search( @args );

# Get VLV response control
($ctrlResp)  = $mesg->control( LDAP_CONTROL_VLVRESPONSE ) or die('Unable to set control response: ' . $!);
$vlv->response( $ctrlResp );

#Dump the results.
foreach $entry ($mesg->entries) { $entry->dump; }

print 'NEW QUERY' . "\n";



# Get new data.
$vlv->scroll(3);
$vlv->before(1);

#Query again
$mesg = $ldap->search( @args );

# Get VLV response control
($ctrlResp)  = $mesg->control( LDAP_CONTROL_VLVRESPONSE ) or die('Unable to set control response: ' . $!);
$vlv->response( $ctrlResp );

#Dump the results.
foreach $entry ($mesg->entries) { $entry->dump; }

print 'NEW QUERY' . "\n";



# Now page with first entry starting with "B" in the middle
$vlv->scroll(3);
$vlv->before(1);

$mesg = $ldap->search( @args );

#Dump the results.
foreach $entry ($mesg->entries) { $entry->dump; }




#Print the result.  I need to find a way to change the return of the entire
#script based on this result, but I'm not sure how consistent 'Success'
#is, especially with l10n/i18n/g11n concerns.
print $mesg->error . "\n";
$ldap->unbind;




#Subroutine to print script usage to the screen.
sub usage
{
  print "\n" . 'Please provide a server, DN and password as arguments.';
  print "\n" . 'Example: ./ldapbind.pl my.ldap.server.tld cn=admin,dc=user,dc=system passwordHere' . "\n\n";
  exit 1;
}

sub process_entry {
  print scalar(@ARGV);
}