#!/usr/bin/perl
# !/usr/local/bin/perl
#
# Copyright (c) 1999 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.13 2001/08/24 03:03:55 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.
#
#
# Revisions:
# $Log: tklkup,v $
# 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 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 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 ( $@ );

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

my %schemaHash = ();

&init_schemaHash;

$Global{'LDAP_SERVER'} = "";
$Global{'bindpw'} = "";
$Global{'binddn'} = "";
$Global{'adata'} = "";
$Global{'info'} = "";
$Global{'slist'} = 0;
$Global{'setVersion'} = 0;
$Global{'sfile'} = 0;
$Global{'fdata'} = "";
$Global{'hand'}  = 'left';
$Global{'horz'} = 200;
$Global{'vert'} = 20;
$Global{'Font'} = "7x5";
$Global{'CORE_SERVER'} = "";
$Global{'sclear'} = 0;
$Global{'limit'}  = 30;
$Global{'port'}   = 389;
$Global{'platform'} = ($^O eq 'MSWin32') ? $^O : 'unix' ;

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.
#

#
#  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; };

                     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 => $version,
                       ) 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 => 5 ) ;


$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 => 1, 
                       -offvalue => 0, -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 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 => $version,
                       ) 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

 
#
# Create Main Bind Window
#
 
sub BIND {
 
$dn_data = "";
$pw_data = "";
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 ); # 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'};
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;

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

   #
   # Get and display the oid number of the objectclass.
   #
   my $oid = $schemaHash{'schema'}->name2oid( "$_" );
   
   #
   # Get the various other items associated with
   # this attribute.
   #
   my @items = $schemaHash{'schema'}->items( "$oid" );
   foreach my $value ( @items )
   {
      next if ( $value eq 'type');

      @item = $schemaHash{'schema'}->item( $oid, $value );
      $value =~ tr/a-z/A-Z/;
      if ( @item && $item[0] eq '1' )
      {
         $list->insert("end", "\t$value\n");
         next;
      }
      if ( defined(@item) )
      {
         if ( $value eq 'MAY' || $value eq 'MUST' )
         {
         $list->insert("end", "\t$value contain:  @item\n");
         }
         else
         {
         $list->insert("end", "\t$value:  @item\n");
         }
      }                                                                    
   }

}

} # 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;
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\nname in text box below this line.   ",
          -variable =>  \$Global{'sfile'}, -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 OBJECTCLASS 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" );

}
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
 






#
#
# Search the directory for data
#
#
#

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(); }

my $version;

if ( $Global{'setVersion'} ) 
{ 
$version = 3;
}
else
{
$version = 2;
}

#
# 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 => $version,
                   ) 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;

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

if ( defined($schemaHash{'schema'}) )
{
if ( $Global{'sfile'} && defined($schemaHash{'schema'}) )
{
  #
  # write 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'} = "";
  $ldap->unbind if ( defined($ldap));
  return;
}

$ra_atts = [];
#
# Get the attributes
#
@$ra_atts = $schemaHash{'schema'}->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'}->objectclasses(); 
$schemaHash{'ocs'} = $ra_atts;
#
# Display the objectclasses
#
 
if ( $selectAll || $selectObj )
{
&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses") 
    if ( defined($schemaHash{'ocs'}) );
}

#&Hierarchial($schemaHash{'ocs'}, \%obj, \%tree, \$schemaHash{'schema'}) 
#    if ( defined($schemaHash{'ocs'}) );

#
# Get the schema matchingrules
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->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'}->matchingruleuse(); 
$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'}->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'}->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'}->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'}->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 
{
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 ( @$ocs)
{
   #
   # Get the oid number of the objectclass.
   #
   my $oid;
   undef($oid);

   $oid = $schema->name2oid( "$_" ); 
   next if ( !defined($oid) );
 
   @sup = $schema->item( $oid, 'sup' ); # objectclass superior
   @name = $schema->item( $oid, 'name' ); # objectclass name

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

}

#
# 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      => 50, 
            -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 attribute.
               #
               my @items = $schema->items( "$oid" );
               foreach my $value ( @items )
               {
                  next if ( $value eq 'type');

                  @item = $schema->item( $oid, $value );
                  $value =~ tr/a-z/A-Z/;
                  if ( @item && $item[0] eq '1' )
                  {
                     $Global{'list'}->insert("end", "$value\n");
                     next;
                  }
                  if ( defined(@item) )
                  {
                     if ( $value eq 'MAY' || $value eq 'MUST' )
                     {
                     $Global{'list'}->insert("end", "$value contain:  @item\n");
                     }
                     else
                     {
                     $Global{'list'}->insert("end", "$value:  @item\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 


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

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

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

#
# Create process Exit button
#

$displayWindow->Button(-text => "CLOSE DISPLAY SEARCH 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( -side => $Global{'hand'} );

#
# 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 => 60, -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
 
#
#
# Search the directory for data
#
#
#

sub search 
{
my $mesg;
my $error;
my $version;

if ( $Global{'setVersion'} ) 
{ 
$version = 3;
}
else
{
$version = 2;
}


my %opt = (
  'd' => 0
);

#
#
#
# Display the search results list box.
#
#
displaySearch();


if ( $display_clear ) { &display_clear(); }

#
# Parameter(s) to return
#
# Default to return everything.
#
#

my $att_wanted = [ "*", 
                   "createTimeStamp",
                   "modifyTimeStamp",
                   "creatorsName",
                   "modifiersName" ];

#
# Set Filter options.
# 
if (  $Global{'info'} eq "Filter" )
{
$match = $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 => $version,
                   ) or $error = 1;
  

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

$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;
}

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

#
# Get and print out the record attributes.
#

sub print_entry {
  my($mesg,$entry) = @_;
  my @ref;

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

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

  }
  else
  {
   
  #
  # Get a list of record attributes
  #
  
  my @attrs = sort $entry->attributes;
  my $max = 0;
  $list->insert("end", " \n");
  $list->insert("end", "-----------------------------------------------------------------------------\n");

  #
  # Get record DN
  #
  
  my $dn = $entry->dn();
  
  $list->insert("end", " \n");
  $list->insert("end", "DN:  $dn\n");
  $list->insert("end", " \n");

  #
  # 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 )
    {
      #
      # Display jpegPhoto in separate window if Tk::JPEG is used.
      #
      displayPhoto(@$attr[0], $dn ) if ( $Global{'jpeg'}) ;  
      $dstring = sprintf "%${max}s: JpegPhoto binary data is not being displayed.\n",$_,$encoded;
      $list->insert("end",  "$dstring");
      next;
    }

    if(ref($attr)) {
      foreach $a (@$attr) {
      #
      # Format data and print data into List Box
      # 
        if ( /;binary$/ )
        {
        $encoded = encode_base64($a);
        $dstring = sprintf "%${max}s: Binary data on next line(s), base64 encoded.\n%s\n\n",$_,$encoded;
        $list->insert("end",  "$dstring");
        }
        else
        {
        $dstring = sprintf "%${max}s: %s\n",$_,$a;
        $list->insert("end",  "$dstring");
        }                                                                       

#        $dstring = sprintf "%${max}s: %s\n",$_,$a;
#        $list->insert("end",  "$dstring");
      }
    }
    else {
      #
      # Format data and print data into List Box
      #
        if ( /;binary$/ )
        {
        $encoded = encode_base64($attr);
        $dstring = sprintf "%${max}s: Binary data on next line(s), base64 encoded.\n%s\n\n",$_,$encoded;
        $list->insert("end",  "$dstring");
        }
        else
        {
        $dstring = sprintf "%${max}s: %s\n",$_,$attr;
        $list->insert("end",  "$dstring");
        }                                                                       
#      $dstring = sprintf "%${max}s: %s\n",$_,$attr;
#      $list->insert("end",  "$dstring");
    }
  }
 }
}

} # End of search subroutine

#
# Display jpegPhoto in separate window if Tk::JPEG is used.
#
sub displayPhoto
{
my ($picture, $dn) = @_; 
my $jpegFile = "/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 = "(ou=*)";  #search 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 => 3,
                   ) 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 ( /^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;
my $ebutton;
my $list;
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
my $error;

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

my $version = 3;

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

my @Attributes = ( qw( namingContexts supportedLDAPVersion 
                    supportedControl supportedExtension altServer ) );
if ( !defined($root) )
{
   my $error =  "Root DSE entry could not be obtained.";
   ERROR(\$error);
}

#
# Set up the Tk windows.
#
#
 
if ( ! Exists($Global{'rootWindow'} ) )
{
  eval
     {
       $Global{'rootWindow'} = MainWindow->new();
     };
  print "$@" if ( defined($@)); }
else
{
$Global{'rootWindow'}->deiconify() if Tk::Exists($Global{'rootWindow'});
$Global{'rootWindow'}->raise() if Tk::Exists($Global{'rootWindow'});
}

$Global{'rootWindow'}->title("ROOT DSE ENTRY");
 
$Global{'rootWindow'}->geometry("+$x+$y"); 

#
# Create label box
#
 
if ( !Exists($label) )
{
$label = $Global{'rootWindow'}->Label()->pack;
}
 
#
# Create process Exit button
#
 
$ebutton = $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($ebutton ) );
 
#
# Create list box, this is where the selected objectclass data will
# be displayed.
#
 
if ( !Exists($list) )
{
$list = $Global{'rootWindow'}->Scrolled('ROText',
            -scrollbars => 'se', -width=>50, -wrap => "none",
            -font => $Global{'Font'}, -height => 10 )
            ->pack();
}
 
foreach $attr (@Attributes)
{

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

}

$ldap->unbind;

}
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 and displaying directory schema information.

=head1 SYNOPSIS


This script is used to lookup 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, and
Mandrake 6.5 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.

 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<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 
Display Search Results window will be displayed.

At the top of the window is the Close Display Search Result Window
button.  Pressing the button will 

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 Display Search Result window can be destroyed by 
enabling the proper window manager destroy function.

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 program.  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.
  

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 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 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 program.  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


