#!/usr/local/bin/perl
#
# Copyright (c) 1999 - 2003 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 2.47 2006/03/27 01:45:56 clif 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.
#
#
#
#
#----------------------------------------------------------------------------
#
use Carp;
use Data::Dumper;
use MIME::Base64;
#use Net::LDAP qw(:all);
use Net::LDAP;
use Net::LDAP::Filter;
use Net::LDAP::Util qw( ldap_explode_dn ldap_error_name ldap_error_text canonical_dn );
use Net::LDAP::Constant;
use Net::LDAP::DSML;
use Net::LDAP::LDIF;
use Getopt::Std;
use Tk;
use Tk::NoteBook;
use Tk::ErrorDialog;
use Tk::LabFrame;
use Tk::ROText;
use Tk::HList;
use Tk::Tree;
use Tk::Label;
use subs qw/ops_items/;
#
# Global variables, wish I did not have to use them
# but Tk forces me to.
#
my %Global = ();
my %Tree = ();
$Global{'jpeg'} = 1;
eval 'require Tk::JPEG';
$Global{'jpeg'} = 0 if ( $@ );
$Global{'splash'} = 1;
eval { require Tk::Splashscreen;
require Tie::Watch;
};
$Global{'splash'} = 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'} = "";
$Global{'ldap'} = undef;
$Global{'bindpw'} = "";
$Global{'binddn'} = "";
$Global{fref} = 0;
$Global{'adata'} = "";
$Global{'info'} = "";
$Global{'slist'} = 0;
$Global{'setVersion'} = 3; # 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'} = 100;
$Global{port} = 389;
$Global{nsslport} = 389;
$Global{sslport} = 636;
$Global{'platform'} = ($^O eq 'MSWin32') ? $^O : 'unix' ;
$Global{'max'} = 0;
$Global{'infoFilter'} = "equal";
$Global{'nismapname'} = 0;
$Global{'automountMapName'} = 0;
$Global{'records'} = 0;
$Global{'mwwidth'} = 600;
$Global{'mwheight'} = 520;
$Global{dirConnError} = undef();
$Global{'setSSL'} = 0;
my $sbbframe;
my $LDAP_SEARCH_BASE = "";
my $DN_BASE = "";
my @base = ();
my $base = "";
my $defaultPort = 389;
my $sepChar = "\f"; # formfeed separator
#--------------------------------------------------------
# Handle the command line parameter(s)
#--------------------------------------------------------
getopts( 'hnrd:i:' );
Usage() if ( $opt_h );
my $debug = $opt_n ? 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 {
$Global{'mainWindow'} = MainWindow->new;
$splash = $Global{'mainWindow'}->Splashscreen(-milliseconds => 0)
if ( $Global{splash} );
$splframe = $splash->LabFrame(-label => "TKLKUP SPLASH SCREEN",
-labelside => "acrosstop")
->pack() if ( $Global{splash} );
$splashList = $splframe->Listbox( -height => 2, -width => 40 )
if ( $Global{splash} );
$splashList->pack()
if ( $Global{splash} );
$splash->Splash()
if ( $Global{splash} );
$splashList->insert("0", "Reading initialization file")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
&initializeProgram; # Read the dot file.
$Global{'mainWindow'}->geometry("$Global{'mwwidth'}x$Global{'mwheight'}+$Global{'horz'}+$Global{'vert'}");
$splash->update()
if ( $Global{splash} );
&createSearchBaseWindow();
$Global{'sbWindow'}->withdraw if Tk::Exists($Global{'sbWindow'});
&initializeBases;
$splashList->insert("0", "Setting tklkup GUI.")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
$Global{'mainWindow'}->title("TKLKUP");
#
# Create the Menubar
#
$Global{'mainWindow'}->configure(-menu => $Global{'menubar'} = $Global{'mainWindow'}->Menu);
$Global{'menubar'}->cascade(-label => "Directory ~OPS",
-menuitems => ops_items);
$Global{'menubar'}->command(-label => "Set ~Bind Credentials",
-command => \&BIND );
$Global{'menubar'}->command(-label => "Set DSA ~Port",
-command => \&PORT );
$Global{'menubar'}->command(-label => "E~XIT PROGRAM",
-command => sub{exit;} );
#
# Create process Exit button
#
$mwf = $Global{'mainWindow'} -> Frame() -> pack(-side => "top");
$mwf ->Label( -text => "DIRECTORY SERVER") ->pack (-side =>"left");
$Global{'slist'} = $mwf ->Listbox( -height => 1 );
$Global{'slist'}->pack( -side => "left", -padx => 2, -pady => 5 );
$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 = $mwf -> Menubutton(-text => "SELECT SERVER",
-relief => "raised", -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "left", -pady => 2, -padx => 5 );
#
# Create a LDAP version status label
#
$Versionstatus = $mwf -> Label -> pack(-side => "left", -anchor => "center" );
if ( $Global{setVersion} == 3 )
{
$Versionstatus->configure( -text => "LDAP V3", -font => $Global{Font});
}
else
{
$Versionstatus->configure( -text => "LDAP V2", -font => $Global{Font});
}
#
# Create a SSL status label
#
$SSLstatus = $mwf -> Label -> pack(-side => "left", -anchor => "center" );
if ( $Global{setSSL} )
{
$SSLstatus->configure( -text => "SSL", -font => $Global{Font});
}
else
{
$SSLstatus->configure( -text => "NON-SSL", -font => $Global{Font});
}
#
# Create a REF status label
#
$FRstatus = $mwf -> Label -> pack(-side => "left", -anchor => "center" );
if ( $Global{fref} )
{
$FRstatus->configure( -text => "REF", -font => $Global{Font});
}
else
{
$FRstatus->configure( -text => " ", -font => $Global{Font});
}
$Global{'mainWindow'}->update();
$Global{nb} = $Global{'mainWindow'}->NoteBook()
->pack(-expand => 1, -fill => 'both');
$Global{p2} = $Global{nb}->add('SEARCH',-label => 'SEARCH');
$Global{'mainWindow'}->update();
&initializeP2;
$Global{'mainWindow'}->update();
$Global{p3} = $Global{nb}->add('SEARCH DISPLAY',-label => 'SEARCH DISPLAY');
&initializeP3;
$Global{'mainWindow'}->update();
$Global{p4} = $Global{nb}->add('SCHEMA',-label => 'SCHEMA DATA');
&initializeP4;
$Global{'mainWindow'}->update();
$Global{p5} = $Global{nb}->add('CREATE ENTRY',-label => 'CREATE ENTRY');
&initializeP5;
$Global{'mainWindow'}->update();
$Global{p1} = $Global{nb}->add('INFO',-label => 'INFO');
&initializeP1;
$splash->Destroy() if ( $Global{splash} );
$splash = undef();
$Global{schema_timer} = $Global{mainWindow}->repeat(1000, \&update_schema);
#
# Run the Main loop looking for events.
#
MainLoop;
}
sub ops_items
{
[
[ 'command', 'Explore ~Root DSE', -accelerator => "Ctrl-r", -command => \&rootDse ],
"",
[ 'command', 'Set ~SSL', -accelerator => "Ctrl-s", -command => \&setSSL ],
"",
[ 'command', 'Set ~NON-SSL', -accelerator => "Ctrl-n", -command => \&nonSSL ],
"",
[ 'command', 'Toggle ~LDAP Version', -accelerator => "Ctrl-l", -command => \&toggleVersion ],
"",
[ 'command', 'Toggle ~Follow Referral', -accelerator => "Ctrl-f", -command => \&toggleRef ],
"",
[ 'command', 'E~xit', -accelerator => "Ctrl-x", -command => sub { exit;} ],
];
}# End of subroutine ops_items
sub update_schema
{
if ( $Global{schemaServer} ne $Global{CORE_SERVER} )
{
$Global{mainWindow} -> Busy(-recurse => 1); # window is busy
$Global{schema_timer}->cancel;
if ( $Global{schemaServer} ne $Global{CORE_SERVER} )
{
$currentPanel = $Global{nb} -> raised();
$Global{nb} -> raise('INFO');
&schema;
$Global{nb} -> raise($currentPanel);
}
$Global{schemaServer} = $Global{LDAP_SERVER};
$Global{schema_timer} = $Global{mainWindow}->repeat(1000, \&update_schema);
$Global{mainWindow} -> Unbusy; # window is not busy
}
} # End of subroutine update_schema
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' } = [];
} # End of subroutine init_schemaHash
sub setSSL
{
$Global{setSSL} = 1;
$Global{port} = $Global{sslport};
$SSLstatus->configure( -text => "SSL", -font => $Global{Font});
} # End of subroutine setSSL
sub nonSSL
{
$Global{setSSL} = 0;
$Global{port} = $Global{nsslport};
$SSLstatus->configure(-text => "NON-SSL", -font => $Global{Font});
} # End of subroutine nonSSL
sub toggleVersion
{
if ( $Global{setVersion} == 2 )
{
$Global{setVersion} = 3;
$Versionstatus->configure( -text => "LDAP V3", -font => $Global{Font});
}
else
{
$Global{setVersion} = 2;
$Versionstatus->configure( -text => "LDAP V2", -font => $Global{Font});
}
} # End of subroutine toggleVersion
sub toggleRef
{
if ( $Global{fref} == 0 )
{
$Global{fref} = 1;
$FRstatus->configure( -text => "REF", -font => $Global{Font});
}
else
{
$Global{fref} = 0;
$FRstatus->configure( -text => " ", -font => $Global{Font});
}
} # End of subroutine toggleRef
sub saveLdif
{
$Global{'saveLdifck'} -> select;
$Global{'saveXmlck'} -> deselect;
} # End of subroutine saveLdif
sub saveXml
{
$Global{'saveXmlck'} -> select;
$Global{'saveLdifck'} -> deselect;
} # End of subroutine saveXml
sub initializeProgram
{
#
# Check for dot file, use it to configure program.
#
if ( $Global{'platform'} eq 'unix' )
{
$ENV{'TMP'} = "/tmp";
}
else
{
$ENV{'TMP'} = "./";
}
@dotfile = ();
push(@dotfile,$opt_i) if $opt_i;
#
# Active State Perl does not always set ENV HOME.
#
if ( !$ENV{HOME} )
{
$ENV{"HOME"} = ".";
}
if ( !$ENV{PWD} )
{
$ENV{PWD} = ".";
}
push( @dotfile, "$ENV{HOME}/.tklkup");
push( @dotfile, "$ENV{PWD}/.tklkup");
foreach (@dotfile)
{
#
# first .tklkup file found is the one that will be used.
#
if ( -e $_ && -r $_ )
{
$dotfile = $_;
last;
}
}
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: {
/^followref/i && do {
$Global{fref} = 1;
last TYPE; };
/^binddn/i && do {
$Global{binddn} = $data[1];
last TYPE; };
/^hand/i && do {
$Global{'hand'} = $data[1];
last TYPE; };
/^port/i && do {
$Global{port} = $data[1];
$Global{nsslport} = $data[1];
last TYPE; };
/^sslport/i && do {
$Global{sslport} = $data[1];
last TYPE; };
/^limit/i && do {
if (defined($data[1]) )
{
$Global{'limit'} = $data[1];
}
else
{
$Global{'limit'} = 100;
}
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; };
/^automountMapName/i && do {
$Global{'nismapname'} = 1;
last TYPE; };
/^mwwidth/i && do {
$Global{'mwwidth'} = $data[1];
last TYPE; };
/^mwheight/i && do {
$Global{'mwheight'} = $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 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
} # End of subroutine initializeProgram
sub initializeBases
{
#
# 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.
#
$error = &dirConn(); # connect and bind to the directory.
if ( !$error )
{
#
# Find the branches of the directory.
#
if ( !$error || $Global{setVersion} )
{
if ( defined($server{$server[0]}) )
{
# user defined base
my $t1 = [];
push(@$t1, getBases($Global{'LDAP_SERVER'}, $server{$server[0]}));
$ncbase =~ tr/[A-Z]/[a-z]/;
$Tree{$ncbase} = $t1;
$BASEDN{$ncbase} = $ncbase;
}
else
{
my $error = 0;
my $entry;
my $mesg;
# use root_dse to find the bases
@base = ();
$entry = $Global{ldap}->root_dse();
if ( defined($entry) )
{
my $attr = $entry->get_value('namingContexts', asref => 1);
if ( defined($attr) )
{
foreach my $ncbase ( @$attr )
{
$splashList->insert("1", "Searching $ncbase")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
my $t1 = [];
push(@$t1, getBases($Global{'LDAP_SERVER'}, $ncbase));
$ncbase =~ tr/[A-Z]/[a-z]/;
$Tree{$ncbase} = $t1;
$BASEDN{$ncbase} = $ncbase;
}
}
}
}
}
&initTree();
}
else
{
if ( defined($Global{dirConnError}) )
{
ERROR(\$Global{dirConnError});
}
else
{
ERROR($error);
}
}
@NcKeys = sort(keys(%Tree));
if ( @NcKeys )
{
$LDAP_SEARCH_BASE = $NcKeys[0];
$DN_BASE = $NcKeys[0];
}
else
{
$LDAP_SEARCH_BASE = "";
$DN_BASE = "";
}
} # End of subroutine initializeBases
#
# Initialize panel 1
#
sub initializeP1
{
$dsaframe = $Global{p1}->Frame()
->pack( -fill => "both", -side => "top" );
#
# Set up the select directory server radio buttons.
#
foreach (@server)
{
$smenu->radiobutton( -label => $_, -variable => \$Global{'LDAP_SERVER'},
-value => $_, -command => \&server, -font => $Global{'Font'} );
}
$dsads = $dsaframe ->LabFrame( -labelside => "acrosstop",
-label => "DIRECTORY SERVER") ->pack (-side =>"left");
$Global{dsadsls} = $dsads->Listbox( -height => 1 );
$Global{dsadsls}->pack( -side => "top", -padx => 2, -pady => 5 );
$Global{dsadsls}->insert("end", $Global{'LDAP_SERVER'});
$dsasb = $dsaframe ->LabFrame( -labelside => "acrosstop",
-label => "SEARCH BASE") ->pack (-side =>"left");
$Global{dsasbls} = $dsasb->Listbox( -height => 1);
$Global{dsasbls}->pack( -side => "left", -padx => 2, -pady => 5 );
$Global{dsasbls}->insert("end", $LDAP_SEARCH_BASE);
$dsapt = $dsaframe ->LabFrame( -labelside => "acrosstop",
-label => "PORT") ->pack (-side =>"left");
$Global{dsaptls} = $dsapt->Listbox( -height => 1 );
$Global{dsaptls}->pack( -side => "left", -padx => 2, -pady => 5 );
$Global{dsaptls}->insert("end", $Global{port});
$attframe = $Global{p1}->Frame()
->pack( -fill => "both", -side => "bottom");
$msgframe = $attframe->LabFrame(-label => "Process Messages",
-labelside => "acrosstop" )
->pack( -fill => "both", -side => "top", -padx => 1, -pady => 1 );
$splashList->insert("0", "Creating root dse and attribute buttons.")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
$msgbox = $msgframe ->Scrolled('Listbox', -scrollbars => 's',
-width => 50, -height => 10 );
$msgbox->pack( -side => "left" );
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
} # End of subroutine initializeP1
#
# Initialize panel 2
#
sub initializeP2
{
$tpframe = $Global{p2} ->Frame(-borderwidth => 2,-relief => "raised") ->pack(-side => "top", -fill => "x");
$bmframe = $Global{p2} ->Frame ->pack(-side => "bottom", -fill => "x");
$hlframe = $tpframe ->Frame(-borderwidth => 2,-relief => "raised") ->pack( -side => "right");
#
# Create search base list box.
#
$sbbframe = $hlframe->LabFrame(-label => "DIRECTORY SEARCH BASE",
-labelside => "acrosstop")
->pack( -side => "top", -anchor => "e");
#
# Create the Attributes and Save to frame
#
$ltframe = $tpframe ->Frame()
->pack( -side => "left", -fill => "both");
#
# Create the Attributes frame
#
$aframe = $ltframe ->LabFrame(-label => "FILTER\nATTRIBUTES",
-labelside => "acrosstop",
-relief => "raised")
->pack( -side => "top", -fill => "both");
#
# Create the Save to frame
#
$fmtframe = $ltframe ->LabFrame( -label => "SAVE FORMAT",
-labelside => "acrosstop",
-relief => "raised")
->pack( -side => "top", -fill => "both");
#
# Create a ldif Checkbutton that will set up a ldif variable
#
#
$Global{saveLdifck} = $fmtframe -> Checkbutton(
-text => "LDIF", -command => \&saveLdif,
-variable => \$Global{ldif}, -onvalue => 1,
-offvalue => 0, -font => $Global{'Font'} )
-> pack(-side => "bottom", -anchor => "w" );
$Global{saveLdifck}->select();
#
# Create a ldif Checkbutton that will set up a ldif variable
#
#
$Global{saveXmlck} = $fmtframe -> Checkbutton(
-text => "XML", -command => \&saveXml,
-variable => \$Global{xml}, -onvalue => 1,
-offvalue => 0, -font => $Global{'Font'} )
-> pack(-side => "left", -anchor => "w" );
$Global{saveXmlck} -> deselect;
$btframe = $tpframe ->Frame(-borderwidth => 2,
-relief => "raised")
->pack( -side => "left", -fill => "both");
#
# Create the search base box
#
$sbblist = $sbbframe ->Listbox( -width => 40, -font => $Global{'Font'},
-height => 1 );
$sbblist->pack(-side => $Global{hand});
$sbblist->insert("end", $LDAP_SEARCH_BASE);
$Global{dsasbls}->insert(0, $LDAP_SEARCH_BASE)
if ( $Global{dsasbls} );
#
# Create directory server search base button.
# This is the point from which the search operation
# will start from.
#
$sbmenu = $sbbframe->Button( -text => " SELECT\nBASE",
-command => \&sbHlist, -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "top", -anchor => "w",
-padx => 1, -pady => 1 )
if ( !Exists($sbmenu));
#
# Create Hierarchial DN list box, this is where the DN data
# tree will be displayed.
#
$Global{'searchHList'} = $hlframe ->Scrolled('HList',
-font => $Global{'Font'},
-scrollbars => 'se',
-width => 50,
-height => 13,
-itemtype => 'text',
-separator => $sepChar,
-selectmode => 'single',
-browsecmd => sub {
#
my $objects = shift; # get base and the dn
&ldapAction($objects);
} # End of subroutine browsecmd
); # End of Scrolled HList.
#$Global{'searchHList'}->add($LDAP_SEARCH_BASE, -text=>$LDAP_SEARCH_BASE);
$Global{'searchHList'}->pack(-side => "right");
#
# 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 => "top", -anchor => "w" );
#
# First set up the 4 main attribute 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 => "top", -anchor => 'w');
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 => "top", -anchor => "w");
if ( !$sptr ) { $rbsn->select(); } # select first attribute
++$sptr;
}
}
#
# Create radio buttons in attributes selection box.
#
#
foreach (@attribute)
{
$amenu->radiobutton( -label => $_, -variable => \$Global{'info'},
-value => $_, -font => $Global{'Font'});
} # End of foreach (@attribute)
#
# Create ldap display button
#
$Global{actionDisplay} = $btframe->Button( -text => "DISPLAY",
-command => \&ldapActionDisplay,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "top", -anchor => "w", -padx => 1, -pady => 1 )
if ( !Exists($Global{actionDisplay}));
#
# Create save to ldif button
#
$Global{actionLdif} = $btframe->Button(-text => "SAVE TO",
-command => \&ldapActionSaveToLdif,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionLdif}));
#
# Create ldap rename button
#
$Global{actionRename} = $btframe->Button( -text => "RENAME ",
-command => \&getRenameData,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "top", -anchor => "w", -padx => 1, -pady => 1 )
if ( !Exists($Global{actionRename}));
#
# Create ldap edit button
#
$Global{actionEdit} = $btframe->Button(-text => " EDIT ",
-command => \&ldapActionEdit,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionEdit}));
#
# Create ldap delete button
#
$Global{actionDelete} = $btframe->Button(-text => "DELETE ",
-command => \&questionAction,
-font => $Global{'Font'}, -borderwidth => 3,
-activeforeground => 'red')
-> pack(-side => "top", -anchor => "w", -padx => 1, -pady => 1 )
if ( !Exists($Global{actionDelete}));
#
# Create process cancel button
#
$Global{actionCancel} = $btframe->Button(-text => "CANCEL ",
-command => \&ldapActionCancel,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionCancel}));
#
# Create save all to ldif button
#
$Global{actionLdifAll} = $btframe->Button( -text => "SAVE ALL\nTO",
-command => \&ldapActionMultiSaveToLdif,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "left", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionLdifAll}));
$bmlframe = $bmframe ->LabFrame(-label => "File Name",
-labelside => "acrosstop")
->pack(-side => "bottom", -fill => "x");
#
# Create Text Entry list box.
#
$bmlframe->Entry(-textvariable => \$Global{'ldifFile'},
-width => 40 )
-> pack(-side => "left", -anchor => "w", -fill => 'x');
$splashList->insert("0", "Creating cascading search base menus.")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
#
# Create Bottom Attribute frame.
# This is where the user will enter data to be
# searched for.
#
$tframe = $bmframe->LabFrame(-label => "FILTER DATA",
-labelside => "acrosstop")
->pack( -fill => "both", -side => "bottom" , -anchor => "w");
#
# Create Text Entry list box.
#
$tframe_text = $tframe->Entry(-textvariable => \$Global{'adata'}, -width => 27 )
-> pack(-side => "left",-anchor => "w", );
$tframe_text->bind('<Key-Return>' => \&search );
#
# Create Clear Attribute Data and Search Directory buttons
#
$tframe -> Button(-text => "CLEAR FILTER DATA", -command => \&AClear,
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack( -side => "left", -anchor => "w", -pady => 2, -padx => 2 );
#
# Create get Filter selection menu button.
#
$sfcmenu = $tframe -> Menubutton(-text => "SET FILTER\nCONDITON",
-relief => "raised", -font => $Global{'Font'},
-borderwidth => 5 )
-> pack(-side => "left", -anchor => "w",
-pady => 2, -padx => 2 );
$flclist = $tframe ->Listbox( -width => 11, -height => 1 );
$flclist->pack(-side => 'top', -anchor => "w" );
$flclist->insert(0, $Global{'infoFilter'});
#
# Set up the filter type 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 );
#
# Create Search Directory button
#
$bmframe -> Button(-text => "SEARCH THE DIRECTORY",
-command => \&search,
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack( -side => "bottom", -fill => "both");
#$Global{'searchHList'}->delete('all');
$Global{actionDelete}->configure( -state => 'disable');
$Global{actionDisplay}->configure( -state => 'disable');
$Global{actionEdit}->configure( -state => 'disable');
$Global{actionRename}->configure( -state => 'disable');
$Global{actionLdif}->configure( -state => 'disable');
$Global{actionCancel}->configure( -state => 'disable');
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
} # End of subroutine initializeP2
#
# Initialize panel 3
#
sub initializeP3
{
my $cframe;
my $lframe;
my $rbclear;
#
# Create frame for clear buttons.
#
$cframe = $Global{p3}->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 = $Global{p3}->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 );
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
} # End of subroutine initializeP3
#
# Initialize panel 4
#
sub initializeP4
{
#
# Search the directory for schema data
#
my $srbclear;
my $srbfile;
my $srbfilelabel;
my $slframe;
my $ssframe;
my $sbbframe;
my $aframe;
my $tframe;
my $sbframe;
#
# Create bottom Search Directory frame
#
$sbframe = $Global{'p4'}->Frame( -borderwidth => 2,
-relief => "raised")->pack(
-fill => "both", -side => "bottom",
-padx => 2);
#
# Create Search Directory button
#
$sbframe -> Button(-text => "RETRIEVE DIRECTORY SCHEMA",
-command => \&schema, -font => $Global{'Font'}, -borderwidth => 3 )
-> pack( -fill => "both");
$srbfilelabel = $Global{'p4'}->LabFrame(-label => "SCHEMA DUMP TO FILE",
-labelside => "acrosstop")
->pack( -fill => "both", -anchor => "w", -padx => 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{'p4'}->LabFrame(-label => "DIRECTORY SCHEMA DATA",
-labelside => "acrosstop")
->pack( -fill => "both", -side => "top",
-expand => 1);
#
# Create a Clear Data Radiobutton that will execute subroutine clear
# to clear the List box before each directory query.
#
$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" );
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
} # End of subroutine initializeP4
#
# Initialize panel 5
#
sub initializeP5
{
$ldifframe = $Global{p5} ->LabFrame(-label => "LDIF FILE NAME")
->pack(-side => "top", -fill => "x");
#
# Create Text Entry list box.
#
$ldifframe->Entry(-textvariable => \$Global{'createLdifFile'},
-width => 25 )
-> pack(-fill => 'x');
#
# Create Create Ldif Entry button
#
$Global{createLdifEntry} = $ldifframe->Button(
-text => "CREATE/MODIFY ENTRY FROM LDIF FILE",
-command => \&ldapActionCreateLdifEntry,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "top", -anchor => "w", -padx => 5, -pady => 5 )
if ( !Exists($Global{createLdifEntry}));
$eframe = $Global{p5} ->Frame(-borderwidth => 2,-relief => "raised")
->pack(-side => "top", -anchor => 'e');
$cteframe = $eframe ->LabFrame(-label => "MANUALLY CREATE ENTRY")
->pack(-side => "top", -anchor => 'e');
#
# Create dn base button.
#
$dnmenu = $cteframe->Button( -text => " SELECT\nDN BASE",
-command => \&sbHlist, -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "right", -anchor => "e",
-padx => 5, -pady => 5 )
if ( !Exists($dnmenu));
#
# Create the search base box
#
$dnblist = $cteframe ->Listbox( -width => 40, -font => $Global{'Font'},
-height => 1 );
$dnblist->pack(-side => "right", -anchor => 'e', -padx => 5, -pady => 5 );
$dnblist->insert("end", $DN_BASE);
#
# create attribute action button
#
$cteframe->Button(-text => "Create The\nEntry",
-font => $Global{'Font'},
-borderwidth => 3,
-command => \&getObjectAttributes,
-relief => 'raised' ) ->pack();
} # End of subroutine initializeP5
#
# Initialize panel 5a
#
sub initializeP5a
{
my $ocs = $schemaHash{'ocs'};
my $obj = $schemaHash{'obj'};
my $tree = $schemaHash{'tree'};
my $schema = $schemaHash{'schema'};
my @tmpKeys;
my @must;
my @may;
my $colist;
$Global{ceObject} = {};
my $optr = 0;
#
# Create Hierarchial list box, this is where the objectclass data
# tree will be displayed.
#
$Global{'olist'} = $eframe->Scrolled('HList',
-font => $Global{'Font'},
-scrollbars => 'se',
-width => $Global{'max'},
-height => 20,
-itemtype => 'text',
-separator => $sepChar,
-selectmode => 'single',
-browsecmd => sub {
#
my $objects = shift;
my $oid;
my $colist;
my $ab;
#my @objectclasses = ();
my $objectclasses = [];
@$objectclasses = split(/$sepChar/,$objects);
$schema = $schemaHash{'schema'};
$colist = $Global{'colist'};
$obj = $schemaHash{'obj'};
$Global{entryData} = {};
$Global{entryData}->{objectClass} = [];
$Global{entryData}->{may} = [];
$Global{entryData}->{must} = [];
my $var = $$objectclasses[-1];
# foreach my $var (@var)
# {
if ( !(exists($Global{ceObject}->{$var})) )
{
#
# create attribute action button
#
$ab = $colist->Button(-text => $var,
-font => $Global{'Font'},
-borderwidth => 3,
-relief => 'raised' );
$Global{ceObject}->{$var} = [];
$Global{ceObject}->{$var}->[0] = $ab;
$Global{ceObject}->{$var}->[1] = $objects;
$colist->windowCreate("end", -window => $ab );
$ab->configure( -command => [ \&deleteObjectclass, \$ab, $var ] );
# position to the next row.
$colist->insert("end", "\n");
}
# }
} # End of subroutine browsecmd
) -> pack( -side => "top", -anchor => 'e')
if ( !Tk::Exists($Global{'olist'}) ) ; # End of Scrolled HList.
#
# Create a ROText Box that will contain the selected objectclass(s)
# for the new entry.
#
$Global{'colist'} = $eframe ->Scrolled('Text', -scrollbars => 'se',
-width => $Global{'max'}, -height => 20, -wrap => 'none',
-font => $Global{'Font'} )
->pack( -side => "top", -anchor => 'e' )
if ( !Tk::Exists($Global{'colist'}) ) ; # End of Scrolled HList.
#
# Create Hierarchial list box, this is where the objectclass data
# tree will be displayed.
#
#
#$Global{'colist'} = $eframe ->Listbox( -width => $Global{'max'},
# -height => 20 )
# -> pack( -side => "top", -anchor => 'e')
# if ( !Tk::Exists($Global{'colist'}) ) ; # End of Scrolled HList.
@tmpKeys = sort(keys(%$tree));
my $base;
$base = "";
#
# Create Hierarchial list box data tree,
# and display data.
#
eval{
foreach ( @tmpKeys )
{
if ( $$tree{$_} ->[0] == 0 )
{
$$tree{$_} ->[0] = 1;
$Global{'olist'}->add($_, -text=>$_); # do the base.
}
$base = $_;
$array = $$tree{$_};
$ptr = 0;
foreach my $var ( @$array )
{
if ( !$ptr )
{
$ptr = 1;
next;
}
$_ = $base . $sepChar . $var;
$Global{'olist'}->add($_, -text => $var);
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 1;
}
}
}
$Global{'olist'}->pack(-side => "right");
};
print "$@" if ( defined($@));
@tmpKeys = sort(keys(%$tree));
#
# Reset objectClass array.
#
foreach ( @tmpKeys )
{
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 0;
}
}
} # End of subroutine initializeP5a
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'});
} # End of cancel subroutine
sub deleteObjectclass
{
my ($aba, $var) = @_;
my $ab;
my $colist = $Global{colist};
$ab = $Global{ceObject}->{$var}->[0];
$ab->destroy;
delete($Global{ceObject}->{$var});
#
# if no objects, clear the ROTEXT box.
#
$Global{colist}->delete("1.0","end")
if ( !(keys(%{$Global{ceObject}})) );
}
#
# Create the Search base window to display the
# search base tree.
#
sub createSearchBaseWindow
{
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
#
# Create Main Bind Window
#
$Global{'sbWindow'} = MainWindow->new;
$Global{'sbWindow'}->title("Select Search Base");
$Global{'sbWindow'}->geometry("+$x+$y");
#
# Create process accept button
#
$Global{'sbWindow'}->Button( -text => "ACCEPT SELECTED DN", -command => \&sbaccept,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
#
# Create process cancel button
#
$Global{'sbWindow'}->Button(-text => "CANCEL BASE CHANGE",
-command => \&sbcancel,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -padx => 5, -pady => 5 ) ;
my $sbdnframe = $Global{'sbWindow'}->Frame()
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
$Global{sbtree} = $sbdnframe->Scrolled("Tree",
-width => 50,
-height => 20,
-separator => $sepChar,
-indent => 35,
-scrollbars => 'sw',
-selectmod => 'single',
-browsecmd => sub {
my $objects = shift;
my %tree = %BASEDN;
$Global{SelectedDN} = $tree{$objects};
}
)->pack(-fill => "both", -expand => 1);
sub sbcancel
{
$Global{'sbWindow'}->withdraw if Tk::Exists($Global{'sbWindow'});
} # End of cancel subroutine
sub sbaccept
{
if ( exists($Global{SelectedDN}) )
{
$LDAP_SEARCH_BASE = $Global{SelectedDN};
$DN_BASE = $LDAP_SEARCH_BASE;
$sbblist->insert(0 , $LDAP_SEARCH_BASE);
$dnblist->insert(0 , $LDAP_SEARCH_BASE);
$Global{dsasbls}->insert(0, $LDAP_SEARCH_BASE)
if ( $Global{dsasbls} );
delete($Global{SelectedDN});
$Global{'sbWindow'}->withdraw if Tk::Exists($Global{'sbWindow'});
}
} # End of sbaccept subroutine
sub sbHlist
{
if (Tk::Exists($Global{'sbWindow'}))
{
$Global{'sbWindow'}->deiconify();
$Global{mainWindow}->update;
#$Global{'sbWindow'}->raise();
$Global{mainWindow}->update;
}
else
{
&createSearchBaseWindow();
&initTree();
}
}
} # End of createSearchBaseWindow subroutine
sub initTree
{
my $onvar;
my $bvar;
my $cvar;
my $t1v;
my $t1;
my $t2;
my $t2K;
my @t2Keys;
my $path;
my $size;
my $wack;
my $nvar;
my @keys = sort(keys(%Tree));
foreach $nvar (@keys)
{
$onvar = $nvar;
$t1v = $Tree{$nvar};
# print "t1 : " ,Dumper($t1v), "\n";
$Global{sbtree}->add($nvar, -text => $nvar);
foreach $bvar (@$t1v)
{
$cvar = canonical_dn($bvar, casefold => "lower" );
$adn = $cvar;
$cvar =~ s/$nvar//;
chop($cvar) if ($cvar =~ /,$/);
# print $bvar,"\n";
# print $cvar,"\n";
$path = "$nvar" . $sepChar;
$t1 = ldap_explode_dn($cvar, casefold => "lower" );
$size = @$t1;
# print "t1 size == $size\n";
while ($size > 1)
{
$t2 = pop(@$t1);
@t2Keys = keys(%$t2);
while (@t2Keys)
{
$t2K = shift( @t2Keys);
$t2size = @t2Keys;
$path .= "$t2K=$$t2{$t2K}";
$path .= "+" if ($t2size > 0 );
}
$path .= $sepChar;
$size = @$t1;
}
# chop($path) if ( $path =~ /\|$/ );
$text = "";
$t2 = pop(@$t1);
@t2Keys = keys(%$t2);
while (@t2Keys)
{
$wack = shift(@t2Keys);
$t2size = @$t2Keys;
$text .= "$wack=$$t2{$wack}";
$text .= "+" if ($t2size > 0 );
}
$path .= $text;
# print "path == $path\n";
# print "text == $text\n";
$path = $text if ( !length($path)) ;
$BASEDN{$path} = $adn;
$Global{sbtree}->add($path, -text => $text);
}
$Global{sbtree}->setmode($onvar,'close');
$Global{sbtree}->close($onvar);
}
$Global{sbtree}->autosetmode();
} # End of subroutine initTree
sub destroyTree
{
}
#
# Get the attributes of the selected objectClasses
#
sub getObjectAttributes
{
my $oid;
my $ahash;
my $alArray;
my @objectclasses = ();
my @tmp;
my $hash = $Global{ceObject};
my @hashKeys = keys(%$hash);
foreach my $hvar ( @hashKeys)
{
@tmp = split(/$sepChar/,$Global{ceObject}->{$hvar}->[1]);
foreach my $nvar (@tmp)
{
if ( !(grep(/$nvar/,@objectclasses)) )
{
push(@objectclasses,$nvar);
}
}
}
return if (!@objectclasses); # can not create an entry with no objectclass.
#
# If this is a posixAccount or shadowAccount, automatically put
# posixAccount, shadowAccount, and account as objectclasses for
# the new entry.
#
push(@objectclasses, "posixAccount")
if ( grep(/shadowAccount/,@objectclasses) &&
!( grep(/posixAccount/,@objectclasses) ) );
push(@objectclasses, "shadowAccount")
if ( grep(/posixAccount/,@objectclasses) &&
!( grep(/shadowAccount/,@objectclasses) ) );
push(@objectclasses, "account")
if ( grep(/shadowAccount/,@objectclasses) &&
grep(/posixAccount/,@objectclasses) &&
!( grep(/account/,@objectclasses) ) );
my $schema = $schemaHash{'schema'};
$obj = $schemaHash{'obj'};
$Global{entryData} = {};
$Global{entryData}->{objectClass} = [];
$Global{entryData}->{may} = [];
$Global{entryData}->{must} = [];
foreach my $var (@objectclasses)
{
$Global{mainWindow}->update;
$oid = $$obj{$var}->[0];
#
# Get the various other items associated with
# this objectclass.
#
my $ahash = $schema->objectclass( $oid );
#
# Get the objectclass name.
#
push( @{$Global{entryData}->{objectClass}},$$ahash{'name'});
if ( $$ahash{must} )
{
$alArray = $$ahash{must};
if ( ref($alArray) eq 'ARRAY' )
{
my $aMust = $Global{entryData}->{must};
foreach my $avar ( @$alArray )
{
push(@{$Global{entryData}->{must}}, $avar )
if ( !(grep(/$avar/,@$aMust)) );
}
}
else
{
push(@{$Global{entryData}->{must}}, $alArray )
if ( !(grep(/$alArray/,@{$Global{entryData}})) );
}
}
if ( $$ahash{may} )
{
$alArray = $$ahash{may};
if ( ref($alArray) eq 'ARRAY' )
{
my $aMay = $Global{entryData}->{may};
foreach my $avar ( @$alArray )
{
push(@{$Global{entryData}->{may}}, $avar )
if ( !(grep(/$avar/,@$aMay)) );
}
}
else
{
push(@{$Global{entryData}->{may}}, $alArray )
if ( !(grep(/$alArray/,@{$Global{entryData}})) );
}
}
}
&makeTheEntry;
} # End of subroutine getObjectAttributes
#
# Search the directory for data
#
sub search
{
my $mesg;
my $error;
my %opt = (
'd' => 0
);
$Global{mainWindow} -> Busy(-recurse => 1); # window is busy
#
# Destroy the dn history list if it exists.
#
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
#
# Parameter(s) to return
#
if ( $Global{'setVersion'} == 3 )
{
#
# Default to return everything.
#
$Global{att_wanted} = [ "*",
"aci",
"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.
#
#
$Global{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.
$Global{filter} = Net::LDAP::Filter->new($match) or $error = 1;
if ( $error == 1 )
{
$error = "Bad filter $match.";
ERROR(\$error);
$Global{mainWindow} -> Unbusy; # window is busy
return;
}
if ( !defined($Global{ldap}) )
{
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$error = "search $Global{dirConnError}";
ERROR(\$error);
}
else
{
ERROR($error);
}
$Global{mainWindow} -> Unbusy; # window is busy
return;
}
}
#
# Display the DN search results list box.
#
$msgbox->delete("0.0", "end");
$msgbox->update;
$Global{'records'} = 0; # initialize record count.
$Global{'searchResults'} = {}; # initialize results hash.
$mesg = $Global{ldap}->search(
base => $LDAP_SEARCH_BASE,
filter => $Global{filter},
attrs => $Global{att_wanted},
callback => \&print_entry,
);
if ( $mesg->code && $mesg->code != 48 )
{
ERROR($mesg->code);
}
#
# 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 . $sepChar . $$var[0]; # create new leaf
$Global{'searchHList'}->add($shbase, -text => $$var[0]); # add leaf to tree.
}
$Global{'searchHList'}->pack(-side => "right");
}; # End of eval
ERROR( \$@ ) if ( $@ );
#
# 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) )
{
return;
}
$dn = $entry->dn; # store the entry dn
++$Global{'records'};
$msgbox->delete("0.0", "end")
if ( !($Global{'records'} % 10 ));
$msgbox->update if ( !($Global{'records'} % 10 ));
$msgbox->insert("0.0", "Entries found: $Global{'records'}")
if ( !($Global{'records'} % 10 ));
$msgbox->update if ( !($Global{'records'} % 10 ));
#
#
#
@ref = $mesg->referrals();
if ( @ref )
{
foreach (@ref )
{
my $rvar = "LDAP Referral: $_";
ERROR(\$rvar);
}
}
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);
my $attr = [];
@$attr = $entry->get_value($_);
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;
}
$Global{mainWindow} -> Unbusy; # window is not busy
} # End of search subroutine
sub AClear {
#
# Clear out text in Attribute Box
#
$Global{'adata'} = "";
} # End of AClear subroutine
#
# Change to a new directory server.
#
sub server
{
my $widget;
my $ptr;
my $mesg;
my $error;
$error = 0;
$currentPanel = $Global{nb} -> raised();
$Global{nb} -> raise('INFO');
$Global{ldap}->unbind if ( defined($Global{ldap}) );
$Global{ldap} = undef if ( defined($Global{ldap}) );
#
# Put directory server name in list box
#
$Global{'slist'}->insert(0 , $Global{'LDAP_SERVER'});
$sslist->insert(0 , $Global{'LDAP_SERVER'}) if ( Exists($sslist) ) ;
$Global{dsadsls}->insert(0, $Global{'LDAP_SERVER'})
if ( $Global{dsadsls} );
#
# Destroy the dn history list if it exists.
#
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
$Global{mainWindow} -> Busy(-recurse => 1); # window is busy
$Global{mainWindow} -> update; # Allow Tk to update
$ptr = 1;
%Tree = (); # Delete the old stuff.
%BASEDN = (); # Delete the old stuff.
@NcKeys = (); # Delete the old stuff.
$Global{'sbtree'}->delete("all");
$msgbox->delete("0.0", "end");
$msgbox->update();
$error = dirConn();
if ( !$error )
{
if ( $Global{'CORE_SERVER'} ne $Global{'LDAP_SERVER'} && defined($server{$Global{'LDAP_SERVER'}} ) )
{
# user defined base
my $t1 = [];
push(@$t1, getBases($Global{'LDAP_SERVER'}, $server{$Global{'LDAP_SERVER'}}));
$ncbase =~ tr/[A-Z]/[a-z]/;
$Tree{$ncbase} = $t1;
$BASEDN{$ncbase} = $ncbase;
}
elsif ( $Global{setVersion} == 3 )
{
my $entry;
# use root_dse to find the bases
$entry = $Global{ldap}->root_dse();
if ( defined($entry) )
{
my $attr = $entry->get_value('namingContexts', asref => 1);
if ( defined($attr) )
{
foreach my $ncbase ( @$attr )
{
$Global{mainWindow}->update;
my $t1 = [];
push(@$t1, getBases($Global{'LDAP_SERVER'}, $ncbase));
$ncbase =~ tr/[A-Z]/[a-z]/;
$Tree{$ncbase} = $t1;
$BASEDN{$ncbase} = $ncbase;
}
}
}
}
#
# Create the search base tree
#
&initTree();
@NcKeys = sort(keys(%Tree));
}
else
{
if ( defined($Global{dirConnError}) )
{
ERROR(\$Global{dirConnError});
$msgbox->insert("1", "$Global{dirConnError}");
$msgbox->update;
}
else
{
ERROR($error);
}
}
if ( @NcKeys)
{
$LDAP_SEARCH_BASE = shift (@NcKeys);
$DN_BASE = $LDAP_SEARCH_BASE;
}
else
{
$LDAP_SEARCH_BASE = "";
$DN_BASE = "";
}
$sbblist->insert(0 , $LDAP_SEARCH_BASE);
$dnblist->insert(0 , $LDAP_SEARCH_BASE);
$Global{dsasbls}->insert(0, $LDAP_SEARCH_BASE)
if ( $Global{dsasbls} );
$Global{'CORE_SERVER'} = $Global{'LDAP_SERVER'};
$Global{mainWindow} -> update; #
$Global{mainWindow} -> Unbusy; # window is not busy
$Global{nb} -> raise($currentPanel);
} # End of server subroutine
sub base {
#
# Put directory server search base into the list box.
#
$sbblist->insert(0 , $LDAP_SEARCH_BASE);
$Global{dsasbls}->insert(0, $LDAP_SEARCH_BASE)
if ( $Global{dsasbls} );
} # End of base subroutine
sub dnbase {
# Put dn base into the list box.
$dnblist->insert(0 , $DN_BASE);
} # End of dnbase subroutine
sub setFilter {
#
# Put search filter conditions into the list box.
#
$flclist->insert(0 , $Global{'infoFilter'});
} # End of setFilter subroutine
#
# Make the correction and bind to the directory server.
#
sub dirConn
{
my $error;
$error = 0;
$Global{dirConnError} = undef();
#
# Make the connection to the directory server
#
if ( $Global{port} == 636 || $Global{'setSSL'} )
{
$bindcommand = 'require Net::LDAPS; new Net::LDAPS( $Global{LDAP_SERVER}, timeout => 1, port => $Global{port}, debug => $opt{d} ) ';
if ( $Global{'platform'} eq 'MSWin32')
{
$error = "This program currently does not support SSL on Microsoft Windows systems.";
ERROR(\$error);
return 1;
}
$Global{ldap} = eval $bindcommand;
if ($@)
{
$msgbox->insert("0.0", $@) if ($@ && Tk::Exists($msgbox)) ;
return -1;
}
if ( !($Global{ldap}->isa('Net::LDAPS') ) )
{
$Global{dirConnError} = "LDAPS connection error to $Global{'LDAP_SERVER'}.";
return -1;
}
}
else
{
$Global{ldap} = new Net::LDAP( $Global{'LDAP_SERVER'},
timeout => 1,
port => $Global{port},
debug => $opt_d,
) or $error = 1;
if ( $error )
{
$Global{dirConnError} = "LDAP connection error to $Global{'LDAP_SERVER'}.";
return 1;
}
}
$mesg = $Global{ldap}->bind( password => "$Global{'bindpw'}",
dn => "$Global{'binddn'}",
version => $Global{'setVersion'},
);
if ( $mesg->code && $mesg->code != 48 )
{
# $errstr = $mesg->code;
# ERROR($errstr);
return $mesg->code;
}
return 0;
} # End of subroutine dirConn
#
# Connect and bind to the referral directory server
#
sub dirRConn
{
my ($url) = @_;
my $error;
$error = 0;
$Global{dirConnError} = undef();
#
# Make the connection to the directory server
#
if ( $Global{port} == 636 || $Global{'setSSL'} )
{
$bindcommand = 'require Net::LDAPS; new Net::LDAPS( $url, timeout => 1, debug => $opt{d} ) ';
if ( $Global{'platform'} eq 'MSWin32')
{
$error = "This program currently does not support SSL on Microsoft Windows systems.";
ERROR(\$error);
return 1;
}
$Global{rldap} = eval $bindcommand;
if ($@)
{
$msgbox->insert("0.0", $@) if ($@ && Tk::Exists($msgbox)) ;
return -1;
}
if ( !($Global{rldap}->isa('Net::LDAPS') ) )
{
$Global{dirConnError} = "LDAPS connection error to $url.";
return -1;
}
}
else
{
$Global{rldap} = new Net::LDAP( $url,
timeout => 1,
debug => $opt_d,
) or $error = 1;
if ( $error )
{
$Global{dirConnError} = "LDAP connection error to $url.";
return 1;
}
}
$mesg = $Global{rldap}->bind( password => "$Global{'bindpw'}",
dn => "$Global{'binddn'}",
version => $Global{'setVersion'},
);
if ( $mesg->code && $mesg->code != 48 )
{
# $errstr = $mesg->code;
# ERROR($errstr);
return $mesg->code;
}
return 0;
} # End of subroutine dirRConn
#
# Disconnect from the directory server.
#
sub dirRUConn
{
$Global{rldap}->disconnect;
delete($Global{rldap});
return 0;
} # End of subroutine dirRUConn
#
# Detect and record the sub-bases, or branches, of the directory.
#
sub getBases()
{
my $mesg;
my ( $host, $base ) = @_;
my @base = ();
my $ptr;
my $match;
my $error = 0; # initialize error flag.
if ( $Global{'nismapname'} )
{
#
# Solaris Native LDAP enabled
#
#$match = "(|(ou=*)(nismapname=*)(objectClass=organizationalUnit))"; #search only for ou entries.
$match = "(|(objectClass=nisMap)(objectClass=organizationalUnit)(objectClass=automountMap))"; #search only for ou entries.
}
else
{
$match = "(objectClass=organizationalUnit)"; #search only for ou entries.
}
my $f = Net::LDAP::Filter->new($match) or $error = 1;
if ( $error )
{
$error = "getBases subroutine Bad filter $match";
ERROR(\$error);
return @base;
}
$base[0] = $base;
$ptr = 0;
while ( $ptr < @base )
{
if ( @base < $Global{'limit'} )
{
$splashList->insert("1", "Searching $base")
if ( defined( $splash) );
$splash->update()
if ( defined( $splash) );
$msgbox->insert("0", "Searching $base")
if ( defined( $msgbox) );
$msgbox->update()
if ( defined( $msgbox) );
my @new_base = calBase($base, $f );
push(@base, @new_base);
}
$base = $base[++$ptr];
}
shift(@base); # get rid of the namingContext entry
return @base;
} # End of subroutine getBases()
sub calBase()
{
my ( $base, $f ) = @_;
my $mesg;
my $entry;
my $errstr;
my $error = 0;
my @new_base = ();
$mesg = $Global{ldap}->search(
base => $base,
filter => $f,
attrs => [ "cn","nismapname","automountMapName" ],
scope => "one",
);
#
# Check for an error on search
# Search call work, but there was an ldap error.
#
if ( $mesg->code && $mesg->code != 11 )
{
$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 = canonical_dn($dn,casefold => "lower");
$dn =~ tr/[A-Z]/[a-z]/;
$_ = $dn;
#
# Record only dn that start with ou=, or in some cases nismapname.
# Normal entrys can be mixed in with these objects.
#
if ( $Global{'nismapname'} && ( /^ou=/ || /^nismapname/i || /^automountMapName/i ) )
{
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()
#
# Determine new mainWindow position.
#
sub globalPos
{
my @pos;
@pos = split(/\+/,$Global{'mainWindow'}->geometry());
$Global{'horz'} = $pos[1];
$Global{'vert'} = $pos[2];
} # End of subrountine globalPos
sub root_cancel
{
$Global{'rootWindow'}->destroy if Tk::Exists($Global{'rootWindow'});
} # End of subrountine root_cancel
#
# 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
#
# 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") if ( !ref($errcode) );
$errlist->insert("end", "") if ( !ref($errcode) );
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
#
# LDAP Error check, some return codes are not really errors.
# You can retry the ldap action after waiting a while.
#
sub CheckError {
my ( $error ) = @_;
#
# Check for DSA busy or internal error
#
if ( $Global{loopCount} > 61 ) {
return 0; # return an error condition.
}
++$Global{loopCount}; # Increment the loop counter.
if ( $error =~ /too busy/ ||
$error =~ /Server encountered an internal error/ )
{
#
# DSA Busy.
#
sleep 1;
return 1; # No error, try again
}
else {
#
# DSA did not return "DSA busy" message
#
return 0; # error
}
} # End of subrountine CheckError
#
# Create Main Bind Window
#
sub BIND {
$dn_data = "";
$pw_data = "";
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
if ( !Tk::Exists( $Global{'bindWindow'} ) )
{
#
# Create Main Bind Window
#
$Global{'bindWindow'} = MainWindow->new;
$Global{'bindWindow'}->title("SET BIND CREDENTIALS");
$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.
#
$dn_data = $Global{binddn} if ( length($Global{binddn}) );
$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.
#
$bindpwdata = $bindpwframe->Entry(-show => '*', -textvariable => \$pw_data,
-width => 25, -font => $Global{'Font'} )
-> pack(-fill => 'x');
$bindpwdata->bind('<Key-Return>' => \&accept );
sub cancel{
$Global{'bindWindow'}->destroy() if Tk::Exists($Global{'bindWindow'});
$Global{'bindWindow'} = undef();
} # End of cancel subroutine
sub accept{
my $mesg;
if (defined($Global{ldap}) )
{
#
# Connect to directory server
#
$mesg = $Global{ldap}->bind( password => "$pw_data",
dn => "$dn_data",
version => $Global{'setVersion'},
);
if ( $mesg->code && $mesg->code != 48 )
{
$errstr = $mesg->code;
ERROR($errstr);
}
else
{
$Global{'bindWindow'}->Busy(-recurse => 1);
$Global{'binddn'} = $dn_data;
$Global{'bindpw'} = $pw_data;
&server;
$Global{'bindWindow'}->Unbusy;
}
}
$Global{'bindWindow'}->destroy() if Tk::Exists($Global{'bindWindow'});
$Global{'bindWindow'} = undef();
} # End of accept subroutine
}
} # End of BIND 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 ) ;
$Global{'portWindow'}->Label(-text => "Port 389 default")
->pack( -side => "top", -anchor => 'w', -pady => 1 );
$Global{'portWindow'}->Label(-text => "Port 636 ssl default")
->pack( -side => "top", -anchor => 'w', -pady => 1 );
#
# Create a ssl Checkbutton that will set up ssl variable
# to set ssl if not port 636.
#
#$Global{'portWindow'} -> Checkbutton(
# -text => "SSL connection",
# -variable => \$Global{'setSSL'},
# -font => $Global{'Font'} )
# -> pack(-side => "top", -anchor => "w" );
$PSSLstatus = $Global{'portWindow'} -> Label -> pack(-side => "top", -anchor => "w" );
if ( $Global{setSSL} )
{
$PSSLstatus->configure( -text => "SSL", -font => $Global{Font});
}
else
{
$PSSLstatus->configure(-text => "NON-SSL", -font => $Global{Font});
}
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;
if ( $Global{setSSL} ) { $Global{sslport} = $port_data;}
else { $Global{nsslport} = $port_data;}
$Global{dsaptls}->insert(0, $Global{port});
$Global{'portWindow'}->destroy() if Tk::Exists($Global{'portWindow'});
$Global{'portWindow'} = undef();
} # End of accept subroutine
} # End of PORT 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");
}
}
}
}
} # End of subroutine print_loop
sub schema_clear {
#
# Clear out text in List Box
#
$schema_list->delete("1.0", "end");
} # End of clear subroutine
#
#
# Get the directory schema
#
sub schema
{
my $mesg;
my $error = 0;
$schemaHash{'obj'} = {};
$schemaHash{'tree'} = {};
$msgbox->insert("0.0", "Retrieving schema information.");
$msgbox->update;
&schema_clear();
$Global{'max'} = 0; # Reset objectclass name lenght.
my $dt = "/tmp/schema.dat.$$";
if ( ! defined($Global{ldap}) )
{
#
# Connect to directory server
#
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$schema_list->insert("end", "$Global{dirConnError}\n");
}
else
{
ERROR($error);
}
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'} = $Global{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'});
$dsml->end_dsml;
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;
return;
}
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
$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'}) );
}
$Global{'max'} = 50 if ( $Global{'max'} > 50 );
&objTree(); # Create the objectClass tree
$Global{'olist'}->delete('all') if Tk::Exists($Global{'olist'});
$Global{mainWindow} -> update; # Allow Tk to update
&initializeP5a(); # Finish making panel 5
} # 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");
}
} # End of schema subroutine
sub objTree
{
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);
$oid = $$aobj{'oid'};
next if ( !defined($oid) );
@sup = $$aobj{'sup'}[0];
@name = $$aobj{'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 . $sepChar . $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"];
}
}
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
}
sub Hierarchial
{
&globalPos();
my $x = $Global{'horz'};
my $y = $Global{'vert'} + 200 ;
my $ocs = $schemaHash{'ocs'};
my $obj = $schemaHash{'obj'};
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;
#
# Set up the Tk windows.
#
#
if ( ! Exists($Global{'histWindow'} ) )
{
eval
{
$Global{'histWindow'} = MainWindow->new();
$Global{'histWindow'}->title("HIERARCHICAL OBJECTCLASS DISPLAY WINDOW");
};
ERROR(\$@) if ( $@ );
}
else
{
my $wstate = $Global{'histWindow'}->state();
if ( $wstate =~ /iconic/ || $wstate =~ /withdrawn/ )
{
$Global{'histWindow'}->deiconify()
if Tk::Exists($Global{'histWindow'});
$Global{'histWindow'}->raise()
if Tk::Exists($Global{'histWindow'});
}
}
$Global{'histWindow'}->geometry("+$x+$y");
#
# Create label box
#
if ( !Exists($Global{'label'}) )
{
$Global{'label'} = $Global{'histWindow'}->Label()->pack;
}
$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.
#
if ( !Exists($Global{'hlist'}) )
{
$Global{'hlist'} = $Global{'histWindow'}->Scrolled('HList',
-font => $Global{'Font'},
-scrollbars => 'se',
-width => $Global{'max'},
-height => 20,
-itemtype => 'text',
-separator => $sepChar,
-selectmode => 'single',
-browsecmd => sub {
#
my $objects = shift;
my $oid;
my @objectclasses = ();
@objectclasses = split(/$sepChar/,$objects);
$Global{'list'}->delete("1.0", "end");
$Global{'label'}->configure(-text=>$objects);
$Global{'list'}->insert("end", " \n");
foreach my $var (@objectclasses)
{
$Global{mainWindow}->update;
$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 )
{
if ( $$tree{$_} ->[0] == 0 )
{
$$tree{$_} ->[0] = 1;
$Global{'hlist'}->add($_, -text=>$_); # do the base.
}
$base = $_;
$array = $$tree{$_};
$ptr = 0;
foreach my $var ( @$array )
{
if ( !$ptr )
{
$ptr = 1;
next;
}
$_ = $base . $sepChar . $var;
$Global{'hlist'}->add($_, -text => $var);
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 1;
}
}
}
$Global{'hlist'}->pack(-side => "right");
};
print "$@" if ( defined($@));
@tmpKeys = sort(keys(%$tree));
#
# Reset objectClass array.
#
foreach ( @tmpKeys )
{
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 0;
}
}
}
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'});
} # 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("CONFIRM DECISION");
$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;
$Global{actionDelete}->configure( -state => 'normal');
$Global{actionDisplay}->configure( -state => 'normal');
$Global{actionEdit}->configure( -state => 'normal');
$Global{actionRename}->configure( -state => 'normal');
$Global{actionLdif}->configure( -state => 'normal');
$Global{actionCancel}->configure( -state => 'normal');
} # End of ldapAction subroutine
sub ldapActionCancel{
delete($Global{'ldapActionDN'});
$Global{actionDelete}->configure( -state => 'disable');
$Global{actionDisplay}->configure( -state => 'disable');
$Global{actionEdit}->configure( -state => 'disable');
$Global{actionRename}->configure( -state => 'disable');
$Global{actionLdif}->configure( -state => 'disable');
$Global{actionCancel}->configure( -state => 'disable');
} # End of cancel subroutine
sub ldapActionCreateEntry
{
if ( !Exists($Global{'olist'}) )
{
&initializeP5a(); # Finish making panel 5
}
} # End of subroutine ldapActionCreateEntry
sub makeTheEntry
{
&globalPos();
my $x = $Global{'horz'} + 100;
my $y = $Global{'vert'} + 100;
%Creation = ();
#
# Create Main Window
#
if (! Exists($Global{'createWindow'}) )
{
$Global{'createWindow'} = MainWindow->new;
$Global{'createWindow'}->title("CREATE DIRECTORY ENTRY");
$Global{'createWindow'}->geometry("+$x+$y");
#
# Create process Exit button
#
$createExit = $Global{'createWindow'}->Button(
-text => "CANCEL CREATE ENTRY DISPLAY",
-command => \&create_cancel, -font => $Global{'Font'},
-borderwidth => 5 )
-> pack(-fill => "both", -padx => 2, -pady => 2 ) ;
$Global{'createWindow'}->Label( -text => "Select a radiobutton to indicate the Naming Attribute and make sure your dn base is correct.")
->pack(-side => "top", -anchor => 'w');
$Global{'createWindow'}->Label( -text => "All attributes in red, or located above the objectClass attributes, must have data")
->pack(-side => "top", -anchor => 'w');
$Global{'createWindow'}->Label(-text => "entered for the attribute.")
->pack(-side => "top", -anchor => 'w');
#
# Create a ROText Box that will actually contain the
# returned directory data.
#
$createlist = $Global{'createWindow'} ->Scrolled('ROText',
-scrollbars => 'se',
-width => 100, -height => 20, -wrap => 'none',
-font => $Global{'Font'} );
$createlist->pack(-fill => "both", -expand => 1 );
$max = 0;
foreach ( @{$Global{entryData}->{must}} )
{
$max = length($_) if ( length($_) > $max );
}
foreach ( @{$Global{entryData}->{may}} )
{
$max = length($_) if ( length($_) > $max );
}
$Creation{dn} = [];
$Creation{dn}->[0] = "$DN_BASE";
$dnLabel = $createlist->Label(-text => "dn",
-font => $Global{'Font'},
-relief => 'groove',
-anchor => 'e',
# -foreground => 'red',
-width => ($max+7) );
$createlist->windowCreate("end", -window => $dnLabel );
$dnTxt = $createlist->Entry(-width => 65,
-textvariable => \$Creation{dn}->[0] );
$createlist->windowCreate("end", -window => $dnTxt );
$createlist->insert("end", "\n"); # position to the next row.
#
# create attribute label
#
#$tmpdn = "";
foreach ( @{$Global{entryData}->{must}} )
{
$Creation{$_} = [] if ( !/objectClass/ );
$Creation{$_}->[0] = "" if ( !/objectClass/ );
$NamingAttribute = "";
${$_} = $createlist->Radiobutton( -text => "", -anchor => 'w',
-variable => \$NamingAttribute, -value => "$_" )
if ( !/objectClass/ );
$createlist->windowCreate("end", -window => ${$_} );
${$_} = $createlist->Label(-text => "$_",
-font => $Global{'Font'},
-relief => 'groove',
-foreground => 'red',
-anchor => 'e',
-width => ($max+2) ) if ( !/objectClass/ );
$createlist->windowCreate("end", -window => ${$_} );
#
# create data entry window
#
${$_} = $createlist->Entry(-width => 65,
-textvariable => \$Creation{$_}->[0] )
if ( !/objectClass/ );
$createlist->windowCreate("end", -window => ${$_} ) if ( !/objectClass/ );
$createlist->insert("end", "\n") if ( !/objectClass/ );
}
$ptr = 0;
$Creation{objectClass} = [];
foreach ( @{$Global{entryData}->{objectClass}} )
{
$Creation{objectClass}->[$ptr] = "$_";
${$_} = $createlist->Label(-text => "objectClass",
-font => $Global{'Font'},
-relief => 'groove',
-anchor => 'e',
-width => ($max+7) );
$createlist->windowCreate("end", -window => ${$_} );
#
# create data entry window
#
${$_} = $createlist->Label(-width => 65, -anchor => 'w',
-text => $Creation{objectClass}->[$ptr]);
$createlist->windowCreate("end", -window => ${$_} );
$createlist->insert("end", "\n"); # position to the next row.
++$ptr;
}
$Global{'createWindow'} ->update;
foreach ( @{$Global{entryData}->{may}} )
{
$Creation{$_} = [];
$Creation{$_}->[0] = "";
${$_} = $createlist->Radiobutton( -text => "", -anchor => 'w',
-variable => \$NamingAttribute, -value => "$_" )
if ( !/objectClass/ );
$createlist->windowCreate("end", -window => ${$_} );
${$_} = $createlist->Label(-text => "$_",
-font => $Global{'Font'},
-relief => 'groove',
-anchor => 'e',
-width => ($max+2) )if ( !/objectClass/ );
$createlist->windowCreate("end", -window => ${$_} );
#
# create data entry window
#
${$_} = $createlist->Entry(-width => 65,
-textvariable => \$Creation{$_}->[0] );
$createlist->windowCreate("end", -window => ${$_} );
$createlist->insert("end", "\n"); # position to the next row.
}
#
# Create the Create button
#
$createMe = $Global{'createWindow'}->Button(
-text => "CREATE ENTRY",
-command => \&create_entry, -font => $Global{'Font'},
-borderwidth => 5 )
-> pack(-fill => "both", -padx => 2, -pady => 2 ) ;
}
} # End of subroutine makeTheEntry
sub create_cancel
{
$Global{ceObject} = undef();
$Global{colist}->delete("1.0","end");
$Global{'createWindow'}->destroy if Tk::Exists($Global{'createWindow'});
$Global{'createWindow'} = undef();
} # End of create_cancel subroutine
sub create_entry
{
my $error;
my $do_it;
my @add = ();
my $mesg;
my $rmesg;
my $DN;
push(@add, 'objectClass');
push(@add, $Creation{objectClass});
delete($Creation{objectClass});
if ( length($NamingAttribute) )
{
$DN = "$NamingAttribute=". $Creation{$NamingAttribute}[0] . "," . $Creation{dn}[0];
}
else
{
$DN = $Creation{dn}[0];
}
delete($Creation{dn});
my @attrs = keys( %Creation );
foreach $att ( @attrs )
{
if ( length($Creation{$att}->[0]) )
{
push(@add, $att);
push(@add, $Creation{$att});
}
}
$Global{ldap}->unbind if ( defined($Global{ldap}) );
$Global{ldap} = undef if ( defined($Global{ldap}) );
$error = 0;
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$error = "Create Entry $Global{dirConnError}";
ERROR(\$error);
}
else
{
ERROR($error);
}
# %Creation = ();
# &create_cancel;
return;
}
$do_it = 1;
$Global{loopCount} = 0;
while ($do_it == 1 )
{
$mesg = $Global{ldap}->add($DN, attrs => \@add );
if ( $mesg->code )
{
if ( $mesg->code == 10 && $Global{fref} )
{
#
# Being refer'ed to another directory server.
#
@referral = $mesg->referrals();
foreach my $rref (@referral )
{
print "LDAP Referral: $rref \n" if $debug;
$rresult = &dirRConn($rref);
if ( $rresult != 0 )
{
print "Referral connect error, trying next now\n" if ( $debug );
next;
}
else
{
$rmesg = $Global{rldap}->add($DN, attrs => \@add );
if ( !$rmesg->code )
{
&dirRUConn();
$do_it = 0;
last;
}
}
} # End of foreach my $rref (@ref )
if ( $do_it )
{
#
# All referrals have been tried, there is a major error.
#
&dirRUConn();
$errstr = "There has been a major referral error creating this DN.";
$errstr .= "The following referrals were tried;\n";
foreach my $rref (@referral )
{
$errstr .= "$rref\n";
}
ERROR($errstr);
return;
} # End of if ( $do_it )
}
else
{
#
# There was an error, check for dsa busy
# error.
#
#
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
#
# Check for server busy.
#
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
}
else
{
#
# There was no error
#
$do_it = 0;
}
}
%Creation = ();
&create_cancel;
} # End of subroutine create_entry
#
# 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'} )
{
&ldapActionCancel;
return;
}
my $objects = $Global{'ldapActionDN'};
&ldapActionCancel;
#
# Display the DN search results list box.
#
$Global{nb}->raise("SEARCH DISPLAY");
delete($Global{'ldapActionDN'});
# 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(/$sepChar/,$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'} )
{
&ldapActionCancel();
return;
}
my $objects = $Global{'ldapActionDN'};
&ldapActionCancel();
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(/$sepChar/,$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
#
my $sptr = 0;
foreach my $var (@infoKeys)
{
$$Global{'multi'}[$sptr] = 0;
$text = sprintf "%${max}s",$var;
my $values = $$info{$var}; # get attribute data array.
$$Global{'multi'}[$sptr] = 1 if (@$values > 1);
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, $sptr ] );
# position to the next row.
$elist->insert("end", "\n");
}
++$sptr;
}
$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, $mv ) = @_;
#
# 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,
-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 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, $mv],
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack(-side => $Global{'hand'},
-padx => 2, -pady => 2 ) ;
$Global{'multi'} = [];
}
}
else { return; }
sub delete_data {
my ( $attr, $Value ) = @_;
#
#
#
$Global{'tmpDELETE'}{$$attr} = $$Value;
} # End of delete_data subroutine
sub replace_data {
my ( $attr, $Value, $tbox,$mv ) = @_;
#
# Replace this attributes value.
# But what if this is a multi-valued attribute.
#
if ( $$Global{'multi'}[$mv] )
{
#
# 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');
}
else
{
$Global{'tmpREPLACE'}{$$attr} = $$tbox->get('1.0','1.end');
}
} # 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{'multi'} = [];
$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 $mesg;
my $rmesg;
my @DNs;
my $do_it;
my $okay;
my @referral;
my $rresult;
if ( !$Global{'ldapActionDN'} )
{
&ldapActionCancel();
return;
}
my $objects = $Global{'ldapActionDN'};
&ldapActionCancel();
@DNs = split(/$sepChar/,$objects); # split base from dn.
$error = 0;
if ( !defined($Global{ldap}) )
{
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$error = "ldapActionDelete $Global{dirConnError}";
ERROR(\$error);
}
else
{
ERROR($error);
}
return;
}
}
$do_it = 1;
$Global{loopCount} = 0;
$okay = 0;
while ($do_it == 1 )
{
$mesg = $Global{ldap}->delete($DNs[1]);
if ( $mesg->code )
{
if ( $mesg->code == 10 && $Global{fref} )
{
#
# Being refer'ed to another directory server.
#
@referral = $mesg->referrals();
foreach my $rref (@referral )
{
print "LDAP Referral: $rref \n" if $debug;
$rresult = &dirRConn($rref);
if ( $rresult != 0 )
{
print "Referral connect error, trying next now\n" if ( $debug );
next;
}
else
{
$rmesg = $Global{rldap}->delete($DNs[1]);
if ( !$rmesg->code )
{
&dirRUConn();
$do_it = 0;
last;
}
}
} # End of foreach my $rref (@ref )
if ( $do_it )
{
#
# All referrals have been tried, there is a major error.
#
&dirRUConn();
$errstr = "There has been a major referral error deleteing this DN.";
$errstr .= "The following referrals were tried;\n";
foreach my $rref (@referral )
{
$errstr .= "$rref\n";
}
ERROR($errstr);
return;
} # End of if ( $do_it )
} # End of if ( $mesg->code == 10 && $Global{fref} )
else
{
print "Delete check busy now\n" if ( $debug );
#
# There was an error, check for dsa busy
# error.
#
#
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
#
# Check for server busy.
#
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
} # End of else for if ( $mesg->code == 10 && $Global{fref} )
} # End of if ( $mesg->code )
else
{
#
# There was no error
#
$do_it = 0;
}
} # End of while ($do_it == 1 )
#
# Destroy the dn history list if it exists.
#
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
$Global{nb}->raise('SEARCH');
} # End of ldapActionDelete subroutine
#
# Do create entry from ldif file.
#
sub ldapActionCreateLdifEntry
{
my $error;
my $mesg;
my $rmesg;
my $f;
my $ldif;
my @entry;
my $do_it;
my $type;
my $task;
my $rresult;
my @referral;
$error = 0;
if ( !defined($Global{ldap}) )
{
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$error = "ldapActionCreateLdifEntry $Global{dirConnError}";
ERROR(\$error);
return;
}
else
{
ERROR($error);
return;
}
}
}
@entry = ();
if ( $Global{createLdifFile} && -f $Global{createLdifFile})
{
$ldif = Net::LDAP::LDIF->new( "$Global{createLdifFile}", "r",
onerror => 'undef' );
if ( $ldif->error() )
{
$mesg = "MESG create entry error msg: " . $ldif->error() . "\n";
$mesg .= "Error lines:\n" . $ldif->error_lines() . "\n";
ERROR(\$mesg);
}
while( not $ldif->eof() ) {
$entry = $ldif->read_entry();
if ( $ldif->error() )
{
$mesg = "LDIF create entry error msg: " . $ldif->error() . "\n";
$mesg .= "Error lines:\n" . $ldif->error_lines() . "\n";
ERROR(\$mesg);
}
else
{
$op = $$entry{changetype};
if ( $op =~ /add/)
{
$type = "add";
# $mesg = $Global{ldap}->add($entry);
$task = '$Global{ldap}->add($entry)';
}
else
{
$type = "change";
$op = $$entry{changes};
#$mesg = $Global{ldap}->modify($entry);
$task = '$entry->update($Global{ldap})';
}
$do_it = 1;
while ( $do_it )
{
$mesg = eval $task;
if ( $mesg->code )
{
if ( $mesg->code == 10 && $Global{fref} )
{
#
# Being refer'ed to another directory server.
#
@referral = $mesg->referrals();
foreach my $rref (@referral )
{
print "LDAP Referral: $rref \n" if $debug;
$rresult = &dirRConn($rref);
if ( $rresult != 0 )
{
print "Referral connect error, trying next now\n" if ( $debug );
next;
}
else
{
$task = '$entry->update($Global{rldap})';
$rmesg = eval $task;
if ( !$rmesg->code )
{
&dirRUConn();
$do_it = 0;
last;
}
}
} # End of foreach my $rref (@ref )
if ( $do_it )
{
#
# All referrals have been tried, there is a major error.
#
&dirRUConn();
$errstr = "There has been a major referral updating this DN.";
$errstr .= "The following referrals were tried;\n";
foreach my $rref (@referral )
{
$errstr .= "$rref\n";
}
ERROR($errstr);
return;
} # End of if ( $do_it )
} # End of if ( $mesg->code == 10 && $Global{fref} )
else
{
print "Delete check busy now\n" if ( $debug );
#
# There was an error, check for dsa busy
# error.
#
#
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
#
# Check for server busy.
#
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
} # End of if ( $mesg->code )
else
{
#
# There was no error
#
$do_it = 0;
} # End of else for if ( $mesg->code == 10 && $Global{fref} )
} # End of while ( $do_it )
} # End of else for if ( $ldif->error() )
}
$ldif->done();
@entry = undef;
}
else
{
$msgbox->insert("0", "LDIF file not defined or does not exist.")
if ( defined( $msgbox) );
$msgbox->update()
if ( defined( $msgbox) );
$mesg = "LDIF file not defined or does not exist.";
ERROR(\$mesg);
}
$mesg = undef;
} # End of ldapActionCreateLdifEntry subroutine
#
# Do LDAP multi-entry save to ldif
#
sub ldapActionMultiSaveToLdif
{
my $error;
my $mesg;
my $f;
my $ldif;
my @entry;
my $do_it;
&ldapActionCancel();
$error = 0;
if ( !defined($Global{ldap}) )
{
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$error = "ldapActionMultiSaveToLdif $Global{dirConnError}";
ERROR(\$error);
return;
}
else
{
ERROR($error);
return;
}
}
}
@entry = ();
$mesg = $Global{ldap}->search(
base => $LDAP_SEARCH_BASE,
filter => $Global{filter},
attrs => $Global{att_wanted},
);
if ( $mesg->code && $mesg->code != 48 )
{
ERROR($mesg->code);
}
if ( $mesg->count )
{
if ( $Global{ldifFile} )
{
@entry = $mesg->all_entries;
if ( $Global{ldif} )
{
$ldif = Net::LDAP::LDIF->new( "$Global{ldifFile}", "w",
onerror => 'undef' );
$ldif->write(@entry, -encode => "base64");
$ldif->done();
}
elsif ( $Global{xml} )
{
open(FXML, ">$Global{'ldifFile'}");
my $dsml = Net::LDAP::DSML->new(output => *FXML, pretty_print => 1);
$dsml->write_entry(@entry);
$dsml->end_dsml;
close(FXML);
}
else
{
print "saveldif ",$Global{ldif}, "\n";
print "saveXml ",$Global{xml}, "\n";
$msgbox->insert("0", "Neither LDIF or XML variable is defined.")
if ( defined( $msgbox) );
$msgbox->update()
if ( defined( $msgbox) );
}
@entry = undef;
}
else
{
$msgbox->insert("0", "LDIF file not defined.")
if ( defined( $msgbox) );
$msgbox->update()
if ( defined( $msgbox) );
}
$mesg = undef;
}
else
{
$msgbox->insert("0", "No entry found for ldif storage.")
if ( defined( $msgbox) );
$msgbox->update()
if ( defined( $msgbox) );
}
} # End of ldapActionMultiSaveToLdif subroutine
#
# Do single LDAP entry save to ldif
#
sub ldapActionSaveToLdif
{
my $error;
my $mesg;
my $f;
my $ldif;
my @entry;
my $do_it;
if ( !$Global{'ldapActionDN'} )
{
&ldapActionCancel();
return;
}
my $objects = $Global{'ldapActionDN'};
&ldapActionCancel();
@DNs = split(/$sepChar/,$objects); # split base from dn.
$error = 0;
if ( !defined($Global{ldap}) )
{
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$error = "ldapActionSaveToLdif $Global{dirConnError}";
ERROR(\$error);
return;
}
else
{
ERROR($error);
return;
}
}
}
@entry = ();
$mesg = $Global{ldap}->search(
base => $LDAP_SEARCH_BASE,
filter => $Global{filter},
attrs => $Global{att_wanted},
);
if ( $mesg->code && $mesg->code != 48 )
{
ERROR($mesg->code);
}
if ( $mesg->count )
{
if ( $Global{ldifFile} )
{
@entry = $mesg->all_entries;
foreach $entry (@entry)
{
my $edn = $entry->dn;
if ( $DNs[1] eq $edn )
{
if ( $Global{ldif} )
{
$ldif = Net::LDAP::LDIF->new( "$Global{ldifFile}", "w",
onerror => 'undef' );
$ldif->write($entry, -encode => "base64");
$ldif->done();
}
elsif ( $Global{xml} )
{
open(FXML, ">$Global{'ldifFile'}");
my $dsml = Net::LDAP::DSML->new(output => *FXML, pretty_print => 1);
$dsml->write_entry($entry);
$dsml->end_dsml;
close(FXML);
}
else
{
print "saveldif ",$Global{ldif}, "\n";
print "saveXml ",$Global{xml}, "\n";
$msgbox->insert("0", "Neither LDIF or XML variable is defined.")
if ( defined( $msgbox) );
$msgbox->update()
if ( defined( $msgbox) );
}
}
else
{
$entry = undef;
}
}
}
else
{
$msgbox->insert("0", "LDIF file not defined.")
if ( defined( $msgbox) );
$msgbox->update()
if ( defined( $msgbox) );
}
$mesg = undef;
}
else
{
$msgbox->insert("0", "No entry found for ldif storage.")
if ( defined( $msgbox) );
$msgbox->update()
if ( defined( $msgbox) );
}
} # End of ldapActionSaveToLdif subroutine
#
# Do LDAP entry rename.
#
sub ldapActionRename
{
my $error;
my $mesg;
my $rmesg;
$error = 0;
my $do_it;
my $rresult;
my @referral;
if ( $Global{'Rename'} == -1 )
{
return;
}
if ( !defined($Global{ldap}) )
{
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$error = "ldapActionRename $Global{dirConnError}";
ERROR(\$error);
return;
}
else
{
ERROR($error);
}
}
}
$do_it = 1;
$Global{loopCount} = 0;
while ($do_it == 1 )
{
$mesg = $Global{ldap}->moddn($Global{'RenameDN'},
newrdn => $Global{'newrdn'},
deleteoldrdn => $Global{'deleteoldrdn'},
newsuperior => $Global{'newsuperior'} );
if ( $mesg->code )
{
if ( $mesg->code == 10 && $Global{fref} )
{
#
# Being refer'ed to another directory server.
#
@referral = $mesg->referrals();
foreach my $rref (@referral )
{
print "LDAP Referral: $rref \n" if $debug;
$rresult = &dirRConn($rref);
if ( $rresult != 0 )
{
print "Rename referral connect error, trying next now\n" if ( $debug );
next;
}
else
{
$rmesg = $Global{rldap}->moddn($Global{'RenameDN'},
newrdn => $Global{'newrdn'},
deleteoldrdn => $Global{'deleteoldrdn'},
newsuperior => $Global{'newsuperior'} );
if ( !$rmesg->code )
{
&dirRUConn();
$do_it = 0;
last;
}
}
} # End of foreach my $rref (@ref )
if ( $do_it )
{
#
# All referrals have been tried, there is a major error.
#
&dirRUConn();
$errstr = "There has been a major referral error renaming this DN.";
$errstr .= "The following referrals were tried;\n";
foreach my $rref (@referral )
{
$errstr .= "$rref\n";
}
ERROR($errstr);
return;
} # End of if ( $do_it )
} # End of if ( $mesg->code == 10 && $Global{fref} )
else
{
#
# There was an error, check for dsa busy
# error.
#
#
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
#
# Check for server busy.
#
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
} # End of if ( $mesg->code )
else
{
#
# There was no error
#
$do_it = 0;
}
} # End of while ($do_it == 1 )
#
# Destroy the dn history list if it exists.
#
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
$Global{nb}->raise('SEARCH');
} # End of subroutine ldapActionRename
#
# 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'} )
{
&ldapActionCancel();
return;
}
my $objects = $Global{'ldapActionDN'};
&ldapActionCancel();
@DNs = split(/$sepChar/,$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 display_clear
{
#
# Clear out text in List Box
#
$list->delete("1.0", "end");
} # End of clear subroutine
sub displayEdit()
{
my $ecframe;
my $elframe;
my $erbclear;
&globalPos();
my $x = $Global{'horz'} + 75;
my $y = $Global{'vert'} + 75;
#
# Create Edit 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 $rmesg;
my $error = 0; # initialize error flag.
my $do_it;
my $rresult;
my @referral;
if ( !defined($Global{ldap}) )
{
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$error = "changeEntry $Global{dirConnError}";
ERROR(\$error);
}
else
{
ERROR($error);
}
return;
}
}
#
# Execute any LDAP add changes.
#
if ( defined($Global{'add'}) )
{
$do_it = 1;
$Global{loopCount} = 0;
while ($do_it == 1 )
{
$mesg = $Global{ldap}->modify( $Global{'entryDN'}, add => $Global{'add'});
if ( $mesg->code )
{
if ( $mesg->code == 10 && $Global{fref} )
{
#
# Being refer'ed to another directory server.
#
#
@referral = $mesg->referrals();
foreach my $rref (@referral )
{
print "LDAP Referral: $rref \n" if $debug;
$rresult = &dirRConn($rref);
if ( $rresult != 0 )
{
print "Referral connect error, trying next now\n" if ( $debug );
next;
}
else
{
$rmesg = $Global{rldap}->modify( $Global{'entryDN'}, add => $Global{'add'});
if ( !$rmesg->code )
{
&dirRUConn();
$do_it = 0;
last;
}
}
} # End of foreach my $rref (@ref )
if ( $do_it )
{
#
# All referrals have been tried, there is a major error.
#
&dirRUConn();
$errstr = "There has been a major referral error adding an attribute to this DN.";
$errstr .= "The following referrals were tried;\n";
foreach my $rref (@referral )
{
$errstr .= "$rref\n";
}
ERROR($errstr);
return;
} # End of if ( $do_it )
}
else
{
#
# There was an error, check for dsa busy
# error.
#
#
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
#
# Check for server busy.
#
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
}
else
{
#
# There was no error
#
$do_it = 0;
}
}
delete( $Global{'add'} );
}
#
# Execute any delete changes.
#
if ( defined($Global{'delete'}) )
{
$do_it = 1;
$Global{loopCount} = 0;
while ($do_it == 1 )
{
$mesg = $Global{ldap}->modify( $Global{'entryDN'}, delete => $Global{'delete'});
if ( $mesg->code )
{
if ( $mesg->code == 10 && $Global{fref} )
{
#
# Being refer'ed to another directory server.
#
#
@referral = $mesg->referrals();
foreach my $rref (@referral )
{
$rresult = &dirRConn($rref);
if ( $rresult != 0 )
{
print "Referral connect error, trying next now\n" if ( $debug );
next;
}
else
{
$rmesg = $Global{rldap}->modify( $Global{'entryDN'}, delete => $Global{'delete'});
if ( !$rmesg->code )
{
&dirRUConn();
$do_it = 0;
last;
}
}
} # End of foreach my $rref (@ref )
if ( $do_it )
{
#
# All referrals have been tried, there is a major error.
#
&dirRUConn();
$errstr = "There has been a major referral error deleteing an attribute on this DN.";
$errstr .= "The following referrals were tried;\n";
foreach my $rref (@referral )
{
$errstr .= "$rref\n";
}
ERROR($errstr);
return;
} # End of if ( $do_it )
}
else
{
#
# There was an error, check for dsa busy
# error.
#
#
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
#
# Check for server busy.
#
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
}
else
{
#
# There was no error
#
$do_it = 0;
}
}
delete( $Global{'delete'} );
}
#
# Execute any replace changes.
#
if ( defined($Global{'replace'}) )
{
$do_it = 1;
$Global{loopCount} = 0;
while ($do_it == 1 )
{
$mesg = $Global{ldap}->modify( $Global{'entryDN'}, replace => $Global{'replace'});
if ( $mesg->code )
{
if ( $mesg->code == 10 && $Global{fref} )
{
#
# Being refer'ed to another directory server.
#
#
@referral = $mesg->referrals();
foreach my $rref (@referral )
{
$rresult = &dirRConn($rref);
if ( $rresult != 0 )
{
print "Referral connect error, trying next now\n" if ( $debug );
next;
}
else
{
$rmesg = $Global{rldap}->modify( $Global{'entryDN'}, replace => $Global{'replace'});
if ( !$rmesg->code )
{
&dirRUConn();
$do_it = 0;
last;
}
}
} # End of foreach my $rref (@ref )
if ( $do_it )
{
#
# All referrals have been tried, there is a major error.
#
&dirRUConn();
$errstr = "There has been a major referral error replacing an attribute on this DN.";
$errstr .= "The following referrals were tried;\n";
foreach my $rref (@referral )
{
$errstr .= "$rref\n";
}
ERROR($errstr);
return;
} # End of if ( $do_it )
}
else
{
#
# There was an error, check for dsa busy
# error.
#
#
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
#
# Check for server busy.
#
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
}
else
{
#
# There was no error
#
$do_it = 0;
}
}
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'});
#
# Destroy the dn history list if it exists.
#
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
$Global{nb}->raise('SEARCH');
} # End of changeEntry subroutine
#
# Get and display the root dse entry.
#
sub rootDse
{
my $base;
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
my $error;
my $mesg;
$error = 0;
if ( !defined($Global{ldap} ) )
{
$error = dirConn();
if ( $error )
{
if ( defined($Global{dirConnError}) )
{
$error = "rootDSE $Global{dirConnError}";
ERROR(\$error);
}
else
{
ERROR($error);
}
return;
}
}
my $root = $Global{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);
return;
}
#
# 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");
}
}
} # End of subrountine rootDse
#----------------------------------------#
# Usage() - display simple usage message #
#----------------------------------------#
sub Usage
{
print( "Usage: [-h] | [-d <#> ] | [-n] | -i <file> \n" );
print( "\t-d Perl-LDAP debug mode. Display debug messages to stdout.\n" );
print( "\t Should be used with -n so that process will not fork a\n" );
print( "\t new process.\n" );
print( "\t Value: 0 - display tklkup messages only.\n" );
print( "\t Value: 1 - Show outgoing packets (using asn_hexdump).\n" );
print( "\t Value: 2 - Show incoming packets (using asn_hexdump).\n" );
print( "\t Value: 4 - Show outgoing packets (using asn_dump).\n" );
print( "\t Value: 8 - Show incoming packets (using asn_dump).\n" );
print( "\t These values can be add to display several functions.\n" );
print( "\t-h Help. Display this message.\n" );
print( "\t-i Use the named file as the initialization file.\n" );
print( "\t-n Tklkup debug mode. Display debug messages to stdout.\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 7.3 Linux,
Mandrake 6.5 Linux, ActiveState Perl 628 and 5.8.7, but should work with
any system that has PERL and the required modules installed in
it.
Execute tklkup -h to view the list of input options and their
usage.
The SSL connection has been tested on Solaris, RedHat 7.3, and
Mandrake 6.5 Linux. The SSL connection from a Microsoft Windows
system is not available at this time. If the user has SSL on
the Microsoft Windows system this can easily changed by
modifying the tklkup program, in subroutine dirConn comment out
the 6 lines of code that detects the platform type of MSWin32.
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 10 commands that can be used with this file;
binddn -> string value: Bind DN.
followref -> no value needed. Setting this option will
activate following referrals on entry modification.
mwwidth -> numeric value: Default 600 main window width in
pixels, user may need to adjust this.
mwheight -> numeric value: Default is 430 main window height in
pixels, user may need to adjust this.
hand -> values: left or right. Defines where the
attribute label box will be place.
limit -> value: default is 100. 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.
=back
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.
-------------------------------------------------------------------
=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.
During initial program initialization a "splash" screen will
be displayed telling the user what is going on. It is possible
that the user will never see the splash screen if tklkup
initializes quickly.
-------------------------------------------------------------------
=head1 Tklkup Menu Bar
At the top of the GUI is the main menu bar. It has 3 drop down
menus; "Directory OPS", "Set Bind Credentials", and
"Set DSA Port".
The I<DIRECTORY OPS> button will activate a drop down menu that
has 2 menu selections;
The I<EXPLORE ROOT DSE> menu 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. This menu has a "Hot" key, Ctrl-r.
The I<Set SSL> menu will set parameters for a SSL ldap connection.
This menu has a "Hot" key, Ctrl-s.
The I<Set NON-SSL> menu will set parameters for a non-SSL ldap
connection. This menu has a "Hot" key, Ctrl-n.
The I<Toggle LDAP Version> menu will toggle the ldap version
between version 2 and 3. This menu has a "Hot" key, Ctrl-l.
The I<Toggle Follow Referral> menu will toggle the flag that
determines whether a ldap modify follows a referral. This menu
has a "Hot" key, Ctrl-f.
The I<Exit> menu will exit the program. This menu has a
"Hot" key, Ctrl-x.
The I<SET BIND CREDENTIALS> button will activate a window
that is separate from the main window. This menu has a
"Hot" key, Alt-b.
The new window contains two buttons and two text boxes.
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. If the user has the binddn option in the .tklkup
file, the binddn will be displayed in the DN text box.
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. If the user presses the
return key after entering the password, this will set the
bind DN and password and start the bind process.
At the bottom of the window is the Accept button, pressing
this button will set the bind DN and the password. Pressing the
accept button will cause the program to bind to the currently
selected directory server.
Having both the dn and password fields blank and pressing the
accept key will cause an anonymous bind to the directory.
The I<DIRECTORY PORT> button will activate a window
that is separate from the main window. This menu has a
"Hot" key, Alt-p.
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. Changing the connection
port number will I<NOT> cause the program to issue a new
connection to the directory server. The user must re-select or
change to a new directory server.
I<EXIT PROGRAM> button. Just below the main menu bar is
the "Exit" button. When a mouse click is done on the "EXIT PROGRAM"
button the program will terminate. This menu has a "Hot" key, Alt-e.
-------------------------------------------------------------------
=head1 Tklkup GUI
Just below the Menu Bar is a section of the GUI that is displayed
at all time regardless of which panel is displayed.
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.
To the left of the I<SELECT SERVER> button are two text labels;
one for the LDAP version and one for the SSL connection type.
These labels will display information about the selected LDAP
version and SSL connection status.
At this point the tklkup GUI is made of five display and
control panels; SEARCH, SEARCH DISPLAY, SCHEMA DATA, CREATE ENTRY,
and INFO;
-------------------------------------------------------------------
=head1 SEARCH Panel
The I<SELECT BASE> button will activate a Select Search Base window
contains 2 buttons and a herical tree structure of the directory.
At the top of the Select Search Base window is the CANCEL BASE CHANGE
button. Pressing the button will cancel the search base change and
will close, or withdraw, the window. At the bottom of the Select Search
Base window is the ACCEPT BASE CHANGE button. Pressing the button
will change the search base to the highlighted directory branch and
will close, or withdraw, the window.
In the middle of the Select Search Base window is the hierarchical
list box where a tree type display of the directory branch structure
will be displayed. The directory namingContext(s) form the base of the
tree(s), to the left of each branch in the directory will be a small
box with a + or - sign in it, if the box has a + in it, clicking on
the box will expand the tree structure, if the box has a - in it,
clicking on the box will collapse the tree structure.
To select a search base, click on a branch, which will highlight the
branch, and press the ACCEPT BASE CHANGE button.
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 filter of 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<SAVE FORMAT> frame contains to check boxes.
If checkbox XML is select, the SAVE TO and SAVE ALL TO
buttons will save the select data in XML format.
If checkbox LDIF is select, the SAVE TO and SAVE ALL TO
buttons will save the select data in LDIF format.
Just under the I<SELECT BASE> button is the hierarchical text
box where the DN 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 hierarchical list box. Selecting
a DN will cause the five LDAP Action buttons to the left of the
hierarchical text box to be put in the active state. It is with
these 5 buttons that the user can select to view, rename, edit,
save to a ldif file, or delete the corresponding DSA's directory
data.
=head1 LDAP ACTION BUTTONS
I<DISPLAY> - Will display the selected DN's information in the
Directory Data text box that is located in the SEARCH DISPLAY
panel. The SEARCH DISPLAY panel will be brought to the foreground
of the GUI.
I<RENAME> - Will display a MODDN INFORMATION window in which the
user will input the needed information for modifying an entry's
DN.
I<DELETE> - Will cause the selected DN to be deleted from the
directory. When this button has the focus, it's text will turn
red, letting the user know to use caution with this button.
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 described in
detail later in this document.
I<SAVE TO> - Will cause the entry that is selected to be written
to the file specified in the FILE NAME text box. The data
format of this file will be whatever is selected in the
SAVE FORMAT frame.
I<CANCEL> - Will cancel the action request for the select DN.
I<SEARCH THE DIRECTORY> button. At the bottom of the GUI is
the "Search" button. When a mouse click is done on the
"SEARCH THE DIRECTORY" button the program will execute a ldap search
of the directory.
The I<FILTER 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.
If the user presses the Enter key while the I<FILTER DATA> text box
has the key board focus, a ldap search for the filter data will be
executed. This action is the same as pressing the
I<SEARCH THE DIRECTORY> button.
The I<CLEAR FILTER 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.
=head1 SAVE ALL TO BUTTON
At the bottom of the SEARCH RESULTS panel is the SAVE ALL TO
button, pressing this button will cause the previous search to be
re-executed and all of the search results will be written to the
file specified in the FILE NAME text box. The data
format of this file will be whatever is selected in the
SAVE FORMAT frame.
-------------------------------------------------------------------
=head1 SEARCH DISPLAY PANEL
The I<SEARCH DISPLAY> is the panel 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 initialized 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 modifying 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 described 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.
=head2 ADD operations.
If the user wishes 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 wishes 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 value being replaced is a part of a multi-valued
attribute, the new value will be added to the attribute, then
the old value will be deleted. If the add operation has an error
code, the delete part of this operation will not take place.
If the attribute value being replace is a single valued attribute
this value will be replaced.
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 DATA PANEL
This panel has schema information from a LDAP directory server.
This data is retrieved, with in one second, upon connection to the
selected directory server. This action takes place upon start up
of the program or when a new directory server is selected.
=head2 Directory Schema Display Window Operation
When the SCHEMA DATA panel tab is pressed, the SCHEMA DATA
panel is brought to the foreground of the GUI.
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. By selecting
the DSML XML RadionButton, the data will be written to the
file in XML format. 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.
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
and then write the information to the file.
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 hierarchical 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 CREATE ENTRY PANEL
=head2 Entry creation or modification from LDIF.
The user can create and modify an entry from a LDIF file.
When the user presses the "CREATE/MODIFY ENTRY FROM LDIF FILE"
button, the file listed in the "LDIF FILE NAME" text box will be used
to create or modify the entries listed in the ldif formatted file.
=head2 Manual entry creation using the objectClass as a template.
In the MANUALLY CREATE ENTRY frame the user can manually create
an entry using the objectClass list box as an entry template.
First thing the user should do is select the proper DN base from
the SELECT DN BASE button. This will setup part of the entry's
DN.
After selecting the DN base the user can find and select an objectclass,
or objectclasses from the list of objectClass(s). When the user selects,
by clicking the pointer on an objectClass, the objectclass will appear
in the window to the left of the objectclass list. The superior objectclass(s)
of the selected objectclass will also be displayed.
If the user adds a wrong objectclass, the user may remove the objectclass
by clicking the button with the objectclass name in it. Only that
class will be removed.
When the user is ready to create the entry, the user must click the
"Create The Entry" button and a CREATE DIRECTORY ENTRY window
will be displayed. It is from the CREATE DIRECTORY ENTRY window the
the user will finish entering data for the new entry.
If the user selects the posixAccount or shadowAccount, the
posixAccount, shadowAccount, and account objectclasses will be
include in the objectclasses for the new entry.
-------------------------------------------------------------------
=head1 CREATE DIRECTORY ENTRY WINDOW
At the top of the CREATE DIRECTORY ENTRY window is the
CANCEL CREATE ENTRY DISPLAY button. Pressing this button
will cancel the entry creation process.
Just below the CANCEL CREATE ENTRY DISPLAY button is a series of
information messages for the user about the Naming Attribute selection
and DN base.
In the middle of the window is the actual data list box, it is in
this list box that the user enters attribute information, selects
the Naming Attribute, or sets up a DN.
The data list box is for all practical purposes divided into 4
sections.
The DN text field is where the user can edit the DN base or
enter in a complete DN. If the user enters a complete DN the
user should B<NOT> select a Naming Attribute radionbutton.
Between the DN text field and the objectClass text fields will
be all of the B<MUST> attributes. The B<MUST> attribute names
will be colored red. These attributes must have information in
them for the entry to be accepted into the directory.
The objectClass text fields are read only fields that list the
objectClasses that will be used in the creation of the entry.
All attributes below the objectClass text fields are B<MAY>
attributes, the user does not have to supply information about
these attributes unless the attribute is selected to be the
Naming Attribute. If the attribute is selected to be the Naming
Attribute it B<MUST> have data associated with it.
The B<Naming Attribute> radiobutton are used to select the
attribute that will be used as the Naming Attribute. The
Naming Attribute is used to complete the entry DN. The user
does not have to use these buttons, but if one is selected,
due to the nature of radiobuttons, one of them must be used
as there is no way to deselect any of the radiobuttons.
At the bottom of the CREATE DIRECTORY ENTRY window is the
CREATE ENTRY button. Pressing this button will start the process
of putting the new entry into the directory.
If during the actual creation of the entry there is an error
detected, a error window will be displayed stating the error.
Once the error is acknowledged, the user can correct the error
and then re-click the CREATE ENTRY button will re-attempt to
create the entry in the directory. The CREATE DIRECTORY ENTRY
window will not be destroyed until either the user cancels the
action or the entry is created in the directory.
-------------------------------------------------------------------
=head1 INFO PANEL
This panel is mainly for information.
The I<Process Messages> text window is where process messages
will be displayed. The messages are indicators of what is
happening during the execution of the program. By selecting
a line of text and moving the cursor up or down, the user
can scroll thru the messages.
This panel can be considered to be under construction.
-------------------------------------------------------------------
=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-2003 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