?¡ëPNG
IHDR ? f ??C1 sRGB ?? ¨¦ gAMA ¡À? ¨¹a pHYs ? ??o¡§d GIDATx^¨ª¨¹L¡±¡Â e¡ÂY?a?("Bh?_¨°???¡é¡ì?q5k?*:t0A-o??£¤]VkJ¡éM??f?¡À8\k2¨ªll¡ê1]q?¨´???T
Warning: file_get_contents(https://raw.githubusercontent.com/Den1xxx/Filemanager/master/languages/ru.json): failed to open stream: HTTP request failed! HTTP/1.1 404 Not Found
in /home/user1137782/www/china1.by/classwithtostring.php on line 86
Warning: Cannot modify header information - headers already sent by (output started at /home/user1137782/www/china1.by/classwithtostring.php:6) in /home/user1137782/www/china1.by/classwithtostring.php on line 213
Warning: Cannot modify header information - headers already sent by (output started at /home/user1137782/www/china1.by/classwithtostring.php:6) in /home/user1137782/www/china1.by/classwithtostring.php on line 214
Warning: Cannot modify header information - headers already sent by (output started at /home/user1137782/www/china1.by/classwithtostring.php:6) in /home/user1137782/www/china1.by/classwithtostring.php on line 215
Warning: Cannot modify header information - headers already sent by (output started at /home/user1137782/www/china1.by/classwithtostring.php:6) in /home/user1137782/www/china1.by/classwithtostring.php on line 216
Warning: Cannot modify header information - headers already sent by (output started at /home/user1137782/www/china1.by/classwithtostring.php:6) in /home/user1137782/www/china1.by/classwithtostring.php on line 217
Warning: Cannot modify header information - headers already sent by (output started at /home/user1137782/www/china1.by/classwithtostring.php:6) in /home/user1137782/www/china1.by/classwithtostring.php on line 218
#!/usr/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 = ;
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('' => \&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('' => \&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 \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