#!/usr/bin/perl
# !/usr/local/bin/perl
#
# Copyright (c) 1999 - 2001 Clif Harden.  All Rights Reserved
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU GENERAL PUBLIC LICENSE.
#----------------------------------------------------------------------------
#
# This program was originally written by Clif Harden.
# Some of the software in the LDAP search subroutine was orginally
# written by Graham Barr.  It is based on Graham Barr's PERL LDAP 
# module and the PERL TK module.
# Both modules are available from the CPAN.org system.
#
# $Id: tklkup,v 1.27 2002/06/15 02:47:34 charden Exp $
#
# Purpose: This program is designed to retrieve data from a LDAP
#          directory and display on the graphical user interface
#          created by this program.  This program can edit the data
#          retrieved from the directory.
#
#
# Revisions:
# $Log: tklkup,v $
# Revision 1.27  2002/06/15 02:47:34  charden
#
# Added code to close windows after ldap actions are taken.  This is to force
# a new search after data has been changed.
#
# Revision 1.26  2002/05/28 01:54:13  charden
#
# Made several code corrections to the code that stores xml formatted
# schema information in a file.  This is due to the new DSML.pm module.
#
# Revision 1.25  2002/05/25 05:05:55  charden
#
# Change schema code to comprehend the new Schema.pm file.
# Added code to determine new x and y position when the main window moves.
#
# Revision 1.24  2002/01/03 02:53:53  charden
#
# Corrected schema parse and display code to comprehend that a multi-valued
# oid number could be returned from name2oid method. Now use the
# is_attribute, is_objectclass, ...,  methods to determine oid number.
#
# Revision 1.23  2001/12/29 22:53:47  charden
#
# Added code to allow the schema information to be stored in a file as
# DSML XML data.  User can now select to store the data as text or XML.
#
# Revision 1.22  2001/12/29 01:50:27  charden
#
# Added code to allow editing of a entry's attributes.
# This makes this software a full featured LDAP directory interface.
# Added pod documentation about new windows and features.
#
# Revision 1.21  2001/12/17 01:35:45  charden
#
# Added fail safe code to the DELETE entry operation.  This forces the
# user to confirm the delete entry request.
# Added pod documentation for the DELETE fail safe window.
#
# Revision 1.20  2001/12/15 05:06:43  charden
#
# Corrected pod documentation error.
#
# Revision 1.19  2001/12/15 04:57:15  charden
#
# Added code to allow various entry modifications.
# Added code to delete an entry.
# Added code to do a mod RDN on an entry.
# Changed search code to display in a ROText box.
# Started code for entry data modification, this code is not complete
# but will not break anything if used.  It will just display the data
# in the Text box that will be used of modification.
# Updated pod documentation to reflect the code changes.
#
# Revision 1.18  2001/09/09 04:50:31  charden
#
# Corrected several errors regarding how the ldap version information was
# set.  All ldap bind commands use the Global{setVersion} hash.
# Added the nismapname option for detecting Solaris Native LDAP automounter
# directory branches.
#
# Revision 1.17  2001/09/07 01:13:31  charden
#
# Added attributes subschemaSubentry and supportedSASLMechanisms to the
# root_dse display list.
#
# Revision 1.15  2001/08/27 03:11:33  charden
#
# Change code to retrieve schema information when Explore Schema
# button is pressed. The Retrieve Schema button can still be used
# to retrieve schema data.
# Added code to detect objectclass string length and used this to set
# Hierarchial objectclass display window size.
#
# Revision 1.14  2001/08/26 23:58:56  charden
#
# Added setFilter subroutine.
# Added Set Filter Condition menu button.
# Added code to allow setting of 4 different search filter combinations;
# equal, begins with, ends with, and contains.
# Added pod documentation for Set Filter Condition.
#
# Revision 1.13  2001/08/24 03:03:55  charden
#
# Added code to set the environment variable HOME if it is not set.
# ActiveState perl does not seem to have this variable set up like the
# Unix version of perl.
#
# Revision 1.12  2001/08/24 02:43:36  charden
#
# Change the way a Unix or Microsoft system is detected.  Used the
# Perl special variable that knows what platform the perl code was
# compiled on.
#
# Revision 1.11  2001/08/12 02:13:16  charden
#
# Added the Filter attribute and change ldap filter creation code to
# not change the filter data when the Filter attribute is selected.
# Added documentation to pod about this change.
#
# Revision 1.10  2001/08/05 04:06:09  charden
#
# Change several lines of code so that Carp and warn would not
# throw un-initialized variable warnings.
#
# Revision 1.9  2001/07/29 18:54:12  charden
#
# Corrected major stupid error on defining hashes Global and schemaHash.
# Change the way that forking of tklkup takes place, will now only fork on
# HPUX, Sun, and Linux.  It should not fork on Windows systems.
#
# Revision 1.8  2001/06/16 03:57:24  charden
# Made attribute jpegPhoto detection case insenitive.
# Corrected error in window creation in subroutine ERROR.
# Changed the way general error messages are submitted to subroutine
# ERROR.
#
# Revision 1.7  2001/06/15 02:48:46  charden
# Added many enhancements.
# Added the ability to display jpegPhoto attributes when they are encountered
# if the Tk::JPEG module is installed.
# Added the ability to do a hierarchical tree graph of objectclasses.  When a
# branch of the tree is selected, a listing of the objectclasses and their
# attributes is displayed in a list box.
# Added the ability to display the ROOT DSE entry if it can be  obtained.
# Changed several look and feel items, made everything more consistent.
#
# Revision 1.6  2001/05/19 02:48:00  charden
# Corrected code that uses the nameContext to determine branches,
# or bases, in the directory.
# Added code to create an error window for error message display. This
# is for use by rountines that do not have a list window.
#
# Revision 1.3  2000/12/20 03:15:42  charden
# Corrected error in the calling of the get_value method so that
# multi-valued attributes were handled correctly.
#
# Revision 1.2  2000/12/13 02:41:59  charden
# Major rewrite of the tklkup script, many enhancements were made.
#
# Combined schema and tklkup scripts, control of both schema and
# search functions are initiated from a main window.
# Seperate display windows are generated for both schema and search
# results.
# Added ldap bind ability from the main window.
#
# Revision 1.1  2000/07/27 14:39:17  gbarr
# Initial checkin
#
# Revision 1.6  2000/06/18 04:08:16  clif
# Changed several pod commands to enhance the lookup
# and feel of the pod documentation.
#
# Revision 1.5  2000/06/08 01:12:27  clif
# Correct wording in the pod documentation.
#
# Revision 1.4  2000/05/27 21:34:12  clif
# Added the README.tklkup file as a internal pod document.
#
# Revision 1.3  2000/05/27 18:35:38  clif
# Removed leading dashes form Net::LDAP options.  These dashes had been
# depricated.
#
# Revision 1.2  2000/05/27 18:29:35  clif
# Added radio button for selection of version 2 or 3 ldap. Version
# 3 was maded the default version.
# Added code to make the binary user certificate data base64 encoded
# for display purposes.
#
# Revision 1.1  2000/01/23 03:00:20  clif
# Initial revision
#
#
#
#
#
#

use Carp;
use Data::Dumper;
use MIME::Base64;
use Net::LDAP qw(:all);
use Net::LDAP::Filter;
use Net::LDAP::Util qw(ldap_error_name ldap_error_text);
use Net::LDAP::Constant;
use Net::LDAP::DSML;
use Getopt::Std;

use Tk;
use Tk::ErrorDialog;
use Tk::LabFrame;
use Tk::ROText;
use Tk::HList;
use Tk::Label;
#
# Global variables, wish I did not have to use them
# but Tk forces me to.
#
my %Global = ();

#$Global{'jpeg'}   = 1;
#eval { use Tk::JPEG; }; 
#$Global{'jpeg'}   = 0 if ( $@ );

#
# Window roots
#
$Global{'mainWindow'}   = undef();
$Global{'schemaWindow'} = undef();
$Global{'histWindow'}   = undef();
$Global{'portWindow'}   = undef();
$Global{'bindWindow'}   = undef();

my %schemaHash = ();

&init_schemaHash;

$Global{'LDAP_SERVER'} = "localhost";
$Global{'bindpw'} = "tarantella";
$Global{'binddn'} = "cn=DirectoryManager";
$Global{'adata'} = "";
$Global{'info'} = "";
$Global{'slist'} = 0;
$Global{'setVersion'} = 2;  # set version 3 ldap
$Global{'sfile'} = 0;
$Global{'fdata'} = "";
$Global{'hand'}  = 'left';
$Global{'horz'} = 200;
$Global{'vert'} = 20;
$Global{'Font'} = "{ MS Sans Serif} 10";
$Global{'CORE_SERVER'} = "";
$Global{'sclear'} = 0;
$Global{'limit'}  = 30;
$Global{'port'}   = 389;
$Global{'platform'} = ($^O eq 'MSWin32') ? $^O : 'unix' ;
$Global{'max'} = 0;
$Global{'infoFilter'} = "equal";
$Global{'nismapname'} = 0;

my $sbbframe;
my @base       = ();
my $base       = "";
my @BaseButton = ();
my $defaultPort = 389;

#--------------------------------------------------------
# Handle the command line parameter(s)
#--------------------------------------------------------

getopts( 'hdr' );

Usage() if ( $opt_h );

my $debug  = $opt_d ? 1 : 0;

#
#

# Fork this process on start up.
#
#
# If not in debug mode;
# Fork a child process and kill the parent.
# (That sounds nasty)
#

if ( !$debug && $Global{'platform'} eq 'unix' ) {


        FORK: {

                if ( $pid = fork ) {
                        # this is parent process, so DIE
                        # 
                        exit;
                        } 
                elsif ( defined $pid) {
                        # this is the child process, so keep on running
                        #
                        &MAIN_PROCESS();                

                        } # End of elsif in FORK.

        } # End of FORK block.


} # End of if.
else {
        #
        # in debug mode, so do not fork but continue to run.
        #
        &MAIN_PROCESS();
        } # End of else


sub MAIN_PROCESS {

my $rbuid;
my $rbcn;
my $rbsn;
my $rbmail;
my $rbclear;
#my $mainWindow;
my $lframe;
my $sframe;
my $aframe;
my $tframe;
my $bframe;
#my $sbmenu;
my @attribute = ();
my @server    = ();

#
# Check for dot file, use it to configure program.
#

if ( $Global{'platform'} eq 'unix' ) 
{
 $ENV{'TMP'} = "/tmp";
}
else
{
 $ENV{'TMP'} = "./";
}

#
#  Active State Perl does not always set ENV HOME.
#

if ( !$ENV{"HOME"} )
{
 $ENV{"HOME"} = "./";
}

my $dotfile = $ENV{"HOME"} . "/.tklkup";

if ( -e $dotfile && -r $dotfile )
{

open(DOT, "<$dotfile");

@Input = <DOT>;

foreach (@Input)
{

my @data = ();

if ( /^#/ || /^\s+$/ ) { next; }

chomp();
@data = split(/:/);

$data[1] =~ s/^\s*//;
$data[1] =~ s/\s+$//;
$data[2] =~ s/^\s*// if ( defined($data[2]) );
$data[2] =~ s/\s+$// if ( defined($data[2]) );

$_ = $data[0];

TYPE: {

    /^hand/i && do {
                     $Global{'hand'} = $data[1];
                     last TYPE; };

    /^port/i && do {
                     $Global{'port'} = $data[1];
                     last TYPE; };

    /^limit/i && do {
                     if (defined($data[1]) ) 
                     { 
                      $Global{'limit'} = $data[1]; 
                     }
                     else 
                     { 
                      $Global{'limit'} = 30; 
                     }
                     last TYPE; };

    /^attribute/i && do {
                     push(@attribute, $data[1]);
                     last TYPE; };

    /^server/i && do {
                     push(@server, $data[1]);
                     if ( defined($data[2]) )
                     {
                     $server{$data[1]} = $data[2];
                     }
		     last TYPE; };

    /^font/i && do {
                     $Global{'Font'} = $data[1];
                     last TYPE; };

    /^nismapname/i && do {
                     $Global{'nismapname'} = 1;
                     last TYPE; };

                     my $error =  "Parsing configuration file found an undefined type:  $_";
                     ERROR(\$error);

    } # End of case TYPE

}

close(DOT);

}

#
# Default is for left hand people!
# Over ride the dot file if the -r command line
# option is used.
#

if ( defined($opt_r) ) {

$Global{'hand'}   = $opt_r ? 'right' : 'left';
# my $Global{'hand'}   = $opt_r ? 'left' : 'right'; # uncomment this for right hand def.

}

#
# Default directory server.
#
if ( @server < 1 ) 
{ 
$server[0] = "ldap.umich.edu"; 
}
$Global{'LDAP_SERVER'} = $server[0];
$Global{'CORE_SERVER'} = $Global{'LDAP_SERVER'};

#
# Default directory search base.
#

 #
 # Find the branches of the directory.
 #
 
 if ( defined($server{$server[0]}) )
 {
 @base =  getBases($Global{'LDAP_SERVER'}, $server{$server[0]});
 }
 else
 {
 my $error;
 my $entry;
 my $mesg;

 my $ldap = new Net::LDAP( $Global{'LDAP_SERVER'},
                           timeout => 1,
                           port => $Global{'port'},
                           debug => $opt{'d'},
                         ) or $error = 1;

    if ( !$error )
    {

    $mesg = $ldap->bind( password => "$Global{'bindpw'}", 
                         dn => "$Global{'binddn'}", 
                         version => $Global{'setVersion'},
                       ) or $error = 1;
   
   if ( $mesg->code ) 
   {
      $errstr = $mesg->code;
      ERROR($errstr);
   }
 
    if ( !$error  )
    {
      $entry = $ldap->root_dse();
      if ( defined($entry) )
      {
        my $attr = $entry->get_value('namingContexts', asref => 1);
        if ( defined($attr) )
        {
         foreach my $ncbase ( @$attr )
         {
          push(@base, getBases($Global{'LDAP_SERVER'}, $ncbase));
         }
        }
        else 
        {
          @base = ();
        }
      }
    }
    }
    else 
    {
    @base = ();
    }
  $ldap->unbind if ( defined($ldap));
 }

 if ( @base >= 1)
 {
 $LDAP_SEARCH_BASE = $base[0];
 }
 else
 {
 $LDAP_SEARCH_BASE = "";
 }


#
# Default directory search attributes.
#
if ( $#attribute < 1 )
{

@attribute = qw/ uid sn cn rfc822mailbox telephonenumber
                 facsimiletelephonenumber gidnumber uidnumber/;
}

push(@attribute,"Filter");  # put roll your on filter at the end

#
# Create Main Window
#

$Global{'mainWindow'} = MainWindow->new;

$Global{'mainWindow'}->title("DIRECTORY SEARCH");

$Global{'mainWindow'}->geometry("+$Global{'horz'}+$Global{'vert'}");
#
# Create process Exit button
#

$Global{'mainWindow'}->Button(-text => "EXIT", 
                    -command => sub{ exit; }, 
                    -font => $Global{'Font'}, 
                    -borderwidth => 5  ) 
                    -> pack(-fill => "both", -padx => 5, -pady => 2 ) ;


$dsaframe = $Global{'mainWindow'}->Frame()
      ->pack( -fill => "both", -side => "top" );


$sframe = $dsaframe->LabFrame(-label => "DIRECTORY SERVER",
      -labelside => "acrosstop")
      ->pack(  -side => $Global{'hand'}  );

$stframe = $sframe->Frame()
      ->pack( -fill => "x", -side => "top" );

$sbframe = $sframe->Frame()
      ->pack( -fill => "x", -side => "bottom" );

$Global{'slist'} = $stframe ->Listbox( -height => 1  );

$Global{'slist'}->pack( -side => $Global{'hand'}  );

$Global{'slist'}->insert("end", $Global{'LDAP_SERVER'});

#
# Create directory server selection button
# This is where the user will select the directory server to
# query.
#

$smenu = $stframe -> Menubutton(-text => "SELECT\nSERVER",
                  -relief => "raised", -font => $Global{'Font'},
                  -borderwidth => 3 )
                  -> pack(-side => $Global{'hand'}, -anchor => "center",
                          -pady => 2 );

#
# Set up the select directory server radio buttons.
#

foreach (@server)
{
   $smenu->radiobutton( -label => $_, -variable => \$Global{'LDAP_SERVER'},
         -value => $_, -command => \&server, -font => $Global{'Font'} );

}

 
#
# Create bind button.
# This will cause another window to be displayed where
# the user will enter the bind DN and password.
#
 
$abind = $stframe -> Button(-text => " BIND TO\n DIRECTORY",
                 -relief => "raised", -command => \&BIND, 
                 -font => $Global{'Font'}, -borderwidth => 3 )
                 -> pack( -side => $Global{'hand'}, -anchor => "w", -pady => 2);
#
# Create a LDAP version Checkbutton that will set up  variable
# setVersion to set the LDAP version before each directory query.
#
 
$setVersion = $sbframe -> Checkbutton(
                       -text => "SET LDAP VERSION, LDAP V3 DEFAULT",
                       -variable =>  \$Global{'setVersion'}, -onvalue => 3, 
                       -offvalue => 2, -font => $Global{'Font'} )
                       -> pack(-side => "left", -anchor => "center" );
 
$setVersion->select();


#
# Create search base list box.
#

$sbbframe = $dsaframe->LabFrame(-label => "DIRECTORY SEARCH BASE",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => $Global{'hand'}, -pady => 1 );

$sbblist = $sbbframe ->Listbox( -width => 30, -height => 1  );

$sbblist->pack(-side => $Global{'hand'} );

$sbblist->insert("end", $LDAP_SEARCH_BASE);

#
# Create directory server search base.
# This is the point from which the search operation
# will start from.
#

$sbmenu = $sbbframe -> Menubutton(-text => " SELECT\nBASE",
                 -relief => "raised", -font => $Global{'Font'}, 
                 -borderwidth => 3 )
                 -> pack(-side => "left", -anchor => "w" );

#
# Set up the select search base radio buttons.
#


foreach (@base)
{
   push(@BaseButton, $sbmenu->radiobutton( -label => $_, 
                     -variable => \$LDAP_SEARCH_BASE,
                     -value => $_, -command => \&base, 
                     -font => $Global{'Font'} ) );

}

#
# Create bottom Search Directory frame
#

$bframe = $Global{'mainWindow'}->Frame(-borderwidth => 2,
      -relief => "raised")->pack(
      -fill => "both", -side => "bottom", -padx => 5, -pady => 2);

#
# Create Search Directory button
#

$bframe -> Button(-text => "SEARCH DIRECTORY", -command =>  \&search, 
        -font => $Global{'Font'}, -borderwidth => 3 ) 
        -> pack( -fill => "both");


$attframe = $Global{'mainWindow'}->Frame()
      ->pack( -fill => "both", -side => "bottom");

#
# Create Bottom Attribute frame.
# This is where the user will enter data to be
# searched for.
#


$tframe = $attframe->LabFrame(-label => "ATTRIBUTE DATA",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "bottom" );

#
# Create Text Entry list box.
#

$tframe->Entry(-textvariable => \$Global{'adata'}, -width => 25 ) 
      -> pack(-fill => 'x');


#
# Create frame for clear buttons.
#

$cframe = $attframe->Frame()
      ->pack( -fill => "both", -side => "bottom" );


#
# Create Clear Attribute Data and Search Directory buttons
#

$cframe -> Button(-text => "CLEAR ATTRIBUTE DATA", -command =>  \&AClear, 
        -font => $Global{'Font'}, -borderwidth => 3 )
        -> pack( -side => $Global{'hand'} );

#
# Create get Filter selection menu button.
#

$sfcmenu = $cframe -> Menubutton(-text => " SET FILTER CONDITON",
                 -relief => "raised", -font => $Global{'Font'},
                 -borderwidth => 3 )
                 -> pack(-side => $Global{'hand'} );

#
# Set up the select search base radio buttons.
#

$rbsf   = $sfcmenu -> radiobutton(-label =>   "equal",
                  -variable => \$Global{'infoFilter'},
                  -value => "equal", -command => \&setFilter );

$rbsf   = $sfcmenu -> radiobutton(-label =>   "begins with",
                  -variable => \$Global{'infoFilter'},
                  -value => "begins with", -command => \&setFilter );


$rbsf   = $sfcmenu -> radiobutton(-label =>   "ends with",
                  -variable => \$Global{'infoFilter'},
                  -value => "ends with", -command => \&setFilter );


$rbsf   = $sfcmenu -> radiobutton(-label =>   "contains",
                  -variable => \$Global{'infoFilter'},
                  -value => "contains", -command => \&setFilter );


$flclist = $cframe ->Listbox( -width => 11, -height => 1  );

$flclist->pack(-side => $Global{'hand'} );

$flclist->insert(0, $Global{'infoFilter'});

#
# Create get root dse entry button.
#

$cframe -> Button(-text => "OBTAIN ROOT DSE ENTRY", 
        -command =>  \&rootDse, 
        -font => $Global{'Font'}, -borderwidth => 3 )
        -> pack( -side => $Global{'hand'} );

#
# Create left attribute selection frame
# This is where the user will select the attribute to be searched.
#

$aframe = $attframe->LabFrame(-label => "ATTRIBUTES",
      -labelside => "acrosstop")
      ->pack( -side => $Global{'hand'} );

#
# First set up the 4 main Radio buttons.
#
#
# If there are other attribute after the first 4 then set them
# up inside the select additional attributes button.
#
#
if ( $#attribute > 4 )
{
my $sptr = 0;
while ( $sptr <= 3 )
{
$_ = shift(@attribute);

$rbsn   = $aframe -> Radiobutton(-text =>   "$_", -variable => \$Global{'info'},
         -value => "$_", -font => $Global{'Font'} ) 
         -> pack( -side => "$Global{'hand'}");

if ( !$sptr ) { $rbsn->select(); } # select first attribute

++$sptr;
}

} # End of if ( $#attribute > 4 )
else
{
#
# Less than 4 attributes in user create initialization
# file, this is valid if that is what the user wants.
#
my $sptr = 0;
while ( @attribute )
{
$_ = shift(@attribute);

$rbsn   = $aframe -> Radiobutton(-text =>   "$_", 
                  -variable => \$Global{'info'},
                  -value => "$_", -font => $Global{'Font'} ) 
                  -> pack( -side => "bottom", -anchor => "w");

if ( !$sptr ) { $rbsn->select(); } # select first attribute

++$sptr;
}

}

#
# Create additional attributes selection button
# This is where the user will select any special attribute to
# search on.
#

$amenu = $aframe -> Menubutton(-text => " SELECT\n ADDITIONAL\n ATTRIBUTES",
                 -relief => "raised", -font => $Global{'Font'},
                 -borderwidth => 3 )
                 -> pack( -side => "bottom", -anchor => "w" );

#
# Create radio buttons in attributes selection box.
#
#

foreach (@attribute)
{

   $amenu->radiobutton( -label => $_, -variable => \$Global{'info'},
          -value => $_, -font => $Global{'Font'});

} # End of foreach (@attribute)


$schframe = $attframe->LabFrame(-label => "DIRECTORY SCHEMA",
      -labelside => "acrosstop" )
      ->pack( -fill => "both", -side => "right", -padx => 1, -pady => 1 );

$prtframe = $attframe->LabFrame(-label => "DIRECTORY PORT",
      -labelside => "acrosstop" )
      ->pack( -fill => "both", -side => "right", -padx => 1, -pady => 1 );

#
# Create schema button.
# This will cause another window to be displayed where
# the user will be able to display schema information.
#
 
$abind = $schframe -> Button(-text => " EXPLORE DIRECTORY\n SCHEMA",
                   -relief => "raised", -command => \&SCHEMA, 
                   -font => $Global{'Font'}, -borderwidth => 3 )
                   -> pack( -side => "$Global{'hand'}", -anchor => "w" );

#
# Create port button.
# This will cause another window to be displayed where
# the user will be able to display port information.
#
 
$abind = $prtframe -> Button(-text => "SET DIRECTORY\nPORT",
                   -relief => "raised", -command => \&PORT, 
                   -font => $Global{'Font'}, -borderwidth => 3 )
                   -> pack( -side => "$Global{'hand'}", -anchor => "w" );


#$_ = $Global{'mainWindow'}->geometry();

#/^=?(\d+x\d+)?([+-]\d+[+-]\d+)?$/;

#
# Run the Main loop looking for events.
#

MainLoop;



sub AClear {

#
# Clear out text in Attribute Box
#

$Global{'adata'} = "";

} # End of AClear subroutine

sub server {
my $widget;
my $ptr;

#
# Put directory server name in list box
#

$Global{'slist'}->insert(0 , $Global{'LDAP_SERVER'});
$sslist->insert(0 , $Global{'LDAP_SERVER'}) if ( Exists($sslist) ) ;

#if ( !$mybase )
#{
$ptr = 1;

#
# Delete data from BaseButton array, we are deleteing the 
# buttons.
#

while ( @BaseButton >= 1  )
{
$widget = pop(@BaseButton);
$sbmenu->menu->delete($ptr);
++$ptr;
}

@base = ();

if ( $Global{'CORE_SERVER'} ne $Global{'LDAP_SERVER'} && defined($server{$Global{'LDAP_SERVER'}} ) )
{


@base = getBases($Global{'LDAP_SERVER'}, $server{$Global{'LDAP_SERVER'}});

}
else
{
 my $error;
 my $mesg;
 my $entry;

 my $ldap = new Net::LDAP( $Global{'LDAP_SERVER'},
                           timeout => 1,
                           port => $Global{'port'},
                           debug => $opt{'d'},
                         ) or $error = 1;

    if ( !$error )
    {

    $mesg = $ldap->bind( password => "$Global{'bindpw'}", 
                         dn => "$Global{'binddn'}", 
                         version => $Global{'setVersion'},
                       ) or $error = 1;

   if ( $mesg->code ) 
   {
      $errstr = $mesg->code;
      ERROR($errstr);
   }
 
    if ( !$error  )
    {
      $entry = $ldap->root_dse();
      if ( defined($entry) )
      {
        my $attr = $entry->get_value('namingContexts', asref => 1);
        if ( defined($attr) )
        {
          foreach my $ncbase ( @$attr )
          {
            push( @base, getBases($Global{'LDAP_SERVER'}, $ncbase));
          }
        }
        else 
        {
          @base = ();
        }
      }
    }
    }
    else 
    {
    @base = ();
    }
  $ldap->unbind if ( defined($ldap));

}

 if ( @base >= 1)
 {
 $LDAP_SEARCH_BASE = $base[0];
 }
 else
 {
 $LDAP_SEARCH_BASE = "";
 }

#
# Set up the select search base radio buttons.
#

foreach (@base)
{
   push(@BaseButton, $sbmenu->radiobutton( -label => $_, 
                     -variable => \$LDAP_SEARCH_BASE,
                     -value => $_, -command => \&base, 
                     -font => $Global{'Font'} ) );

}

# } # End of if ( !$mybase )

$LDAP_SEARCH_BASE = $base[0];
$sbblist->insert(0 , $LDAP_SEARCH_BASE);


$Global{'CORE_SERVER'} = $Global{'LDAP_SERVER'};

} # End of server subroutine


#sub attribute {

#
# Build a correct Filter string from the data
# passed from the Additional Attributes
# radiobutton selection.
#

#my $tmp = "(" . $uid . "=";

#$info = $tmp;

#} # End of attribute subroutine


sub base {

#
# Put directory server search base into the list box.
#

$sbblist->insert(0 , $LDAP_SEARCH_BASE);

} # End of base subroutine

sub setFilter {

#
# Put search filter conditions into the list box.
#

$flclist->insert(0 , $Global{'infoFilter'});

} # End of setFilter subroutine

 
#
# Create Main Bind Window
#
 
sub BIND {
 
$dn_data = "";
$pw_data = "";
&globalPos();

my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
 
#
# Create Main Bind Window
#
 
$Global{'bindWindow'} = MainWindow->new;
 
$Global{'bindWindow'}->title("BIND TO DIRECTORY");
 
$Global{'bindWindow'}->geometry("+$x+$y");
#
# Create process accept button
#
$Global{'bindWindow'}->Button( -text => "ACCEPT", -command => \&accept, 
           -font => $Global{'Font'}, -borderwidth => 3 )
           -> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
 
#
# Create process cancel button
#
$Global{'bindWindow'}->Button(-text => "CANCEL", -command => \&cancel, 
           -font => $Global{'Font'}, -borderwidth => 3)
           -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
 
my $binddnframe = $Global{'bindWindow'}->LabFrame(-label => "DN",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
 
#
# Create DN Entry text box.
#
 
$binddnframe->Entry(-textvariable => \$dn_data, -width => 25 )
      -> pack(-fill => 'x');
 
my $bindpwframe = $Global{'bindWindow'}->LabFrame(-label => "PASSWORD",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
 
#
# Create Password Entry text box.
#
 
$bindpwframe->Entry(-show => '*', -textvariable => \$pw_data, 
                    -width => 25, -font => $Global{'Font'} )
                    -> pack(-fill => 'x');
 
sub cancel{
 
$Global{'bindWindow'}->destroy() if Tk::Exists($Global{'bindWindow'});
$Global{'bindWindow'} = undef(); 
} # End of cancel subroutine
 
sub accept{ 
 
$Global{'binddn'} = $dn_data;
$Global{'bindpw'} = $pw_data;
 
$Global{'bindWindow'}->destroy() if Tk::Exists($Global{'bindWindow'});
$Global{'bindWindow'} = undef(); 
 
} # End of accept subroutine
} # End of BIND subroutine


 
#
# Create Main Error Window
#
 
sub ERROR {
my ($errcode ) = @_;
my $errmsg;

return if ($errcode == 48 && $Global{'setVersion'} == 3 ); # Anonymous bind error, not really an error.

my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;

if ( ref($errcode) )
{ 
$errmsg = $$errcode;
}
else
{
$errmsg = ldap_error_text($errcode);
}

my @errmsg = split(/\n/,$errmsg);

#
# Create Main Error Window
#
if ( ! Exists($Global{'errorWindow'} ) )
{ 
$Global{'errorWindow'} = MainWindow->new;
 
$Global{'errorWindow'}->title("ERROR MESSAGES");
 
$Global{'errorWindow'}->geometry("+$x+$y");
#
# Create process dismiss button
#
$Global{'errorWindow'}->Button( -text => "DISMISS", -command => \&dismiss, 
           -font => $Global{'Font'}, -borderwidth => 3 )
           -> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
 
$errlist = $Global{'errorWindow'} ->Scrolled(Listbox, -scrollbars => 'se',
                                  -width => 70, -height => 10  );

$errlist->pack(-fill => "both", -expand => 1 );
}

$errlist->insert("end", "Error Code: $errcode");
$errlist->insert("end", "");

foreach my $msg ( @errmsg )
{
$errlist->insert("end", $msg);
}

sub dismiss{ 
 
$Global{'errorWindow'}->destroy() if Tk::Exists($Global{'errorWindow'});
$errlist = undef();
 
} # End of dismiss subroutine

} # End of ERROR subroutine


#
# Create Main Port Window
#
 
sub PORT {
 
$port_data = $Global{'port'};
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
 
#
# Create Main Port Window
#
 
$Global{'portWindow'} = MainWindow->new;
 
$Global{'portWindow'}->title("DIRECTORY PORT");
 
$Global{'portWindow'}->geometry("+$x+$y");
#
# Create process accept button
#
$Global{'portWindow'}->Button( -text => "ACCEPT", -command => \&portAccept, 
           -font => $Global{'Font'}, -borderwidth => 3 )
           -> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
 
#
# Create process cancel button
#
$Global{'portWindow'}->Button(-text => "CANCEL", -command => \&portCancel, 
           -font => $Global{'Font'}, -borderwidth => 3)
           -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
 
my $portframe = $Global{'portWindow'}->LabFrame(-label => "PORT",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
 
#
# Create Port Entry text box.
#
 
$portframe->Entry(-textvariable => \$port_data, -width => 10 )
      -> pack(-fill => 'x');
 
 
sub portCancel{
 
$Global{'portWindow'}->destroy() if Tk::Exists($Global{'portWindow'});
$Global{'portWindow'} = undef(); 
 
} # End of cancel subroutine
 
sub portAccept{ 
 
$Global{'port'} = $port_data;
 
$Global{'portWindow'}->destroy() if Tk::Exists($Global{'portWindow'});
$Global{'portWindow'} = undef(); 
 
} # End of accept subroutine
} # End of PORT subroutine


} # End of MAIN_PROCESS subroutine


#
# Create Schema Display Window
#
 
sub print_loop()
{
my $list = shift;
my $ocs = shift;
my $Title = shift;
#my $method = shift;

my $asize;
my $ahash;
my $var;

foreach $ahash ( @$ocs)
{
   $list->insert("end", "$Title\n");

   #
   # Get and display the data for this object
   #

   my @hkeys = keys(%$ahash);
 
   foreach $var (@hkeys)
   {
   # Step thru the hash keys
  
   next if ( $var =~ /type/);  # do not care about type

   $alArray =  $$ahash{$var};
 
   if ( ref($alArray) eq 'ARRAY' )
   {
   # it is a n array pointer so there is probably a list.
 
   my $asize = @$alArray;  # get the size of the list.
   #
   # if the array has size then print the array
   # else ignore the array.
   #
   if ( $asize  )
   {
   # Okay, there is something in the array. 

   $list->insert("end", "\t$var: ");

   foreach $a ( @$alArray )
   {
   $list->insert("end", "$a ");
   }
   $list->insert("end", "\n");
   }
   }
   else
   {
   # There is not an array
   if ( $alArray ==  1)
   { 
   # it is just information attribute for the object
   $list->insert("end", "\t$var\n");
   }
   else
   {
   $list->insert("end", "\t$var:  $alArray\n");
   }
   }
 
}                                                                               


   #
   # Get the various other items associated with
   # this attribute.
   #
#      next if ( $value eq 'type');

#      $value =~ tr/a-z/A-Z/;

}

} # End of subroutine print_loop

#
#
# Search the directory for schema data
#
#
#

sub SCHEMA 
{

my $srbclear;
my $srbfile;
my $srbfilelabel;
my $slframe;
my $ssframe;
my $sbbframe;
my $aframe;
my $tframe;
my $sbframe;
#my $sslist;
&globalPos();
my $x = $Global{'horz'} + 100;
my $y = $Global{'vert'} + 100;
#
# Create Main Window
#
if (!  Exists($Global{'schemaWindow'}) )
{
$Global{'schemaWindow'} = MainWindow->new;

$Global{'schemaWindow'}->title("DIRECTORY SCHEMA SEARCH");

$Global{'schemaWindow'}->geometry("+$x+$y");
#
# Create process Exit button
#

$Global{'schemaWindow'}->Button( -text => "CLOSE SCHEMA SEARCH WINDOW", 
                       -command => \&schema_cancel, -font => $Global{'Font'}, 
                       -borderwidth => 5 )
                       -> pack(-fill => "both", -padx => 2, -pady => 2 ) ;

$ssframe = $Global{'schemaWindow'}->LabFrame(-label => "DIRECTORY SERVER",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "top", -padx => 2, -pady => 2 );

$sslist = $ssframe ->Listbox( -height => 1  );

$sslist->pack(-fill => "both", -expand => 1 );

$sslist->insert("end", $Global{'LDAP_SERVER'});

#
# Create bottom Search Directory frame
#

$sbframe = $Global{'schemaWindow'}->Frame( -borderwidth => 2, 
                        -relief => "raised")->pack(
                        -fill => "both", -side => "bottom", 
                        -padx => 2, -pady => 2);

#
# Create Search Directory button
#

$sbframe -> Button(-text => "RETRIEVE DIRECTORY SCHEMA", 
         -command =>  \&schema, -font => $Global{'Font'}, -borderwidth => 3 )
         -> pack( -fill => "both");

$srbfilelabel = $Global{'schemaWindow'}->LabFrame(-label => "SCHEMA DUMP TO FILE",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -anchor => "w", -padx => 2, -pady => 2);

$srbfile = $srbfilelabel -> Checkbutton( 
          -text => "Write schema data to file, enter file name in text box below this line.   ",
          -variable =>  \$Global{'sfile'}, -onvalue => 1, -offvalue => 0,
          -font => $Global{'Font'} )
          -> pack(-anchor => "w" );

$srbfilelabel -> Checkbutton( 
          -text => "Write schema data to file in DSML XML format.",
          -variable =>  \$Global{'xml'}, -onvalue => 1, -offvalue => 0,
          -font => $Global{'Font'} )
          -> pack(-anchor => "w" );

#
# Create Text Entry list box.
#

$srbfilelabel->Entry(-textvariable => \$Global{'fdata'}, -width => 25 ) 
      -> pack(-fill => 'x');


#
# Create list frame.
#

$slframe = $Global{'schemaWindow'}->LabFrame(-label => "DIRECTORY SCHEMA DATA",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "top", -pady => 2,
      -expand => 1);

#
# Create a Clear Data Radiobutton that will execute subroutine clear
# to clear the List box before each directory query.
#

$srbclear = $slframe -> Checkbutton(
                     -text => "Clear directory data on each query.",
                     -variable =>  \$Global{'sclear'}, -onvalue => 1,
                     -offvalue => 0, -font => $Global{'Font'} )
                     -> pack(-anchor => 'nw' );

$srbclear->select();

$selframe = $slframe -> LabFrame(-label => "DISPLAY SELECTED OBJECTS",
                                 -labelside => "acrosstop" )
                                 ->pack( -side => $Global{'hand'}, 
                                 -expand => 1, -fill => "both" );

$sellframe = $selframe->Frame( -borderwidth => 0, 
                        -relief => "raised")->pack(
                        -fill => "both", -side => "top", 
                        -padx => 0, -pady => 0);

$sellAll = $sellframe -> Checkbutton(-text => "ALL",
      -variable =>  \$selectAll, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-side => "top", -anchor => 'w' );

$sellAll->select();

$sellObj = $sellframe -> Checkbutton(-text => "objectClasses",
      -variable =>  \$selectObj, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-side => "top", -anchor => 'w' );

$sellMatch = $sellframe -> Checkbutton(-text => "matchingRules",
      -variable =>  \$selectMatch, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-side => "top", -anchor => 'w' );

$sellAtt = $sellframe -> Checkbutton(-text => "attributeType",
      -variable =>  \$selectAtt, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-side => "top", -anchor => 'w' );


$sellsyn = $sellframe -> Checkbutton(-text => "ldapsyntaxes",
      -variable =>  \$selectSyn, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-side => "top", -anchor => 'w' );

$sellnf = $sellframe -> Checkbutton(-text => "nameforms",
      -variable =>  \$selectNf, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-side => "top", -anchor => 'w' );

$selldsr = $sellframe -> Checkbutton(-text => "ditstructurerules",
      -variable =>  \$selectDsr, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-side => "top", -anchor => 'w' );

$selldcr = $sellframe -> Checkbutton(-text => "ditcontentrules",
      -variable =>  \$selectDcr, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-side => "top", -anchor => 'w' );

$sellmru = $sellframe -> Checkbutton(-text => "matchingruleuse",
      -variable =>  \$selectMru, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-side => "top", -anchor => 'w' );


      $sellframe -> Button(-text => "SHOW HIERARCHIAL\nOBJECTCLASS TREE",
      -command =>  \&Hierarchial,  -font => $Global{'Font'},
      -borderwidth => 3 )
      -> pack(-side => "bottom" );

#
# Create Clear Attribute Data and Search Directory buttons
#

$slframe ->Button(-text => "     CLEAR DATA     ",
     -command =>  \&schema_clear, -font => $Global{'Font'},
     -borderwidth => 3 ) 
     -> pack(-side => "bottom", -fill => "both",  -padx => 5 );
#
# Create a ROText Box that will actually contain the 
# returned directory data.
#

$schema_list = $slframe ->Scrolled('ROText', -scrollbars => 'se',
        -width => 50, -height => 20, -wrap => 'none', 
        -font => $Global{'Font'}  );

$schema_list->pack( -side => "bottom" );

&schema;

}
else
{
$Global{'schemaWindow'}->deiconify() if Tk::Exists($Global{'schemaWindow'});
$Global{'schemaWindow'}->raise() if Tk::Exists($Global{'schemaWindow'});
}

sub schema_clear {

#
# Clear out text in List Box
#

$schema_list->delete("1.0", "end");

} # End of clear subroutine

 
sub schema_cancel{
 
# $schemaWindow->withdraw if Tk::Exists($schemaWindow);
$Global{'schemaWindow'}->destroy if Tk::Exists($Global{'schemaWindow'});
$Global{'schemaWindow'} = undef(); 
} # End of cancel subroutine
 






#
#
# Get the directory schema
#
#
#

sub schema 
{
my $mesg;
my $error = 0;

$schemaHash{'obj'} = {};
$schemaHash{'tree'} = {};
#my %obj = ();
#my %tree = ();

#my @atts = ();
#my @ocs = ();
#my @mrs = ();
#my @nfm = ();
#my @lsyn = ();
#my @dits = ();
#my @ditc = ();
#my @mru = ();




my $dt = "/tmp/schema.dat.$$";

if ( $Global{'sclear'} ) { &schema_clear(); }

#
# Connect to directory server
# 

my $ldap = new Net::LDAP( $Global{'LDAP_SERVER'},
                          timeout => 1,
                          port => $Global{'port'},
                          debug => $opt{'d'},
                        ) or $error = 1;

if ( $error == 1 )
{
   $schema_list->insert("end",  "Connect error:  $@\n");
   return;
}

$mesg = $ldap->bind( password => "$Global{'bindpw'}", 
                     dn => "$Global{'binddn'}", 
                     version => $Global{'setVersion'},
                   ) or $error = 1;

   
if ( $mesg->code ) 
{
   $errstr = $mesg->code;
   ERROR($errstr);
}
 
if ( $error == 1 )
{
   $schema_list->insert("end",  "Bind error:  $@\n");
   return;
}

#
# Get the schema, tries to read rootdse, if unable assumes cn=schema.
# This is NOT always the case.
#

$schema = undef();
my @items;
my @item;
my $dsml;

$schemaHash{'schema'} = $ldap->schema();

if ( defined($schemaHash{'schema'}) )
{
if ( $Global{'sfile'} && defined($schemaHash{'schema'}) )
{
  if ( $Global{'xml'} )
  {
  #
  # write XML text to file instead of text box
  #
#    @xml_data = ();
#    $dsml = Net::LDAP::DSML->new( output => \@xml_data, pretty_print => 1 );
    open(FXML, ">$Global{'fdata'}");  
    $dsml = Net::LDAP::DSML->new( output => *FXML, pretty_print => 1 );
    $dsml->write_schema($schemaHash{'schema'});
    close(FXML);
  }
  else
  {
    #
    # write straight text to file instead of text box
    #
    $schemaHash{'schema'}->dump( $Global{'fdata'} );
  }
 
  $schema_list->insert("end",
                       "Schema data written to file: $Global{'fdata'}\n");
  $Global{'sfile'} = 0;
  $Global{'fdata'} = "";
  $Global{'xml'} = 0;
  $ldap->unbind if ( defined($ldap));
  return;

}

$ra_atts = [];
#
# Get the attributes
#
@$ra_atts = $schemaHash{'schema'}->all_attributes(); 
$schemaHash{'atts'} = $ra_atts; 


#
# Display the attributes
#
 
if ( $selectAll || $selectAtt  )
{
&print_loop($schema_list, $schemaHash{'atts'}, "attributeType") 
  if ( defined($schemaHash{'atts'}) );
}

$ra_atts = [];
#
# Get the schema objectclasses
#
@$ra_atts = $schemaHash{'schema'}->all_objectclasses(); 
$schemaHash{'ocs'} = $ra_atts;

#
# Calculate the text length of each objectclass string.
#
foreach my $var (@$ra_atts) 
{ 
$Global{'max'} = length($$var{'name'}) 
        if length($$var{'name'}) > $Global{'max'} 

}

#
# Add 6 to the max objectclass string size,
# got to allow for graphics information.
#

$Global{'max'} += 6;

#
# Display the objectclasses
#
 
if ( $selectAll || $selectObj )
{
&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses") 
    if ( defined($schemaHash{'ocs'}) );
}


#
# Get the schema matchingrules
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_matchingrules(); 
$schemaHash{'mrs'} = $ra_atts;

#
# Display the matchingrules
#
 
if ( $selectAll || $selectMatch )
{
&print_loop($schema_list, $schemaHash{'mrs'}, "matchingRules" ) 
    if ( defined($schemaHash{'mrs'}) );
}

#
# Get the schema matchingruleuse
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_matchingruleuses(); 
$schemaHash{'mru'} = $ra_atts;

#
# Display the matchingruleuse
#
 
if ( $selectAll || $selectMru )
{
&print_loop($schema_list, $schemaHash{'mru'}, "matchingRuleUse" ) 
    if ( defined($schemaHash{'mru'}) );
}

#
# Get the schema ldapsyntaxes
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_syntaxes(); 
$schemaHash{'lsyn'} = $ra_atts;

#
# Display the ldapsyntaxes
#
 
if ( $selectAll || $selectSyn )
{
&print_loop($schema_list, $schemaHash{'lsyn'}, "ldapSyntax" ) 
    if ( defined($schemaHash{'lsyn'}) );
}

#
# Get the schema nameForms
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_nameforms(); 
$schemaHash{'nfm'} = $ra_atts;

#
# Display the nameForms
#
 
if ( $selectAll || $selectNf )
{
&print_loop($schema_list, $schemaHash{'nfm'}, "nameForms" ) 
    if ( defined($schemaHash{'nfm'}) );
}

#
# Get the schema ditstructurerules
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_ditstructurerules(); 
$schemaHash{'dits'} = $ra_atts;

#
# Display the ditstructurerules
#
 
if ( $selectAll || $selectDsr )
{
&print_loop($schema_list, $schemaHash{'dits'}, "ditstructurerules" ) 
    if ( defined($schemaHash{'dits'}) );
}

#
# Get the schema ditcontentrules
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_ditcontentrules(); 
$schemaHash{'ditc'} = $ra_atts;

#
# Display the ditcontentrules
#
 
if ( $selectAll || $selectDcr )
{
&print_loop($schema_list, $schemaHash{'ditc'}, "ditcontentrules" ) 
    if ( defined($schemaHash{'ditc'}) );
}

} # End of if ( defined($schema) ) 
else 
{
  $schema_list->insert("end",  "The schema object was return undefined.\n");
  $schema_list->insert("end",  "There are several problems that can cause\n");
  $schema_list->insert("end",  "this situation.\n");
  $schema_list->insert("end",  "1. Your server may require you to be bound\n");
  $schema_list->insert("end",  "   to the directory as the directory\n");
  $schema_list->insert("end",  "   administrator.  Bind to the directory\n");
  $schema_list->insert("end",  "   as the directory administrator and \n");
  $schema_list->insert("end",  "   retry pulling the schema data.\n");
  $schema_list->insert("end",  "\n");
  $schema_list->insert("end",  "2. Your server is a version 2 LDAP server\n");
  $schema_list->insert("end",  "   or the version 3 LDAP radio button is in\n");
  $schema_list->insert("end",  "   the version 2 position.  Version 2 LDAP\n");
  $schema_list->insert("end",  "   servers will not return schema data.\n");

}

$ldap->unbind if ( defined($ldap));

} # End of schema subroutine

} # End of SCHEMA subroutine

sub init_schemaHash
{

 $schemaHash{ 'schema' } = undef();
 $schemaHash{ 'obj' }  = {};
 $schemaHash{ 'tree' } = {};

 $schemaHash{ 'atts' } = [];
 $schemaHash{ 'ocs' }  = [];
 $schemaHash{ 'mrs' }  = [];
 $schemaHash{ 'nfm' }  = [];
 $schemaHash{ 'lsyn' } = [];
 $schemaHash{ 'dits' } = [];
 $schemaHash{ 'ditc' } = [];
 $schemaHash{ 'mru' }  = [];

}

sub Hierarchial 
{
&globalPos();
my $x = $Global{'horz'};
my $y = $Global{'vert'}  + 200 ;
my $ocs = $schemaHash{'ocs'};
my $obj = $schemaHash{'obj'};
$schemaHash{'tree'} = {};
my $tree = $schemaHash{'tree'};
my $schema = $schemaHash{'schema'};
my @tmpKeys;
my $size;
my $Path;
my $done;
my @sup;
my @name;
my $name;
my $SUP;
my $array;

if ( !defined($ocs) || !defined($tree) || 
     !defined($obj) || !defined($schema) )
{
   #
   # No schema data available
   #
   my $error = "LDAP Schema data is not available.";
   ERROR(\$error);
   return;
}

#
# Get the schema objectClasses
#
foreach my $aobj ( @$ocs)
{
   #
   # Get the oid number of the objectclass.
   #
   my $oid;
   undef($oid);
#   print "$aobj\n";
   $oid = $$aobj{'oid'}; 
   next if ( !defined($oid) );
#   print "oid; $oid\n";
#   print "sup ",$$aobj{'sup'},"\n"; 
#   print "name ",$$aobj{'name'},"\n"; 
    @sup = $$aobj{'sup'}[0];
    @name = $$aobj{'name'};
#    print "sup : @sup\n";
#   @sup = $schema->item( $oid, 'sup' ); # objectclass superior
#   @name = $schema->item( $oid, 'name' ); # objectclass name

   $$obj{"$name[0]"} = [ "$oid", "$sup[0]" ]; # store data

}

#return;

#
# get objectclass hash keys.
#
@tmpKeys = sort(keys(%$obj)) if (defined($$obj{'top'}));

$$tree{'top'} = [0,]; # pre-load top objectclass.

foreach (@tmpKeys)
{

next if ( $_ eq "" || $_ eq "top" );

$done = 0;  # initialize done flag
$Path = "";  # initialize objectclass Path 

$name = $_;
while ( !$done )
{

$SUP = $$obj{$_}->[1]; # get current objectclass's superior
$SUP = "top" if ( $SUP eq "" );  # on null superior, make top superior
if ( $Path eq "" )
{
$Path = $SUP;  # Start objectclass path.
}
else
{
$Path = $SUP . "/" . $Path;  # add new objectclass to path.
}
$done = 1 if ( $SUP eq 'top' ) ; # when we reach objectclass top we are done.
$_ = $SUP;  # walk back up the chain

}

if ( defined($$tree{$Path}) )
{
#
# Path key has already been initialized, add current objectclass 
# to list.
#
$array = $$tree{$Path};
push(@$array,$name);
}
else 
{
#
# Path key needs to be initialized, add current objectclass 
# to list.
#
$$tree{$Path} = [0, "$name"];
}

}

#
# Set up the Tk windows.
#
#

if ( ! Exists($Global{'histWindow'} ) ) 
{
  eval 
     { 
       $Global{'histWindow'} = MainWindow->new(); 
     };
  print "$@" if ( defined($@)); }
else 
{
$Global{'histWindow'}->deiconify() if Tk::Exists($Global{'histWindow'}); 
$Global{'histWindow'}->raise() if Tk::Exists($Global{'histWindow'}); 
}                                                                               

$Global{'histWindow'}->geometry("+$x+$y"); 
$Global{'histWindow'}->title("HIERARCHICAL OBJECTCLASS DISPLAY WINDOW");
#
# Create label box
#

if ( !Exists($Global{'label'}) )
{
$Global{'label'} = $Global{'histWindow'}->Label()->pack;
}

#
# Create process Exit button
#

$hbutton = $Global{'histWindow'}->Button(
              -text => "CLOSE HIERARCHICAL DISPLAY WINDOW", 
              -command => \&hist_cancel, -font => $Global{'Font'},
              -borderwidth => 5 )
              -> pack(-fill => "both", -padx => 2, -pady => 2 ) 
              if ( Exists($Global{'histWindow'} ) && 
                   !Exists($hbutton ) );

#
# Create list box, this is where the selected objectclass data will
# be displayed.
#

if ( !Exists($Global{'list'}) )
{
$Global{'list'} = $Global{'histWindow'}->Scrolled('ROText',
            -scrollbars => 'se', -width=>50, -wrap => "none",
            -font => $Global{'Font'}, -height => 20 ) 
            ->pack(-side => "left");
}


#
# Create Hierarchial list box, this is where the objectclass data
# tree will be displayed.
#

$Global{'hlist'} = $Global{'histWindow'}->Scrolled('HList', 
            -font       => $Global{'Font'},
            -scrollbars => 'se',
            -width      => $Global{'max'}, 
            -height     => 20,
            -itemtype   => 'text',
            -separator  => '/',
            -selectmode => 'single',
            -browsecmd  => sub {
#
            my $objects = shift;
            my $oid;
            my @objectclasses = ();
            @objectclasses = split(/\//,$objects);
            $Global{'list'}->delete("1.0", "end");
            $Global{'label'}->configure(-text=>$objects);
            $Global{'list'}->insert("end", " \n");

            foreach my $var (@objectclasses)
            {
               $oid = $$obj{$var}->[0];
               #
               # Get the various other items associated with
               # this objectclass.
               #
               my $ahash = $schema->objectclass( "$oid" );
               my @hkeys = sort(keys(%$ahash));
               #
               # Get and display the objectclass name.
               #
               $alArray =  $$ahash{'name'};
               $Global{'list'}->insert("end", "name:  $alArray\n");

               foreach $varr (@hkeys)
               {
                # Step thru the hash keys
  
                next if ( $varr =~ /name/);  # already done name.
                next if ( $varr =~ /type/);  # do not care about type

                $alArray =  $$ahash{$varr};
 
                if ( ref($alArray) eq 'ARRAY' )
                {
                 # it is a n array pointer so there is probably a list.
 
                 my $asize = @$alArray;  # get the size of the list.
                 #
                 # if the array has size then print the array
                 # else ignore the array.
                 #
                 if ( $asize  )
                 {
                 # Okay, there is something in the array. 
 
                  $Global{'list'}->insert("end", "\t$varr: ");
 
                  foreach $a ( @$alArray )
                  {
                   $Global{'list'}->insert("end", "$a ");
                  }
                  $Global{'list'}->insert("end", "\n");
                 }
                }
                else
                {
                 # It is not an array
                 if ( $alArray ==  1)
                 { 
                  # it is just and information attribute for the object
                  $Global{'list'}->insert("end", "\t$varr\n");
                 }
                 else
                 {
                  $Global{'list'}->insert("end", "\t$varr:  $alArray\n");
                 }
                }
 
               } 

            $Global{'list'}->insert("end", " \n");
            $Global{'list'}->insert("end", "--------------------------------------------------\n");
            $Global{'list'}->insert("end", " \n");
            }

            } # End of subroutine browsecmd

            );  # End of Scrolled HList.


@tmpKeys = sort(keys(%$tree));
my $base;
$base = "";

#
# Create Hierarchial list box data tree, 
# and display data.
#

eval{
foreach ( @tmpKeys ) {
    my $array = $$tree{$_};
    if ( @$array[0] == 0 ) 
    {
      @$array[0] = 1;
      $Global{'hlist'}->add($_, -text=>$_);  # do the base.
    }

    $base = $_; 
    $array = $$tree{$_};
    $ptr = 0;
    foreach my $var ( @$array )
    {
    if ( !$ptr )
    {
      $ptr = 1;
      next;
    }
    $_ = $base . "/" . $var; 
    $Global{'hlist'}->add($_, -text => $var);
    if ( defined($$tree{$_}) )
    {
      my $aptr = $$tree{$_};
      @$aptr[0] = 1;
    } 
    }

}
$Global{'hlist'}->pack(-side => "right");
};
print "$@" if ( defined($@));

sub hist_clear {

#
# Clear out text in List Box
#

$Global{'list'}->delete("1.0", "end");

} # End of clear subroutine
 
sub hist_cancel{

$Global{'list'}->destroy if Tk::Exists($Global{'list'});
$Global{'hlist'}->destroy if Tk::Exists($Global{'hlist'});
$Global{'histWindow'}->destroy if Tk::Exists($Global{'histWindow'});
#$Global{'tree'} = {};
#$Global{'obj'} = {};
} # End of cancel subroutine

} # End of subroutine  Hierarchial 


 
#
# Create Accept/Cancel Window
#
 
sub questionAction {
&globalPos();
my $x = $Global{'horz'} + 0;
my $y = $Global{'vert'} + 50;
 
#
# Create Main Window
#
 
$Global{'answerWindow'} = MainWindow->new;
 
$Global{'answerWindow'}->title("BIND TO DIRECTORY");
 
$Global{'answerWindow'}->geometry("+$x+$y");
#
# Create process accept button
#
$Global{'answerWindow'}->Button( -text => "ACCEPT", -command => \&doAction, 
           -font => $Global{'Font'}, -borderwidth => 3 )
           -> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
 
#
# Create process cancel button
#
$Global{'answerWindow'}->Button(-text => "CANCEL", -command => \&cancelAction, 
           -font => $Global{'Font'}, -borderwidth => 3)
           -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
 
sub cancelAction{
 
$Global{'answerWindow'}->destroy() if Tk::Exists($Global{'answerWindow'});
delete($Global{'answerWindow'}); 
} # End of cancel subroutine
 
sub doAction{ 
 
$Global{'answerWindow'}->destroy() if Tk::Exists($Global{'answerWindow'});
delete($Global{'answerWindow'}); 
$Global{'searchHistWindow'}->destroy if Tk::Exists($Global{'searchHistWindow'});
$Global{'searchHistWindow'} = undef(); 

&ldapActionDelete;   # Delete the entry from the directory
 
} # End of accept subroutine
} # End of questionAction subroutine

 
#
# Create ldapAction Window
#
 
sub ldapAction {

$Global{'ldapActionDN'} = shift;

&globalPos(); 
my $x = $Global{'horz'} + 0;
my $y = $Global{'vert'} + 30;
 
#
# Create Main ldapAction Window
#
 
$Global{'ldapActionWindow'} = MainWindow->new;
 
$Global{'ldapActionWindow'}->title("LDAP ACTION");
 
$Global{'ldapActionWindow'}->geometry("+$x+$y");

#
# Create ldap display button
#
$Global{'ldapActionWindow'}->Button( -text => "DISPLAY", -command => \&ldapActionDisplay, 
           -font => $Global{'Font'}, -borderwidth => 3 )
           -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
 

#
# Create ldap rename button
#
$Global{'ldapActionWindow'}->Button( -text => "RENAME", 
           -command => \&getRenameData, 
           -font => $Global{'Font'}, -borderwidth => 3 )
           -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
 
#
# Create ldap edit button
#
$Global{'ldapActionWindow'}->Button(-text => " EDIT ", 
           -command => \&ldapActionEdit,
           -font => $Global{'Font'}, -borderwidth => 3)
           -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
 
#
# Create ldap delete button
#
$Global{'ldapActionWindow'}->Button(-text => "DELETE", 
           -command => \&questionAction,
           -font => $Global{'Font'}, -borderwidth => 3)
           -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
 
 
#
# Create process cancel button
#
$Global{'ldapActionWindow'}->Button(-text => "CANCEL", -command => \&ldapActionCancel,
           -font => $Global{'Font'}, -borderwidth => 3)
           -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
 
sub ldapActionCancel{

delete($Global{'ldapActionDN'});
 
$Global{'ldapActionWindow'}->destroy() 
       if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'}); 

} # End of cancel subroutine
 
} # End of ldapAction subroutine

#
# Do LDAP entry data display.
#

sub ldapActionDisplay
{
my $dataArray;
my $blank = "   ";
my $data;
my $dn;
my $max;
my $lb;
my $info;
my $text;
my @infoKeys;
my @DNs = ();
if ( !$Global{'ldapActionDN'} )
{
delete($Global{'ldapActionDN'});
 
$Global{'ldapActionWindow'}->destroy() 
       if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'}); 
return;
}
my $objects = $Global{'ldapActionDN'};

delete($Global{'ldapActionDN'});
 
$Global{'ldapActionWindow'}->destroy() 
       if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'}); 

&displaySearch();

&displaySearch();  # create the entry data display window.

# clear the entry data display window.
if ( $display_clear ) { &display_clear(); }
#
# Format and display the data associcated with the dn 
# passed to this subroutine.
#
@DNs = split(/\//,$objects); # split base from dn.

$dataArray = $Global{'searchResults'};
$data = $$dataArray{$DNs[1]}; # get data associated with this dn
$dn = $$data[0];     # get DN
$max = $$data[1];    # get max size of atttributes
$info = $$data[2];   # get data hash address.
@infoKeys = sort(keys(%$info));  # get a list of all attributes.
$text = sprintf "%${max}s: %s\n",'dn',$dn;
$list->insert("end", $text); # insert data
#
# For each attribute display it's data
# 
foreach my $var (@infoKeys)
{

 if ( $var =~ /^jpegPhoto/i )
 {
   #
   # Display jpegPhoto in separate window if Tk::JPEG is used.
   #
   my $Value = decode_base64($$info{$var});
   displayPhoto($Value, $dn ) if ( $Global{'jpeg'}) ;  
   $dstring = "JpegPhoto binary data is not being displayed.\n";
   #
   #

   $text = sprintf "%${max}s: %s\n",$var,$dstring;
   $list->insert("end", $text); # position to the next row.
   next;
 }

 my $values = $$info{$var}; # get attribute data array.
 foreach my $Value ( @$values)
 {

  #
  # Format data and print data into Entry Box
  # 
  if ( $var =~ /;binary$/ )
  {
   $encoded = encode_base64($Value);
   $text = sprintf "%${max}s: %s\n",$var,$encoded;
  }
  else
  {
   $text = sprintf "%${max}s: %s\n",$var,$Value;
  }

   $list->insert("end", $text); # position to the next row.

  }
}

# position to the next row. 
$list->insert("end", "-----------------------------------------------------------------------------\n");
$list->insert("end", "\n");

}



#
# Do LDAP entry edit.
#

sub ldapActionEdit
{
my $dataArray;
my $editArray;
my $blank = "   ";
my $data;
my $dn;
my $max;
my $lb;
my $info;
my @infoKeys;
my @DNs = ();
my @tmp1 = ();
#my $index;
my $indexCount;
my $text;

if ( !$Global{'ldapActionDN'} )
{
delete($Global{'ldapActionDN'});
 
$Global{'ldapActionWindow'}->destroy() 
       if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'}); 
return;
}
my $objects = $Global{'ldapActionDN'};

delete($Global{'ldapActionDN'});
 
$Global{'ldapActionWindow'}->destroy() 
       if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'}); 

return if Tk::Exists($Global{'editWindow'});

&displayEdit();

# clear the entry data display window.

#
# Format and display the data associcated with the dn 
# passed to this subroutine.
#
@DNs = split(/\//,$objects); # split base from dn.

$dataArray = $Global{'searchResults'};
$data = $$dataArray{$DNs[1]}; # get data associated with this dn
$dn = $$data[0];     # get DN
my $tmpdn = $dn;     # save DN
$Global{'entryDN'} = $dn;     # save DN
$max = $$data[1];    # get max size of atttributes
$info = $$data[2];   # get data hash address.
@tmp1 = sort(keys(%$info));  # get a list of all attributes.

foreach my $attrKey ( @tmp1 )
{
 #
 # User can not edit these attributes, remove from the list of 
 # attributes to display.
 #
 if ( $attrKey =~ /createTimeStamp/i || $attrKey =~ /modifyTimeStamp/i ||
      $attrKey =~ /creatorsName/i || $attrKey =~ /modifiersName/i )
 {
    next;
 }

 push( @infoKeys, $attrKey );  # get a list of all attributes.

}

#
# create attribute label 
#
$text = sprintf "%${max}s",'DN';

$lb = $elist->Label(-text => $text, 
                    -font => $Global{'Font'},
                    -relief => 'groove',
                    -anchor => 'e',
                    -width => ($max+2) );

$elist->windowCreate("end", -window => $lb );
#
# create data entry window
#
$lb = $elist->Entry(-width => 85,
                   -textvariable => \$tmpdn);
$elist->windowCreate("end", -window => $lb );

$elist->insert("end", "\n"); # position to the next row.

#
# For each attribute display it's data
# 
foreach my $var (@infoKeys)
{

$text = sprintf "%${max}s",$var;

 my $values = $$info{$var}; # get attribute data array.

 foreach my $Value ( @$values )
 {

  if ( $var =~ /;binary$/ ) { next; } # We do not do binary data, yet.

  #
  # create attribute action button 
  #
  $ab = $elist->Button(-text => $text, 
                      -font => $Global{'Font'},
                      -borderwidth => 3,
                      -relief => 'raised' );

  $elist->windowCreate("end", -window => $ab );

  #
  # Format data and print data into Entry Box
  # 
  $lb = $elist->Listbox(-width => 85, -height => 1 );
  $elist->windowCreate("end", -window => $lb ); 
  $lb->insert('end', $Value );

  $ab->configure( -command => [ \&changeAttribute, \$ab, \$lb, \$Value, \$var ] );

  # position to the next row. 
  $elist->insert("end", "\n");

  }
}

$lb = $elist->Entry(-width => 85,
                    -textvariable => \$blank);
$elist->windowCreate("end", -window => $lb ); 
# position to the next row. 
$elist->insert("end", "\n");

}


sub changeAttribute
{
my ( $ab, $lb, $Value, $attr  ) = @_;

#
# Create change attribute Window
#
if (!Exists($Global{'changeWindow'}) )
{
&globalPos();
my $x = $Global{'horz'} + 75;
my $y = $Global{'vert'} + 75;
my $acframe;
my $alframe;
my $attribute;
$Global{'tmpADD'} = {};
$Global{'tmpDELETE'} = {};
$Global{'tmpREPLACE'} = {};

$Global{'changeWindow'} = MainWindow->new;
 
$Global{'changeWindow'}->title("ATTRIBUTE MODIFICATION WINDOW");
 
$Global{'changeWindow'}->geometry("+$x+$y");
 
#
# Create process Cancel button
#
 
$Global{'changeWindow'}->Button(-text => "CANCEL ATTRIBUTE EDIT",
      -command => \&change_cancel,
      -font => $Global{'Font'}, -borderwidth => 5 )
      -> pack(-fill => "both", -padx => 2, -pady => 2 ) ;
#
# Create frame for clear buttons.
#
 
 
$acframe = $Global{'changeWindow'}->Frame()
      ->pack( -fill => "both", -side => "bottom", -padx => 5, -pady => 2);
 
#
# Create Clear Data
#
 
$acframe -> Button(-text => "     ACCEPT DATA CHANGE     ",
      -command =>  \&makeChanges,
#      -command =>  [ \&makeChanges,\$ADD,\$DELETE,\$REPLACE ],
      -font => $Global{'Font'},
      -borderwidth => 3 )
      ->pack( -fill => 'both' );
 
 
#
# Create list frame.
#
 
$outerframe = $Global{'changeWindow'}->Frame()
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
      -expand => 1);
 
#
# Create data frame.
#
 
$alframe = $outerframe->LabFrame(-label => "ATTRIBUTE DATA",
      -labelside => "acrosstop" )
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
      -expand => 1);
 

#
# Create a Text Box that will actually contain the
# returned directory data.
#
 
$attrlist = $alframe ->Text( -width => 80, -height => 1, 
      -wrap => 'none',
      -font => $Global{'Font'}  );
 
$attrlist->pack(-fill => "both", -expand => 1 );
$attrlist->insert('end', $$Value); 

if ( $Global{'add_new_attribute'} )
{
#
# Create data frame.
#
 
$Global{'newAttributeFrame'} = $outerframe->LabFrame(
      -label => "NEW ATTRBUTE NAME",
      -labelside => "acrosstop" )
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
      -expand => 1);
 
#
# Create a Text Box that will actually contain the
# returned directory data.
#
 
 
$Global{'newAttribute'} = $Global{'newAttributeFrame'}->Text( 
      -width => 80, -height => 1, 
      -wrap => 'none',
      -font => $Global{'Font'}  );
 
$Global{'newAttribute'}->pack(-fill => "both", -expand => 1 );
 
$Global{'newAttributeReady'} = 1 ;

}


# 
##
## Create process add new attribute button
##
# 
#$Global{'changeWindow'}->Button(-text => "ADD\nATTRIBUTE",
#      -command => [\&add_attribute, $attr, $Value, \$outerframe],
#      -font => $Global{'Font'}, -borderwidth => 5 )
#      -> pack(-side => $Global{'hand'},
#      -padx => 2, -pady => 2 ) ;

 
#
# Create process Add button
#
 
$Global{'changeWindow'}->Button(-text => "ADD",
      -command => [\&add_data, $attr, $Value, \$attrlist],
      -font => $Global{'Font'}, -borderwidth => 5 )
      -> pack(-side => $Global{'hand'},
      -padx => 2, -pady => 2 ) ;

 
if ( !defined($Global{'add_new_attribute'}) )
{
#
# Create process Delete button
#
 
$Global{'changeWindow'}->Button(-text => "DELETE",
      -command => [\&delete_data, $attr, $Value],
      -font => $Global{'Font'}, -borderwidth => 5 )
      -> pack(-side => $Global{'hand'},
      -padx => 2, -pady => 2 ) ;

 
#
# Create process Replace button
#
 
$Global{'changeWindow'}->Button(-text => "REPLACE",
      -command => [\&replace_data, $attr, $Value,\$attrlist],
      -font => $Global{'Font'}, -borderwidth => 5 )
      -> pack(-side => $Global{'hand'},
      -padx => 2, -pady => 2 ) ;

#
# Create a multi value Checkbutton that will determine how multi-valued
# attributes are handled.  The schema can tell you but version 2
# ldap servers can not deliver schema data.
#
 
$Global{'changeWindow'} -> Checkbutton(
      -text => "SET MULTI-VALUED ATTRIBUTE",
      -variable =>  \$Global{'multi'}, -onvalue => 1,
      -offvalue => 0, -font => $Global{'Font'} )
      -> pack(-side => "left", -anchor => "center" );

}

}
else { return; }
 
sub delete_data {
my ( $attr, $Value ) = @_;
#
# 
#
$Global{'tmpDELETE'}{$$attr} = $$Value;
 
} # End of delete_data subroutine
 
 
sub replace_data {
my ( $attr, $Value, $tbox ) = @_;
#
# Replace this attributes value.
# But what if this is a multi-valued attribute.  
#
if ( $Global{'multi'} )
{
#
# User says it is a multi-valued attribute.
#
# First I add the new data then delete the old data.
#
$Global{'tmpDELETE'}{$$attr} = $$Value;
$Global{'tmpADD'}{$$attr} = $$tbox->get('1.0','1.end');

# print '|',$Global{'tmpREPLACE'}{$$attr},"|\n"; 
}
else
{
$Global{'tmpREPLACE'}{$$attr} = $$tbox->get('1.0','1.end');
# print '||',$Global{'tmpREPLACE'}{$$attr},"||\n"; 

}
 
} # End of replace_data subroutine
 
 
sub add_data {
my ( $attr, $Value, $tbox ) = @_;
my $newAttribute;
if ( $Global{'newAttributeReady'} )
{ 
#
# add new attribute and it's value
#
$newAttribute = $Global{'newAttribute'}->get('1.0','1.end');
#print $newAttribute, "\n";

$Global{'tmpADD'}{$newAttribute} = $$tbox->get('1.0','1.end');

}
else
{
#
# add new value to attribute
#
$Global{'tmpADD'}{$$attr} = $$tbox->get('1.0','1.end');

}
 
} # End of add_data subroutine
 
sub makeChanges {

my $tmp = $Global{'tmpADD'};
my @Keys = sort(keys(%$tmp));

if ( @Keys ) 
{
foreach my $var ( @Keys)
{
$Global{'add'}{$var} = $Global{'tmpADD'}{$var};
# print $var, " == ", $Global{'tmpADD'}{$var},"\n";
}

$Global{tmpADD} = {};

$Global{'newAttribute'}->destroy 
       if Tk::Exists($Global{'newAttribute'});
$Global{'newAttributeFrame'}->destroy 
       if Tk::Exists($Global{'newAttributeFrame'});
delete( $Global{'newAttributeReady'} ) 
       if ( defined($Global{'newAttributeReady'} ));
delete( $Global{'newAttribute'}) 
       if ( defined($Global{'newAttribute'} ));
delete( $Global{'newAttributeFrame'}) 
       if ( defined($Global{'newAttributeFrame'} ));

}

$tmp = $Global{'tmpDELETE'};

@Keys = sort(keys(%$tmp));

if ( @Keys ) 
{
foreach my $var ( @Keys)
{
$Global{'delete'}{$var} = $Global{'tmpDELETE'}{$var};
# print $Global{'tmpDELETE'}{$var},"\n";

}

$Global{tmpDELETE} = {};

}


$tmp = $Global{'tmpREPLACE'};
@Keys = sort(keys(%$tmp));

if ( @Keys ) 
{
foreach my $var ( @Keys)
{
$Global{'replace'}{$var} = $Global{'tmpREPLACE'}{$var};
# print $Global{'tmpREPLACE'}{$var},"\n";
}

$Global{tmpREPLACE} = {};
}

$Global{'changeWindow'}->destroy if Tk::Exists($Global{'changeWindow'});

} # End of clear subroutine
 
sub change_cancel{
 
$Global{tmpADD} = {};
$Global{tmpDELETE} = {};
$Global{tmpREPLACE} = {};
$Global{'changeWindow'}->destroy if Tk::Exists($Global{'changeWindow'});
 
} # End of cancel subroutine                                                    



} # End of subroutine changeAttribute

#
# Do LDAP entry delete.
#
sub ldapActionDelete
{
my $error;
my $ldap;
my $mesg;
my @DNs;

if ( !$Global{'ldapActionDN'} )
{
delete($Global{'ldapActionDN'});
 
$Global{'ldapActionWindow'}->destroy() 
       if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'}); 
return;
}
my $objects = $Global{'ldapActionDN'};

delete($Global{'ldapActionDN'});
 
$Global{'ldapActionWindow'}->destroy() 
       if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'}); 

@DNs = split(/\//,$objects); # split base from dn.
$error = 0;

$ldap = new Net::LDAP( $Global{'LDAP_SERVER'},
                          timeout => 1,
                          port => $Global{'port'},
                        ) or $error = 1; 

if ( $error == 1 )
{
   $list->insert("end",  "Connect error:  $@\n");
   return;
   $errstr = "Delete connect error on ldap server $Global{'LDAP_SERVER'}\n";
   ERROR($errstr);
}

$mesg = $ldap->bind( password => $Global{'bindpw'}, 
                     dn => $Global{'binddn'},
                     version => $Global{'setVersion'},
                   ) or $error = 1;
  

if ( $mesg->code ) 
{
   $errstr = $mesg->code;
   ERROR($errstr);
}
 
if ( $error == 1 )
{
   $errstr =  "Delete Bind error on ldap server $Global{'LDAP_SERVER'}\n";
   ERROR($errstr);
}

$mesg = $ldap->delete($DNs[1]) or $error = 1; 

if ( $error == 1 )
{
   $errstr = "Delete error: $object\nOn ldap server $Global{'LDAP_SERVER'}\n";
   ERROR($errstr);
   return;
}
   
if ( $mesg->code ) 
{
   $errstr = $mesg->code;
   ERROR($errstr);
}

$ldap->unbind;

} # End of ldapActionDelete subroutine

#
# Do LDAP entry rename.
#

sub ldapActionRename
{
my $error;
my $ldap;
my $mesg;
$error = 0;

if ( $Global{'Rename'} == -1 ) 
{
return;
}

$ldap = new Net::LDAP( $Global{'LDAP_SERVER'},
                          timeout => 1,
                          port => $Global{'port'},
                        ) or $error = 1; 

if ( $error == 1 )
{
   $list->insert("end",  "Connect error:  $@\n");
   return;
   $errstr = "Rename connect error on ldap server $Global{'LDAP_SERVER'}\n";
   ERROR($errstr);
}

$mesg = $ldap->bind( password => $Global{'bindpw'}, 
                     dn => $Global{'binddn'},
                     version => $Global{'setVersion'},
                   ) or $error = 1;
  

if ( $mesg->code ) 
{
   $errstr = $mesg->code;
   ERROR($errstr);
}
 
if ( $error == 1 )
{
   $errstr =  "Rename Bind error on ldap server $Global{'LDAP_SERVER'}\n";
   ERROR($errstr);
}

$mesg = $ldap->moddn($Global{'RenameDN'}, 
                     newrdn => $Global{'newrdn'}, 
                     deleteoldrdn => $Global{'deleteoldrdn'}, 
                     newsuperior => $Global{'newsuperior'} ) or $error = 1; 

if ( $error == 1 )
{
   $errstr = "Rename error: $Global{'RenameDN'}\nOn ldap server $Global{'LDAP_SERVER'}\n";
   ERROR($errstr);
   return;
}
   
if ( $mesg->code ) 
{
   $errstr = $mesg->code;
   ERROR($errstr);
}

}
 
#
# Create Rename DATA  Window
#
 
sub getRenameData {
$Global{'newsuperior'} = "";
$Global{'newrdn'} = "";
$Global{'RenameDN'} = "";
$Global{'deleteoldrdn'} = 1;
&globalPos();
my $x = $Global{'horz'} + 0;
my $y = $Global{'vert'} + 50;
my @rdnData;
my $rdn;
my $super;
my $delrdn;
my @DNs;

if ( !$Global{'ldapActionDN'} )
{
delete($Global{'ldapActionDN'});
 
$Global{'ldapActionWindow'}->destroy() 
       if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'}); 
return;
}
my $objects = $Global{'ldapActionDN'};

delete($Global{'ldapActionDN'});
 
$Global{'ldapActionWindow'}->destroy() 
       if Tk::Exists($Global{'ldapActionWindow'});
delete($Global{'ldapActionWindow'}); 

@DNs = split(/\//,$objects); # split base from dn.

$Global{'RenameDN'} = $DNs[1];

@rdnData = split(/,/,$DNs[1]);

$rdn = shift(@rdnData);

foreach my $var (@rdnData)
{
$super .= $var . ",";
} 

chop($super); # get rid of trailing comma

#
# Create Data Window
#
 
$Global{'renameWindow'} = MainWindow->new;
 
$Global{'renameWindow'}->title("MODDN INFORMATION");
 
$Global{'renameWindow'}->geometry("+$x+$y");
#
# Create process accept button
#
$Global{'renameWindow'}->Button( -text => "ACCEPT", -command => \&rdnAccept, 
           -font => $Global{'Font'}, -borderwidth => 3 )
           -> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
 
#
# Create process cancel button
#
$Global{'renameWindow'}->Button(-text => "CANCEL", -command => \&rdnCancel, 
           -font => $Global{'Font'}, -borderwidth => 3)
           -> pack(-side => "top", -padx => 5, -pady => 5 ) ;
 
my $newrdnframe = $Global{'renameWindow'}->LabFrame(-label => "Newrdn",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
 
#
# Create newrdn text box.
#
 
my $t1 = $newrdnframe->Entry(-textvariable => \$Global{'newrdn'}, -width => 25 )
      -> pack(-fill => 'x');
 
$t1->insert("end", $rdn);


#
# Create a Deleteoldrdn Radiobutton that will execute subroutine clear
# to clear the List box before each directory query.
#

$delrdn = $Global{'renameWindow'} -> Checkbutton(-text => "DELETE OLD RDN DATA",
      -variable =>  \$Global{'deleteoldrdn'}, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-anchor => 'sw' );

$delrdn->select();

my $newsuperiorframe = $Global{'renameWindow'}->LabFrame(-label => "Newsuperior RDN",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
 
#
# Create Password Entry text box.
#
 
my $t2 = $newsuperiorframe->Entry( -textvariable => \$Global{'newsuperior'}, 
                    -width => 25, -font => $Global{'Font'} )
                    -> pack(-fill => 'x');
 
$t2->insert("end", $super);

sub rdnCancel{
 
$Global{'renameWindow'}->destroy() if Tk::Exists($Global{'renameWindow'});
delete($Global{'renameWindow'}); 
delete( $Global{'newsuperior'});
delete( $Global{'newrdn'});
delete( $Global{'deleteoldrdn'} );
delete( $Global{'RenameDN'} );
} # End of cancel subroutine
 
sub rdnAccept{ 
 
#
# Clean up data and close windows, forces another search to
# get valid new data.
#

$Global{'renameWindow'}->destroy() if Tk::Exists($Global{'renameWindow'});
$Global{'searchHistWindow'}->destroy if Tk::Exists($Global{'searchHistWindow'});
$Global{'renameWindow'} = undef(); 
$Global{'searchHistWindow'} = undef(); 

&ldapActionRename();  # Rename the entry in the directory
 
delete( $Global{'newsuperior'});
delete( $Global{'newrdn'});
delete( $Global{'deleteoldrdn'} );
delete( $Global{'RenameDN'} );

delete($Global{'index'}) if ( defined($Global{'index'}));

} # End of accept subroutine

} # End of getRenameData subroutine


sub displaySearch()
{
# my $displayWindow;
my $cframe;
my $lframe;
my $rbclear;
#my $list;
&globalPos();
my $x = $Global{'horz'} + 100;
my $y = $Global{'vert'} + 100;
#
# Create Main Window
#
if (!Exists($displayWindow) )
{

$displayWindow = MainWindow->new;

$displayWindow->title("DIRECTORY SEARCH DISPLAY");

$displayWindow->geometry("+$x+$y");

#
# Create process Exit button
#

$displayWindow->Button(-text => "CLOSE SEARCH DISPLAY RESULT WINDOW", 
              -command => \&display_cancel, -font => $Global{'Font'},
              -borderwidth => 5 )
              -> pack(-fill => "both", -padx => 2, -pady => 2 ) ;

#
# Create frame for clear buttons.
#


$cframe = $displayWindow->Frame()
      ->pack( -fill => "both", -side => "bottom", -padx => 5, -pady => 2);

#
# Create Clear Data
#

$cframe -> Button(-text => "     CLEAR DATA     ", 
     -command =>  \&display_clear, -font => $Global{'Font'},
     -borderwidth => 3 ) 
     ->pack( -fill => 'both' );

#
# Create list frame.
#

$lframe = $displayWindow->LabFrame(-label => "DIRECTORY DATA",
      -labelside => "acrosstop" )
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
      -expand => 1);

#
# Create a Clear Data Radiobutton that will execute subroutine clear
# to clear the List box before each directory query.
#

$rbclear = $lframe -> Checkbutton(-text => "CLEAR DIRECTORY DATA ON EACH QUERY",
      -variable =>  \$display_clear, -onvalue => 1, -offvalue => 0, 
      -font => $Global{'Font'} )
      -> pack(-anchor => 'sw' );

$rbclear->select();

#
# Create a ROText Box that will actually contain the 
# returned directory data.
#

$list = $lframe ->Scrolled('ROText', -scrollbars => 'se',
        -width => 80, -height => 20, -wrap => 'none', 
        -font => $Global{'Font'}  );

$list->pack(-fill => "both", -expand => 1 );

}
#else
#{
#$displayWindow->deiconify() if Tk::Exists($displayWindow);
#$displayWindow->raise() if Tk::Exists($displayWindow);
#}


sub display_clear {

#
# Clear out text in List Box
#

$list->delete("1.0", "end");

} # End of clear subroutine
 
sub display_cancel{
 
# $displayWindow->withdraw if Tk::Exists($displayWindow);
$displayWindow->destroy if Tk::Exists($displayWindow);
 
} # End of cancel subroutine

} # End of subroutine displaySearch





sub displayEdit()
{
my $ecframe;
my $elframe;
my $erbclear;
&globalPos();
my $x = $Global{'horz'} + 75;
my $y = $Global{'vert'} + 75;
#
# Create Main Window
#
if (!Exists($Global{'editWindow'}) )
{

$Global{'editWindow'} = MainWindow->new;

$Global{'editWindow'}->title("ENTRY EDIT DISPLAY");

$Global{'editWindow'}->geometry("+$x+$y");

#
# Create process Exit button
#

$Global{'editWindow'}->Button(-text => "CANCEL ENTRY EDIT", 
                    -command => \&edit_cancel, 
                    -font => $Global{'Font'}, -borderwidth => 5 )
                    -> pack(-fill => "both", -padx => 2, -pady => 2 ) ;

#
# Create frame for clear buttons.
#


$ecframe = $Global{'editWindow'}->Frame()
      ->pack( -fill => "both", -side => "bottom", -padx => 5, -pady => 2);

#
# Create Clear Data
#

$ecframe -> Button(-text => "     CHANGE DATA     ", 
     -command =>  \&changeEntry, -font => $Global{'Font'},
     -borderwidth => 3 ) 
     ->pack( -fill => 'both' );

#
# Create list frame.
#

$elframe = $Global{'editWindow'}->LabFrame(-label => "ENTRY DATA",
      -labelside => "acrosstop" )
      ->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
      -expand => 1);

#
# Create a ROText Box that will actually contain the 
# returned directory data.
#

$elist = $elframe ->Scrolled('Text', -scrollbars => 'se',
        -width => 80, -height => 20, -wrap => 'none', 
        -font => $Global{'Font'}  );

$elist->pack(-fill => "both", -expand => 1 );

 
#
# Create process add new attribute button
#
 
$elframe->Button(-text => "ADD\nATTRIBUTE",
      -command => \&add_new_attribute,
      -font => $Global{'Font'}, -borderwidth => 5 )
      -> pack(-side => $Global{'hand'},
      -padx => 2, -pady => 2 ) ;



}

sub edit_cancel{

delete($Global{'add'}); 
delete($Global{'delete'}); 
delete($Global{'replace'}); 
$Global{'editWindow'}->destroy if Tk::Exists($Global{'editWindow'});
 
} # End of cancel subroutine

} # End of subroutine displayEdit

#
# Add new attribute to entry that is being edited.
#
sub add_new_attribute
{
$Global{'add_new_attribute'} = 1;
changeAttribute( 1,1,1,1);
delete($Global{'add_new_attribute'});
} # End of subroutine add_new_attribute

#
# Execute any LDAP add, delete, or replace changes.
#
sub changeEntry {
my $errstr;
my $mesg;
my $error = 0;  # initialize error flag.
 
my $ldap = new Net::LDAP( $Global{'LDAP_SERVER'},
                          timeout => 1,
                          port => $Global{'port'},
                        ) or $error = 1;
 
if ( $error == 1 )
{
   $errstr = "Connect error:  $@\n";
   ERROR($errstr);
   return;
}
 
$mesg = $ldap->bind( password => $Global{'bindpw'},
                     dn => $Global{'binddn'},
                     version => $Global{'setVersion'},
                   ) or $error = 1;

if ( $mesg->code )
{
   $errstr = $mesg->code;
   ERROR($errstr);
}
 
if ( $error == 1 )
{
   $errstr = "Bind error:  $@\n";
   ERROR($errstr);
   return;
}

#
# Execute any LDAP add changes.
#
if ( defined($Global{'add'}) )
{

$mesg = $ldap->modify( $Global{'entryDN'}, add => $Global{'add'})
        or $error = 1;
 
 
if ( $error == 1 )
{
   $errstr = "Add modify error:  $@\n";
   ERROR($errstr);
   return;
}
 
if ( $mesg->code )
{
   $errstr = $mesg->code;
   ERROR($errstr);
   return;
}

delete( $Global{'add'} );

}

#
# Execute any delete changes.
#
if ( defined($Global{'delete'}) )
{
$mesg = $ldap->modify( $Global{'entryDN'}, delete => $Global{'delete'})
        or $error = 1;
 
 
if ( $error == 1 )
{
   $errstr = "Delete modify error:  $@\n";
   ERROR($errstr);
   return;
}
 
if ( $mesg->code )
{
   $errstr = $mesg->code;
   ERROR($errstr);
   return;
}
delete( $Global{'delete'} );

}


#
# Execute any replace changes.
#
if ( defined($Global{'replace'}) )
{
$mesg = $ldap->modify( $Global{'entryDN'}, replace => $Global{'replace'})
        or $error = 1;
 
 
if ( $error == 1 )
{
   $errstr = "Replace modify error:  $@\n";
   ERROR($errstr);
   return;
}
 
if ( $mesg->code )
{
   $errstr = $mesg->code;
   ERROR($errstr);
   return;
}
delete( $Global{'replace'} );

}

#
# Clean up data and close windows, forces another search to
# get valid new data.
#
delete($Global{'index'}) if ( defined($Global{'index'}));

delete($Global{'tmpADD'}) if ( defined($Global{'tmpADD'}));
delete($Global{'tmpDELETE'}) if ( defined($Global{'tmpDELETE'}));
delete($Global{'tmpREPLACE'}) if ( defined($Global{'tmpREPLACE'}));

delete($Global{'add'}) if ( defined($Global{'add'}));
delete($Global{'delete'}) if ( defined($Global{'delete'}));
delete($Global{'replace'}) if ( defined($Global{'replace'}));

$Global{'editWindow'}->destroy if Tk::Exists($Global{'editWindow'});
$Global{'changeWindow'}->destroy if Tk::Exists($Global{'changeWindow'});
$Global{'searchHistWindow'}->destroy if Tk::Exists($Global{'searchHistWindow'});

} # End of changeEntry subroutine
 

sub displayDnList
{
&globalPos();
my $x = $Global{'horz'};
my $y = $Global{'vert'}  + 230 ;

#
# Set up the Tk windows.
#
#

if ( ! Exists($Global{'searchHistWindow'} ) ) 
{
  eval 
     { 
       $Global{'searchHistWindow'} = MainWindow->new(); 
     };
  print "$@" if ( defined($@)); }
else 
{
$Global{'searchHistWindow'}->deiconify() if Tk::Exists($Global{'searchHistWindow'}); 
$Global{'searchHistWindow'}->raise() if Tk::Exists($Global{'searchHistWindow'}); 
}                                                                               

$Global{'searchHistWindow'}->geometry("+$x+$y"); 
$Global{'searchHistWindow'}->title("SEARCH RESULTS");
#
# Create label box
#

if ( !Exists($Global{'label'}) )
{
$Global{'searchLabel'} = $Global{'searchHistWindow'}->Label()->pack;
}

#
# Create process Exit button
#

$hbuttonSearch = $Global{'searchHistWindow'}->Button(
              -text => "CLOSE SEARCH DISPLAY WINDOW", 
              -command => \&histSearch_cancel, -font => $Global{'Font'},
              -borderwidth => 5 )
              -> pack(-fill => "both", -padx => 2, -pady => 2 ) 
              if ( Exists($Global{'searchHistWindow'} ) && 
                   !Exists($hbuttonSearch ) );

#
# Create Hierarchial DN list box, this is where the DN data
# tree will be displayed.
#

$Global{'searchHList'} = $Global{'searchHistWindow'}
   ->Scrolled('HList', 
            -font       => $Global{'Font'},
            -scrollbars => 'se',
            -width      => 50, 
            -height     => 20,
            -itemtype   => 'text',
            -separator  => '/',
            -selectmode => 'single',
            -browsecmd  => sub {
#
            my $objects = shift;   # get base and the dn

            return if ( Tk::Exists($Global{'ldapActionWindow'})) ;
            &ldapAction($objects);

            } # End of subroutine browsecmd

   );  # End of Scrolled HList.


sub histSearch_clear {

#
# Clear out text in List Box
#

$Global{'searchList'}->delete("1.0", "end");

} # End of clear subroutine
 
sub histSearch_cancel{

$Global{'searchList'}->destroy if Tk::Exists($Global{'searchList'});
$Global{'searchHList'}->destroy if Tk::Exists($Global{'searchHList'});
$Global{'searchHistWindow'}->destroy if Tk::Exists($Global{'searchHistWindow'});
} # End of cancel subroutine

} # End of cancel subroutine

#
# Search the directory for data
#

sub search 
{
my $mesg;
my $error;
my $att_wanted;
my %opt = (
  'd' => 0
);

#
# Destroy the dn history list if it exists.
#
$Global{'searchHList'}->destroy if Tk::Exists($Global{'searchHList'});

#
# Display the DN search results list box.
#
displayDnList();

#
# Parameter(s) to return
#

if ( $Global{'setVersion'} == 3 )
{
#
# Default to return everything.
#
$att_wanted = [ "*", 
                "createTimeStamp",
                "modifyTimeStamp",
                "creatorsName",
                "modifiersName" ];
}
else
{
#
#
# If you have only version 2 ldap servers you will need to 
# to add the attributes that you want data returned for to
# this list.
#
#
$att_wanted = [ "cn" ,
                "sn",
                "mail",
                "modifyTimeStamp",
                "creatorsName",
                "modifiersName" ];
}

#
# Set Filter options.
# 
if (  $Global{'info'} eq "Filter" )
{
$match = $Global{'adata'};
}
else
{
if ( $Global{'infoFilter'} =~ /^equal$/ )
{
  $match = "(" . $Global{'info'} . '=' . $Global{'adata'} . ")";
}
elsif ( $Global{'infoFilter'} =~ /^begins with$/ )
   {
     $match = "(" . $Global{'info'} . '=' . $Global{'adata'} . "*)";
   }
elsif ( $Global{'infoFilter'} =~ /^ends with$/ )
   {
     $match = "(" . $Global{'info'} . '=*' . $Global{'adata'} . ")";
   }
elsif ( $Global{'infoFilter'} =~ /^contains$/ )
   {
     $match = "(" . $Global{'info'} . '=*' . $Global{'adata'} . "*)";
   }
   else
   {
     $match = "(" . $Global{'info'} . '=' . $Global{'adata'} . ")";
   }

}

$error = 0;  # initialize error flag.

my $f = Net::LDAP::Filter->new($match) or $error = 1;

if ( $error == 1 )
{
   $list->insert("end",  "Bad filter '$match'.\n");
   return;
}

my $ldap = new Net::LDAP( $Global{'LDAP_SERVER'},
                          timeout => 1,
                          port => $Global{'port'},
                        ) or $error = 1; 

if ( $error == 1 )
{
   $list->insert("end",  "Connect error:  $@\n");
   return;
}

$mesg = $ldap->bind( password => $Global{'bindpw'}, 
                     dn => $Global{'binddn'},
                     version => $Global{'setVersion'},
                   ) or $error = 1;
  

if ( $mesg->code ) 
{
   $errstr = $mesg->code;
   ERROR($errstr);
}
 
if ( $error == 1 )
{
   $list->insert("end",  "Bind error:  $@\n");
   return;
}

$Global{'searchResults'} = {};  # initialize results hash.

$mesg = $ldap->search(
  base   => $LDAP_SEARCH_BASE,
  filter => $f,
  attrs  => $att_wanted,
  callback => \&print_entry,
) or $error = 1; 


if ( $error == 1 )
{
   $list->insert("end", "Search error:  $@\n");
   return;
}
   
if ( $mesg->code ) 
{
   $errstr = $mesg->code;
   $list->insert("end", "Error code:  $errstr\n");
   $errstr = ldap_error_text($errstr);
   $list->insert("end", "$errstr\n");
   return;
}


#
# Create Hierarchial DN list box data tree, 
# and display data.
#


eval{
#
# Create the base point.
#
$Global{'searchHList'}->add($LDAP_SEARCH_BASE, -text=>$LDAP_SEARCH_BASE);  

$results = $Global{'searchResults'};

@dnKeys = sort(keys(%$results));

#
# build the hierachical list using the DN
#
foreach my $dnvar ( @dnKeys ) 
{
 $var = $$results{$dnvar};  # get entry data array
 $shbase = $LDAP_SEARCH_BASE . "/" . $$var[0]; # create new leaf
 $Global{'searchHList'}->add($shbase, -text => $$var[0]); # add leaf to tree.
}
$Global{'searchHList'}->pack(-side => "right");
};

print "$@" if ( defined($@));


$ldap->unbind if ( defined($ldap));

#
# Get and print out the record attributes.
#

sub print_entry {
  my($mesg,$entry) = @_;
  my @ref = ();
  my $dn;
  my $max;
  my $data = [];
  my $information = {};

  if ( !defined($entry) )
  { 
#    $list->insert("end", "No records found matching filter $match.\n") 
#       if ($mesg->count == 0) ;

    return;
  }
 
  $dn = $entry->dn;           # store the entry dn
  #
  #
  #
  @ref = $mesg->referrals();
  if ( @ref )
  {
  foreach (@ref )
  {
    $list->insert("end", "LDAP Referral: $_ \n");
  }

  }
  else
  {
  #
  # Get a list of record attributes
  #
  
  my @attrs = sort $entry->attributes;
  $max = 0;
  #
  # Calculate each attribute`s text length.
  # We use this to create a pretty print out in the 
  # List Box
  #
  
  foreach (@attrs) { $max = length($_) if length($_) > $max }

  #
  # Get attribute`s data
  #
  
  foreach (@attrs) {
    my $attr = $entry->get_value($_, asref => 1);
    next unless $attr;

    if ( /^jpegPhoto/i )
    {
      #
      # record jpegPhoto data.
      #
      $encoded = encode_base64(@$attr[0]);
      $$information{$_} = $encoded;
      next;
    }

    $$information{$_} = $attr;  # record ldap data

    next;
    
  }
 }
push(@$data, $dn);   # dn of entry
push(@$data, $max);  # max attribute string lenght
push(@$data, $information);
${$Global{'searchResults'}}{$dn} = $data;
}

} # End of search subroutine

#
# Display jpegPhoto in separate window if Tk::JPEG is used.
#
sub displayPhoto
{
my ($picture, $dn) = @_; 
my $jpegFile = $ENV{'TMP'} ."/jpegfile.$$";
#
# Store the jpeg data to a temp file.
#
open(TMP, "+>$jpegFile");
$| = 1;

print TMP $picture;
close(TMP);

if ( !-e "$jpegFile" )
{
my $str = "Could not create temporary jpeg file $jpegFile";
ERROR( \$str );
return;
}

#
# Create a TK window to display the jpeg picture.
#
my $mw  = MainWindow->new();
$mw->title("JPEG PHOTO DISPLAY");
my $list = $mw ->Listbox( -height => 1, width => length($dn)  );  
$list->pack( -side => "top" );  
$list->insert("end", $dn);                                                                                 
my $image = $mw->Photo(-file => $jpegFile, -format => "jpeg" );

$mw->Label(-image => $image)->pack(-expand => 1, -fill => 'both');
$mw->Button(-text => 'CLOSE WINDOW', -command => [destroy => $mw])->pack;
MainLoop;

unlink $jpegFile;

} # End of displayPhoto

#
# Detect and record the sub-bases, or branches, of the directory.
#

sub getBases()
{
my $mesg;
my ( $host, $base ) = @_;
my @base = ();
my $ptr;
my $match;

if ( $Global{'nismapname'} )
{
 #
 # Solaris Native LDAP enabled
 #
 $match = "(|(ou=*)(nismapname=*))";  #search only for ou entries.
}
else
{
 $match = "(ou=*)";  #search only for ou entries.
}
my $error = 0;  # initialize error flag.

my $f = Net::LDAP::Filter->new($match) or die "Bad filter '$match'";

my $ldap = new Net::LDAP( $host,
                          timeout => 30,
                          port => $Global{'port'},
                        ) or $error = 1;

#
# Check for an error on connect/object creation
#

if ( $error == 1 )
{
   my $error = "getBases LDAP connect error.";
   ERROR(\$error);
   return @base;
}

$mesg = $ldap->bind( password => "$Global{'bindpw'}", 
                     dn => "$Global{'binddn'}", 
                     version => $Global{'setVersion'},
                   ) or $error = 1;

#
# Check for an error on bind
#
   
if ( $error == 1 )
{
   my $error = "getBases LDAP bind error.";
   ERROR(\$error);
   return @base;
}

if ( $mesg->code ) 
{
  $errstr = $mesg->code;
  ERROR($errstr);
}
 
push(@base,$base);
$ptr = 0;

while ( $ptr < @base )
{
 if ( @base < $Global{'limit'} )
 { 
  my @new_base = calBase($base, $ldap, $f );
  push(@base, @new_base);
 }
 $base = $base[++$ptr];
}

$ldap->unbind if ( defined($ldap));
return @base;

} # End of subroutine getBases()


sub calBase()
{
my ( $base, $ldap, $f ) = @_;
my $mesg;
my $entry;
my $errstr;
my $error = 0;
my @new_base = ();

$mesg = $ldap->search(
  base   => $base,
  filter => $f,
  attrs  => [ "cn" ],
  scope  => "one",
) or $error = 1;

#
# search for deadly ldap->search call error,
# not the same as an ldap error.
#
if ( $error == 1 )
{
   my $error = "getBases LDAP search error.";
   ERROR(\$error);
   return @new_base;
}


#
# Check for an error on search
# Search call work, but there was an ldap error.
#

if ( $mesg->code ) 
{
   $errstr = $mesg->code;
   ERROR($errstr);
   return @new_base;
}
 else
 {

 $entry = $mesg->entry;

 return @new_base unless defined($entry);
 $count = $mesg->count();

 for($i = 0 ; $i < $count ; $i++) 
 {
 my $entry = $mesg->entry($i);

 $dn = $entry->dn;
 $_ = $dn;

#
# Record only dn that start with ou=
# Normal entrys can be mixed in with these objects.
#
 if ( $Global{'nismapname'} && ( /^ou=/ || /^nismapname/ ) )
 {
  push(@new_base, $dn);  # record only dn that start with ou=
 }
 elsif ( /^ou=/ )
 {
  push(@new_base, $dn);  # record only dn that start with ou=
 }

 }
return @new_base;

}

} # End of subroutine calBase()

#
# Get and display the root dse entry.
#

sub rootDse
{
my $base;
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
my $error;

#if ( $Global{'setVersion'} != 3 )
#{
# $error = "LDAP version is not equal to 3.";
# ERROR(\$error);
# return;
#}

my $ldap = new Net::LDAP($Global{'LDAP_SERVER'}) or die;
my $mesg = $ldap->bind( version => $Global{'setVersion'} ) or die;

if ( $mesg->code  )
{
    $error = $mesg->code;
    ERROR($error);
    return if ( $mesg->code != 48 );

}
my $root = $ldap->root_dse();

my @Attributes = ( qw(subschemaSubentry namingContexts supportedLDAPVersion 
                    supportedControl supportedExtension altServer supportedSASLMechanisms) );

if ( !defined($root) )
{
   my $error =  "Root DSE entry could not be obtained.";
   ERROR(\$error);
}

#
# Set up the Tk windows.
#
#
 
if ( ! Exists($Global{'rootWindow'} ) )
{
   $Global{'rootWindow'} = MainWindow->new();
   $Global{'rootWindow'}->title("ROOT DSE ENTRY");
   $Global{'rootWindow'}->geometry("+$x+$y"); 
}

#
# Create label box
#
# 
if ( !Exists($Global{'labelDSE'}) )
{
 $Global{'labelDSE'} = $Global{'rootWindow'}->Label()->pack;
}
 
#
# Create process Exit button
#
 
$Global{'ebuttonDSE'} = $Global{'rootWindow'}->Button(
              -text => "CLOSE ROOT DSE DISPLAY WINDOW",
              -command => \&root_cancel, -font => $Global{'Font'},
              -borderwidth => 5 )
              -> pack(-fill => "both", -padx => 2, -pady => 2 )
              if ( Exists($Global{'rootWindow'} ) &&
                   !Exists($Global{'ebuttonDSE'} ) );
 
#
# Create list box, this is where the selected objectclass data will
# be displayed.
#
 
if ( !Exists($Global{'listDSE'}) )
{
 $Global{'listDSE'} = $Global{'rootWindow'}->Scrolled('ROText',
             -scrollbars => 'se', -width=>50, -wrap => "none",
             -font => $Global{'Font'}, -height => 10 )
             ->pack();
}
else
{
 #
 # clear the list box
 #
 $Global{'listDSE'}->delete("1.0", "end");
} 

foreach $attr (@Attributes)
{

 $base = $root->get_value( $attr, asref => 1); 
 foreach (@$base)
 {
 $Global{'listDSE'}->insert("end", "$attr:  $_\n");
 }

}

$ldap->unbind;

}

#
# Determine new mainWindow position.
#
sub globalPos 
{

my @pos;
@pos = split(/\+/,$Global{'mainWindow'}->geometry());
$Global{'horz'} = $pos[1];
$Global{'vert'} = $pos[2];

}

sub root_cancel
{
 $Global{'rootWindow'}->destroy if Tk::Exists($Global{'rootWindow'}); 
}

#----------------------------------------#
# Usage() - display simple usage message #
#----------------------------------------#
sub Usage
{
   print( "Usage: [-h] | [-d]\n" );
   print( "\t-d    Debug mode.  Display debug messages to stdout.\n" );
   print( "\t      Will not fork process.\n" );
   print( "\t-h    Help.  Display this message.\n" );
   print( "\n" );
   print( "\t      Perldoc pod documentation is included in this script.\n" );
   print( "\t      To read the pod documentation do the following;\n" );
   print( "\t      perldoc <script name>\n" );
   print( "\n" );
   print( "\n" );
   exit( 1 );
}

__END__

=head1 NAME

tklkup -  A script to do LDAP directory lookups, edits, and displaying directory schema information.

=head1 SYNOPSIS


This script is used to lookup and edit information from a LDAP 
directory server.  It is GUI based with several buttons for 
selecting directory servers, search bases, attributes and
for enabling the Directory Schema Search window.

This script has been tested on Solaris, RedHat 6.0 Linux, 
Mandrake 6.5  and ActiveState Perl 628 but should work with 
any system that has PERL and the required modules installed in 
it.

There are 2 files associated with the tklkup program in this 
tar file; dot.tklkup, and tklkup.

About the files.

=over 4

=item dot.tklkup

dot.tklkup - This is the initialization file that should be put 
into each users home directory as I<.tklkup>.  

This file will have to be setup properly before the user 
can expect the tklkup script to work properly.  The odds of this
initialization file being setup correctly for anyone is I<ZERO>.
However the script can be run with this file to get a feel 
for how the script will look.

It allows the user to customize how tklkup will look and 
work for them.
If the .tklkup files does not exist in a users home
directory the program has a set of built-in defaults
that it will use.

To be used this file must have user read permission.

There are 5 commands that can be used with this file;
hand, attribute, server, limit, and port.
 
 hand -> values: left or right.  Defines where the 
                 attribute label box will be place.

 limit -> value: default is 30.  Limits the number of 
                 search base(s) detected.

 port -> value: default is 389.  User should set this
                 to match their needs.
 
 nismapname -> Solaris Native LDAP uses nismapname to define
               the automounter directory branches.  Default
               is to not use Solaris Native LDAP.  Uncomment
               this line in the dot.tklkup file to enable this
               option.

 attribute -> attribute upon which the data search will be
              based.  One attribute per line.  There is one
              additional attribute that is always listed without
              any action by the user; Filter.  This attribute
              allows the user to enter the I<COMPLETE> filter
              that will used to search for data.  

 server -> name of the directory server that you wish
           to conduct the data search. 
           One server per line.
           Each line can have one of two formats
           server: server name
                  or
           server: server name: base 

           The I<server: server name> format will try to use the 
           root_dse function to define the base.
           It the root_dse returns the namingContexts attribute,
           that information will be use to determine the search
           base(s).
           If the root_dse returns undefined or has no namingContexts
           attribute, a null string will be the search base.
           In this case the user will have to define a search base
           in the server command of the .tklkup file.

           The I<server: server name: base> format will 
           cause each of the defined servers to have it's 
           own special initial search base and use this initial
           search base to find all of the other search bases.
           This is an attempt to do auto search base detection.
           Using this method has one I<draw back>, when changing
           to a different directory server there is a possible
           I<delay> on displaying the new server name and 
           search base.  This is due to the fact that TK and 
           it's MainLoop() process are not multi-tasking.
           The new search base has to be acquired and setup before 
           MainLoop() takes control of the process.
           Depending on the number of search bases this time period
           can be quite a few seconds.  

           When switching between servers with the same base, the 
           search base will I<not> be updated.  This too can have 
           a I<draw back> if there are new search bases in the 
           new server but it saves time.

           None of this is a problem if all of your servers have 
           the same DIT layouts. Just define them with the 
           same search base, there should be little or no delay
           when switching to the new server.          
           
 Now a word about directory branch, or search base, detection.  
 There are many things that can prevent this function from working
 properly.  Several version 2 LDAP servers that this was tested 
 on required that you be bound to the server.
 None of the version 3 LDAP servers required this. 
 If this function does not work for you, provide a bind DN and 
 password.  The normal mode of operation for this function is an 
 anonymous bind situation. 
 Some of the ldap servers I worked with would never return the 
 information I expected, auto detection never functioned on these
 systems.
 There is one college ldap server on the Internet that has so 
 many bases that it takes over an hour to figure out all the 
 search bases.  The only way the operator knows that the 
 script is still working is because search limit exceeded messages
 are displayed on the console that initiated the tklkup script.
 Who wants to wait a hour while the script figures this out.
 
 If you decide to use auto search base detection you will just have
 to try it and hope it works.

=back 4
-------------------------------------------------------------------

=head1 tklkup

tklkup - PERL executable file.  

You may need to change the first line of the PERL tklkup script 
to point to your file pathname of perl.

When executed tklkup will display a window on your
computer.  The graphical user interface, GUI, has 
several sections to it.  

If tklkup is run on a HPUX, Sun, or Linux system the 
tklkup process will fork and run in background mode.
If tklkup is run in debug mode or on a system that is not
listed above it will I<NOT> fork and will run in in 
foreground mode.

I<Exit> button.  At the top of the GUI is the "Exit"
button.  When a mouse click is done on the "Exit" button 
the program will terminate.

The I<SET LDAP VERSION> "RadioButton" diamond will select the
LDAP protocol version.  When selected the "RadioButton" 
diamond will be red in color.  This indicates that the 
ldap connection will use the version I<3> protocol.  To use 
ldap version I<2> protocol press the "RadioButton" diamond 
so that it becomes a gray color.
 
The I<SELECT SERVER> button will activate a 
drop down menu.  From the menu the user will select the 
"RadioButton" that corresponds to the directory server the
user wishes to use.  When selected the "RadioButton" diamond
will turn red in color.  This menu is a designed to be a 
"I<tear off>" menu, selecting the "---------------" line will 
cause the pull down menu to become a separate window that 
is still somewhat controlled by the GUI.  The 
DIRECTORY SERVER text box will display the directory name 
that is selected.  If the GUI is icon-ed or exited, the tear 
off window will follow the actions of the GUI.  All other 
actions like moving or closing just the torn off window 
must be done by the user's window manager.

The I<BIND TO DIRECTORY> button will activate a window 
that is separate from the main window.  

The new window contains two buttons and two text boxes. 
For security reasons nothing is initially displayed in the 
text boxes.  Pressing the accept button with this setup
will cause the bind DN and password to be set to null
strings.

At the top of the window is a Cancel button, pressing
this button will cancel the operation of setting the
bind DN and password. 

The DN text box is where the user will enter the DN
to bind with.

The PASSWORD text box is where the user will enter the password
for the DN.  Star "*" will be shown for the characters
as they are typed into the text box.  

At the bottom of the window is the Accept button, pressing
this button will set the bind DN and the password.

The I<SELECT BASE> button will activate a 
drop down menu.  From the menu the user will select the 
"RadioButton" that corresponds to the search base  the
user wishes to use in the directory search.  When selected 
the "RadioButton" diamond will turn red in color.  The 
DIRECTORY SEARCH BASE text box will display the directory 
search base that is selected.  This menu is a designed to 
be a "I<tear off>" menu, selecting the "---------------" line 
will cause the pull down menu to become a separate window 
that is still somewhat controlled by the GUI.  If the GUI
is icon-ed or exited, the tear off window will follow the
actions of the GUI.  All other actions like moving or 
closing just the torn off window must be done by the 
user's window manager.

The I<SELECT ADDITIONAL ATTRIBUTES> button will activate a 
drop down menu.  From the menu the user will select the 
"RadioButton" that corresponds to the attribute the
user wishes to use in the directory search.  When selected 
the "RadioButton" diamond will turn red in color.  This menu 
is a designed to be a "I<tear off>" menu, selecting the 
"---------------" line will cause the pull down menu to 
become a separate window that is still somewhat controlled 
by the GUI.  If the GUI is icon-ed or exited, the tear off 
window will follow the actions of the GUI.  All other 
actions like moving or closing just the torn off window 
must be done by the user's window manager.

The I<CLEAR ATTRIBUTE DATA> button will clear out the text
that appears in the Attribute Data text box.

The I<SET FILTER CONDITION> button will activate a drop down menu.  
From the menu the user will select the "RadioButton" that 
corresponds to the filter conditions the user wishes to use 
in the directory search.  When selected the "RadioButton" 
diamond will turn red in color.  This menu is a designed 
to be a "I<tear off>" menu, selecting the 
"---------------" line will cause the pull down menu to 
become a separate window that is still somewhat controlled 
by the GUI.  If the GUI is icon-ed or exited, the tear off 
window will follow the actions of the GUI.  All other 
actions like moving or closing just the torn off window 
must be done by the user's window manager.
The four filter conditions control how the search filter
will be created.  Just to the side of the I<SET FILTER CONDITION>
button is a text box that displays the filter condition
that is selected.

The I<OBTAIN ROOT DSE ENTRY> button will attempt to obtain the
root dse entry for the selected directory server.  If the root
dse entry is obtained a separate window will be displayed that 
will display the information obtained from the root dse entry.
If the root dse entry can not be obtained then an error message
window will be displayed.

The I<ATTRIBUTE DATA> text box is where the user will enter 
the data to be searched for.  The program will automatically
put the beginning and ending parenthesis around the data.
If the I<Filter> attribute is selected this is where the 
I<COMPLETE> filter is entered, the program will not modify this
string in any way.

The I<DIRECTORY PORT> button will activate a window 
that is separate from the main window.  

The new window contains two buttons and one text box. 
If the user needs to change the TCP connection port, this
is where it is done.

At the top of the window is a Cancel button, pressing
this button will cancel the operation of setting the
port number.

The text box is where the user will enter the port
number to connect. Display in the text box is the
current port number.

At the bottom of the window is the Accept button, pressing
this button will set the port number.

The I<EXPLORE DIRECTORY SCHEMA> button will activate the 
Directory Schema Search Window.  For information about
this window see the Schema section of the manual.

I<SEARCH> button.  At the bottom of the GUI is the "Search"
button.  When a mouse click is done on the "Search" button 
the program will execute a ldap search.

-------------------------------------------------------------------

=head1 Display Search Results

When the SEARCH DIRECTORY button is pressed the Search Results 
window will be displayed.

At the top of the GUI is the "Close Display Search Result Window" 
button.  When a mouse click is done on the "Close Display Search Result
Window" button the Display Search Result window will be withdrawn.  
The window is not destroyed, it just made invisible and disabled.

The Search Result window can be destroyed by enabling the proper 
window manager destroy function.

The hierarchial text box is where the results of the directory search 
will be displayed.  If there were valid results returned from the 
search a list of DN entry(s) will be displayed in the hierarchial 
list box.  Selecting a DN will cause a LDAP Action window to 
appear in which the user can select to view, rename, edit, or 
delete the corresponding DS's directory data.

-------------------------------------------------------------------

=head1 LDAP ACTION WINDOW

The LDAP Action window has 4 buttons inside of it; 

I<DISPLAY> - Will display A Directory Search Display window to 
appear with the corresponding data in it.

I<RENAME> - Will display a MODDN INFORMATION window in which the
user will input the needed information for modifing an entry's
DN.

I<DELETE> - Will cause the selected DN to be deleted from the
directory.

I<EDIT> - Will cause a Entry Edit Display window with the 
corresponding entry data in it.  It is from this window that the 
user can change directory data.  This window is discribed in 
detail later in this document.

I<CANCEL> - Will cancel the action request for the select DN.

-------------------------------------------------------------------

=head1 DIRECTORY SEARCH DISPLAY WINDOW
 
I<DIRECTORY SEARCH DISPLAY> is the window where data for the 
selected DN is displayed. Data is displayed in the read only
Directory Data text box.  Associated with the Directory Data 
text box is the "RadioButton" that determines how often the
data in the directory text box is cleared.  If the "CheckButton" 
is selected, colored red, the directory data text box will be 
cleared out before each directory query.  If the "CheckButton" 
is not selected the directory data text box will NOT be cleared 
out until the Clear Data button in clicked or the 
CLEAR DIRECTORY DATA ON EACH QUERY "RadioButton" is selected.

The Directory Data text box is where the results of the
directory search will be displayed.  With the cursor
in the Directory Data text box you have access to additional
functions when you depress the mouse "action" button.
When the "action" mouse button is depressed a small text box
with 4 additional functions will be displayed inside the
Directory Data text box.  These 4 functions are;

 File -> This function exits the window.  You can not edit
         the Directory Data text box because it is created 
         as a read only text box.

 Edit -> This function gives the user 3 additional functions;
         Copy -> I do not know what this function does.
         Select All -> Highlights/Selects all of the text in
         the Directory Data text box.
         Unselect All -> Unselects all of the text in 
         the Directory Data text box.
         Select/Unselect are used in-conjunction with the 
         Copy function.

 Search -> This function gives the user 4 additional
         functions.
         Find, Find Next, Find Previous -> These functions
         find text in the Directory Data text box.
         Replace -> This function allows you to replace the
         text that is selected.  However this is just 
         a fake replacement as you can not edit the 
         Directory Data text box because it is created 
         as a read only text box.

 View -> This function gives the user 3 additional 
         functions.
         Goto Line ->  When selected will prompt the
         user for a line number, the line number being
         the line number the user wishes to see.
         What Line ->  When selected will tell the user
         what line number the cursor is on.
         Wrap ->  When selected will prompt the user
         to choose how to do line wrapping in the 
         Directory Data text box.
  
The CLEAR DATA button will clear out the text that 
appears in the Directory Data text box.

=head2 JPEG Photo Display.

If the Tk::JPEG module is installed in the user's Perl system,
when a jpegPhoto attribute is read a separate I<JPEG PHOTO DISPLAY>
window will be display.  Inside this window will be the jpeg photo,
a list box containing the DN of the entry, and a I<CLOSE WINDOW> button.

If the Tk::JPEG module is I<NOT> installed in the user's Perl 
system, nothing will be displayed for the jpegPhoto.

-------------------------------------------------------------------

=head1 MODDN INFORMATION WINDOW

The I<RENAME> button will activate a window that is separate from 
the main window.  

The new window contains two buttons, two text boxes and one 
checkbutton. 
The text boxes are initailized with data that corresponds the
DN that was selected in the Search Results window.  It is in
these text boxes that the user will enter the data needed for the
modrdn operation to take place.

At the top of the window is a Cancel button, pressing
this button will cancel the operation of modifing the DN.

The Newrdn text box is where the user will enter the new RDN
for the selected entry.

The Newsuperior RDN text box is where the user will enter the new
superior RDN, or branch DN, for the selected entry.

At the bottom of the window is the Accept button, pressing
this button will set the new RDN and the superior RDN.

The I<DELETE OLD RDN DATA> check box controls whether the old
entry information is deleted or not deleted.  When the check box
is selected, colored red, the old entry information will be deleted.
This is the default action for this button.  
Unselecting the check box will cause the entry data to not be deleted.

-------------------------------------------------------------------

=head1 ENTRY EDIT DISPLAY Window.

It is from this window that the user can modify an entry's data.
There can only be one of these windows active at a time.
Attributes that contain I<binary> information can I<NOT> be modified
with this program.

At the top of the window is the I<CANCEL ENTRY EDIT> button.  Pressing
this button will cancel all pending data changes for this entry. It
will also cause the window to be destroyed.

At the bottom of the window is the I<CHANGE DATA> button.  Pressing
this button will cause all of the pending data changes to take
place.

Just above the I<CHANGE DATA> button is the I<ADD ATTRIBUTE> button.
Pressing this button gives the user the option of entering a new
attribute name and value so that this information can be put into
the entry.

In the middle of the window is the I<ENTRY DATA> box.  In this box
is the all of the entry's current attributes along with their data.

Each line in the box is broken up into two parts; the attribute button and
the attribute data list box. There is one attribute and data pair per
line.  Multi-valued attributes have one line per attribute value.

The first line in the I<ENTRY DATA> box will be the DN of the entry. 
This line can not be edited.

To edit an attribute, press the button that has the attributes name on
it.  This will cause a I<ATTRIBUTE MODIFICATION> window to be displayed.
This window is discribed in detail later in this documentation.

When the user has finished making changes, press the I<CHANGE DATA> button.
This will start the process of making the change(s) in the LDAP 
directory.  If any errors occur a error window will appear.  After the
error window is dismissed the I<ENTRY EDIT DISPLAY> window will still 
be active.  The user can at this point do what ever it takes to correct
the problem.

If no errors occur the I<ENTRY EDIT DISPLAY> window and the 
I<SEARCH RESULTS> windows will be destroyed.  This is due to the fact
that the data in both windows is no longer valid.  The user must 
research the LDAP directory to get the new updated information.


-------------------------------------------------------------------

=head1 ATTRIBUTE MODIFICATION Window.

It is from this window that the user can modify an attribute's data.
There can only be one of these windows active at a time.

At the top of the window is the I<CANCEL ATTRIBUTE EDIT> button.  Pressing
this button will cancel all pending data changes for this attribute. It
will also cause the window to be destroyed.

At the bottom of the window is the I<ACCEPT DATA CHANGE> button.  Pressing
this button will cause all of the current data changes to be put into
the pending data change queue.

In the middle of the window is the attribute data text box.  It is in
this text box that the user will find the current data for the attribute
the user selected.  Depending on the operation the user wants to do the 
user can change the data or leave the data as is.

Below the attribute data text box are three buttons, ADD, DELETE, and
REPLACE.  To the right of the REPLACE button is a check button that
controls operations on multi-valued attributes during REPLACE operations.


=head2 ADD operations.

If the user wishs to add a new value to an attribute; the user should
enter the new data in the attribute data text box and then press
the I<ADD> button.

=head2 DELETE operations.

If the user wishs to delete the value from an attribute; the user should
not bother the data in the attribute data text box and should press
the I<DELETE> button.

=head2 REPLACE operations.

The attribute replace operation is a little tricky depending whether the
attribute is single or multi valued.

If the user knows that the attribute is multi-valued and wants to preserve
the other attribute values the user should press the check button to the
right of the I<REPLACE> button.  Doing this will control how the add and
delete operations are staged.  The user should then enter the new data in
the attribute data text box and press the I<REPLACE> button.

If the user wishs to replace all of the values for an attribute; 
the user should enter the new data in the attribute data text box and 
press the I<REPLACE> button.


When the user done with the changes the user should press the 
I<ACCEPT DATA CHANGES> button.  This will move the data changes onto
the pending data change queue and close the window. 

-------------------------------------------------------------------

=head1 DIRECTORY DELETE CONFIRM WINDOW.

When the DELETE button is selected, before the actual deletion
takes place, a window will be displayed with a Cancel and Accept
buttons. This gives the user a fail safe in case the user selects
the DELETE button by accident.  Pressing the Cancel will cancel
the delete request, pressing the Accept button will cause the
directory entry to be deleted.

-------------------------------------------------------------------

=head1 Schema Window.

=head2 Directory Schema Search Window

This function is used to lookup schema information from a LDAP 
directory server.  The directory server to be searched is 
selected from the Directory Search window.

=head2 Directory Schema Search Window Operation

When the Explore Directory Schema button is pressed in the
Directory Search window, the Directory Schema Search window 
will be displayed on your computer.  The graphical user 
interface, GUI, has several sections to it.  

At the top of the GUI is the "Close Schema Search Window" button.  
When a mouse click is done on the "Close Schema Search Window" 
button the schema window will be destroyed.  

The Directory Schema Search window can be destroyed by 
enabling the proper window manager destroy function.

When the Write Data To File RadioButton is selected the 
LDAP Schema data will be written to the file listed 
in the text box below the RadioButton text.  Once the data 
has been written to the file a message will be written to the
DIRECTORY SCHEMA DATA text box stating that the data has been
written to a file and will list the file name. Upon 
completion of the schema dump operation the RadioButton and 
text in the file name text box will be reset.

Associated with the Directory Schema Data text box is the "CheckButton"
that determines how often the data in the directory text
box is cleared.  If the "CheckButton" is selected, colored
red, the directory data text box will be cleared out before
each directory query.  If the "CheckButton" is not selected
the directory data text box will NOT be cleared out until 
the Clear Data button in clicked or the CLEAR DIRECTORY DATA
ON EACH QUERY "CheckButton" is selected.  By default the 
CheckButton is select to clear out the data in the Directory
Schema Data text box on each query.

Associated with the Directory Schema Data text box is a series of
"CheckButtons" that determines what of the schema objects will be
displayed.  There are 9 Checkbuttons; ALL, objectClass, matchingRules,
attributeTypes, ldapsyntaxes, nameforms, ditstructurerules, 
ditcontentrules, and matchingruleuse.  If the "CheckButton" is 
selected, colored red, then schema objects of that type will be 
displayed in the Directory Schema Data text box. 
If the "CheckButton" is not selected, gray in color, then schema
objects of this type will not be displayed in the Directory Schema
Data text box.  By default the ALL CheckButton is select.

The Directory Schema Data text box is where the results of the
directory search will be displayed.  With the cursor
in the Directory Data text box you have access to additional
functions when you depress the mouse "action" button.
When the "action" mouse button is depressed a small text box
with 4 additional functions will be displayed inside the 
Directory Data text box.  These 4 functions are;

 File -> This function exits the window.  You can not edit
         the Directory Data text box because it is created 
         as a read only text box.

 Edit -> This function gives the user 3 additional functions;
         Copy -> I do not know what this function does.
         Select All -> Highlights/Selects all of the text in
         the Directory Data text box.
         Unselect All -> Unselects all of the text in 
         the Directory Data text box.
         Select/Unselect are used in-conjunction with the 
         Copy function.

 Search -> This function gives the user 4 additional
         functions.
         Find, Find Next, Find Previous -> These functions
         find text in the Directory Data text box.
         Replace -> This function allows you to replace the
         text that is selected.  However this is just 
         a fake replacement as you can not edit the 
         Directory Data text box because it is created 
         as a read only text box.

 View -> This function gives the user 3 additional 
         functions.
         Goto Line ->  When selected will prompt the
         user for a line number, the line number being
         the line number the user wishes to see.
         What Line ->  When selected will tell the user
         what line number the cursor is on.
         Wrap ->  When selected will prompt the user
         to choose how to do line wrapping in the 
         Directory Data text box.
  
The Clear Data button will clear out the text that 
appears in the Directory Schema Data text box.

The I<SHOW HIERARCHICAL OBJECTCLASS TREE> will cause one of two
windows to be displayed.  For information about these windows see 
the HIERARCHICAL OBJECTCLASS section of the manual.

At the bottom of the GUI is the "Retrieve Directory Schema" button.  
When a mouse click is done on the "Retrieve Directory Schema" 
button the script will query the directory server for schema information.

=head1 HIERARCHICAL OBJECTCLASS Window

If no directory schema data has been obtained from the selected 
directory server a error message window will be displayed stating
that no schema data is available.

If directory schema data has been obtained from the selected
directory server a separate window will be displayed.
The I<HIERARCHICAL OBJECTCLASS> window has two list boxes and 
a I<CLOSE HIERARCHICAL DISPLAY WINDOW> button.  The 
I<CLOSE HIERARCHICAL DISPLAY WINDOW> button will destroy the 
I<HIERARCHICAL OBJECTCLASS> window.  In one of the list boxes will
be a hierarchial tree of all of the objectclasses obtained from the
directory server.  Doing a mouse button select on one of the 
objects in the tree will cause information about that objectclass 
branch to be displayed in the adjacent list box.  The most superior
ojectclass will be at the top of the listing, the leaf objectclass
will be at the bottom of the listing.  Each objectclass is separated
by a dashed line.  All information about each objectclass will be 
displayed in that objectclass's section.

-------------------------------------------------------------------


=head1 REQUIREMENTS


To use this program you will need the following.


At least PERL version 5.004.  You can get a stable version of PERL
from the following URL;
   http://cpan.org/src/index.html

Perl Tk800.022 module.  You can get this from the following URL;
   ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Tk/

If you wish to display a jpegPhoto attribute then you will need the
Perl Tk-JPEG-2.014 module.  You can get this from the following URL;
   ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Tk/

Perl LDAP module.  You can get this from the following URL;
   ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Net/

Perl Convert-ASN1 module.  You can get this from the following URL;
   ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Convert/

Depending on the modules loaded in your PERL system, you may need to
load the following PERL module.

Perl Digest-MD5 module.  You can get this from the following URL;
   ftp://ftp.duke.edu/pub/CPAN/modules/by-module/MD5/

Bundled inside each PERL module is instructions on how to install the 
module into your PERL system.

-------------------------------------------------------------------

=head1 INSTALLING THE SCRIPT

Install the tklkup script anywhere you wish, I suggest 
/usr/local/bin/tklkup.

Install the dot.tklkup file in each users home directory
as .tklkup.  It is possible to use a central copy and
create a link in the user home directory to the central copy.

-------------------------------------------------------------------

Since the script is in PERL, feel free to modify it if it does not 
meet your needs.  This is one of the main reasons I did it in PERL.
If you make an addition to the code that you feel other individuals
could use let me know about it.  I may incorporate your code
into my code.

=head1 AUTHOR

Clif Harden <charden@pobox.com>
If you find any errors in the code please let me know at
charden@pobox.com.

=head1 COPYRIGHT

Copyright (c) 1999-2001 Clif Harden. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=cut


