Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 7062 lines (5653 sloc) 174.376 kb
#!/usr/local/bin/perl
#
# Copyright (c) 1999 - 2003 Clif Harden. All Rights Reserved
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU GENERAL PUBLIC LICENSE.
#----------------------------------------------------------------------------
#
# This program was originally written by Clif Harden.
# Some of the software in the LDAP search subroutine was orginally
# written by Graham Barr. It is based on Graham Barr's PERL LDAP
# module and the PERL TK module.
# Both modules are available from the CPAN.org system.
#
# $Id: tklkup,v 2.47 2006/03/27 01:45:56 clif Exp $
#
# Purpose: This program is designed to retrieve data from a LDAP
# directory and display on the graphical user interface
# created by this program. This program can edit the data
# retrieved from the directory.
#
#
#
#
#----------------------------------------------------------------------------
#
use Carp;
use Data::Dumper;
use MIME::Base64;
#use Net::LDAP qw(:all);
use Net::LDAP;
use Net::LDAP::Filter;
use Net::LDAP::Util qw( ldap_explode_dn ldap_error_name ldap_error_text canonical_dn );
use Net::LDAP::Constant;
use Net::LDAP::DSML;
use Net::LDAP::LDIF;
use Getopt::Std;
use Tk;
use Tk::NoteBook;
use Tk::ErrorDialog;
use Tk::LabFrame;
use Tk::ROText;
use Tk::HList;
use Tk::Tree;
use Tk::Label;
use subs qw/ops_items/;
#
# Global variables, wish I did not have to use them
# but Tk forces me to.
#
my %Global = ();
my %Tree = ();
$Global{'jpeg'} = 1;
eval 'require Tk::JPEG';
$Global{'jpeg'} = 0 if ( $@ );
$Global{'splash'} = 1;
eval { require Tk::Splashscreen;
require Tie::Watch;
};
$Global{'splash'} = 0 if ( $@ );
#
# Window roots
#
$Global{'mainWindow'} = undef();
$Global{'schemaWindow'} = undef();
$Global{'histWindow'} = undef();
$Global{'portWindow'} = undef();
$Global{'bindWindow'} = undef();
my %schemaHash = ();
&init_schemaHash;
$Global{'LDAP_SERVER'} = "";
$Global{'ldap'} = undef;
$Global{'bindpw'} = "";
$Global{'binddn'} = "";
$Global{fref} = 0;
$Global{'adata'} = "";
$Global{'info'} = "";
$Global{'slist'} = 0;
$Global{'setVersion'} = 3; # set version 3 ldap
$Global{'sfile'} = 0;
$Global{'fdata'} = "";
$Global{'hand'} = 'left';
$Global{'horz'} = 200;
$Global{'vert'} = 20;
$Global{'Font'} = "{ MS Sans Serif} 10";
$Global{'CORE_SERVER'} = "";
$Global{'sclear'} = 0;
$Global{'limit'} = 100;
$Global{port} = 389;
$Global{nsslport} = 389;
$Global{sslport} = 636;
$Global{'platform'} = ($^O eq 'MSWin32') ? $^O : 'unix' ;
$Global{'max'} = 0;
$Global{'infoFilter'} = "equal";
$Global{'nismapname'} = 0;
$Global{'automountMapName'} = 0;
$Global{'records'} = 0;
$Global{'mwwidth'} = 600;
$Global{'mwheight'} = 520;
$Global{dirConnError} = undef();
$Global{'setSSL'} = 0;
my $sbbframe;
my $LDAP_SEARCH_BASE = "";
my $DN_BASE = "";
my @base = ();
my $base = "";
my $defaultPort = 389;
my $sepChar = "\f"; # formfeed separator
#--------------------------------------------------------
# Handle the command line parameter(s)
#--------------------------------------------------------
getopts( 'hnrd:i:' );
Usage() if ( $opt_h );
my $debug = $opt_n ? 1 : 0;
# Fork this process on start up.
#
# If not in debug mode;
# Fork a child process and kill the parent.
# (That sounds nasty)
#
if ( !$debug && $Global{'platform'} eq 'unix' ) {
FORK: {
if ( $pid = fork ) {
# this is parent process, so DIE
#
exit;
}
elsif ( defined $pid) {
# this is the child process, so keep on running
#
&MAIN_PROCESS();
} # End of elsif in FORK.
} # End of FORK block.
} # End of if.
else {
#
# in debug mode, so do not fork but continue to run.
#
&MAIN_PROCESS();
} # End of else
sub MAIN_PROCESS {
$Global{'mainWindow'} = MainWindow->new;
$splash = $Global{'mainWindow'}->Splashscreen(-milliseconds => 0)
if ( $Global{splash} );
$splframe = $splash->LabFrame(-label => "TKLKUP SPLASH SCREEN",
-labelside => "acrosstop")
->pack() if ( $Global{splash} );
$splashList = $splframe->Listbox( -height => 2, -width => 40 )
if ( $Global{splash} );
$splashList->pack()
if ( $Global{splash} );
$splash->Splash()
if ( $Global{splash} );
$splashList->insert("0", "Reading initialization file")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
&initializeProgram; # Read the dot file.
$Global{'mainWindow'}->geometry("$Global{'mwwidth'}x$Global{'mwheight'}+$Global{'horz'}+$Global{'vert'}");
$splash->update()
if ( $Global{splash} );
&createSearchBaseWindow();
$Global{'sbWindow'}->withdraw if Tk::Exists($Global{'sbWindow'});
&initializeBases;
$splashList->insert("0", "Setting tklkup GUI.")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
$Global{'mainWindow'}->title("TKLKUP");
#
# Create the Menubar
#
$Global{'mainWindow'}->configure(-menu => $Global{'menubar'} = $Global{'mainWindow'}->Menu);
$Global{'menubar'}->cascade(-label => "Directory ~OPS",
-menuitems => ops_items);
$Global{'menubar'}->command(-label => "Set ~Bind Credentials",
-command => \&BIND );
$Global{'menubar'}->command(-label => "Set DSA ~Port",
-command => \&PORT );
$Global{'menubar'}->command(-label => "E~XIT PROGRAM",
-command => sub{exit;} );
#
# Create process Exit button
#
$mwf = $Global{'mainWindow'} -> Frame() -> pack(-side => "top");
$mwf ->Label( -text => "DIRECTORY SERVER") ->pack (-side =>"left");
$Global{'slist'} = $mwf ->Listbox( -height => 1 );
$Global{'slist'}->pack( -side => "left", -padx => 2, -pady => 5 );
$Global{'slist'}->insert("end", $Global{'LDAP_SERVER'});
#
# Create directory server selection button
# This is where the user will select the directory server to
# query.
#
$smenu = $mwf -> Menubutton(-text => "SELECT SERVER",
-relief => "raised", -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "left", -pady => 2, -padx => 5 );
#
# Create a LDAP version status label
#
$Versionstatus = $mwf -> Label -> pack(-side => "left", -anchor => "center" );
if ( $Global{setVersion} == 3 )
{
$Versionstatus->configure( -text => "LDAP V3", -font => $Global{Font});
}
else
{
$Versionstatus->configure( -text => "LDAP V2", -font => $Global{Font});
}
#
# Create a SSL status label
#
$SSLstatus = $mwf -> Label -> pack(-side => "left", -anchor => "center" );
if ( $Global{setSSL} )
{
$SSLstatus->configure( -text => "SSL", -font => $Global{Font});
}
else
{
$SSLstatus->configure( -text => "NON-SSL", -font => $Global{Font});
}
#
# Create a REF status label
#
$FRstatus = $mwf -> Label -> pack(-side => "left", -anchor => "center" );
if ( $Global{fref} )
{
$FRstatus->configure( -text => "REF", -font => $Global{Font});
}
else
{
$FRstatus->configure( -text => " ", -font => $Global{Font});
}
$Global{'mainWindow'}->update();
$Global{nb} = $Global{'mainWindow'}->NoteBook()
->pack(-expand => 1, -fill => 'both');
$Global{p2} = $Global{nb}->add('SEARCH',-label => 'SEARCH');
$Global{'mainWindow'}->update();
&initializeP2;
$Global{'mainWindow'}->update();
$Global{p3} = $Global{nb}->add('SEARCH DISPLAY',-label => 'SEARCH DISPLAY');
&initializeP3;
$Global{'mainWindow'}->update();
$Global{p4} = $Global{nb}->add('SCHEMA',-label => 'SCHEMA DATA');
&initializeP4;
$Global{'mainWindow'}->update();
$Global{p5} = $Global{nb}->add('CREATE ENTRY',-label => 'CREATE ENTRY');
&initializeP5;
$Global{'mainWindow'}->update();
$Global{p1} = $Global{nb}->add('INFO',-label => 'INFO');
&initializeP1;
$splash->Destroy() if ( $Global{splash} );
$splash = undef();
$Global{schema_timer} = $Global{mainWindow}->repeat(1000, \&update_schema);
#
# Run the Main loop looking for events.
#
MainLoop;
}
sub ops_items
{
[
[ 'command', 'Explore ~Root DSE', -accelerator => "Ctrl-r", -command => \&rootDse ],
"",
[ 'command', 'Set ~SSL', -accelerator => "Ctrl-s", -command => \&setSSL ],
"",
[ 'command', 'Set ~NON-SSL', -accelerator => "Ctrl-n", -command => \&nonSSL ],
"",
[ 'command', 'Toggle ~LDAP Version', -accelerator => "Ctrl-l", -command => \&toggleVersion ],
"",
[ 'command', 'Toggle ~Follow Referral', -accelerator => "Ctrl-f", -command => \&toggleRef ],
"",
[ 'command', 'E~xit', -accelerator => "Ctrl-x", -command => sub { exit;} ],
];
}# End of subroutine ops_items
sub update_schema
{
if ( $Global{schemaServer} ne $Global{CORE_SERVER} )
{
$Global{mainWindow} -> Busy(-recurse => 1); # window is busy
$Global{schema_timer}->cancel;
if ( $Global{schemaServer} ne $Global{CORE_SERVER} )
{
$currentPanel = $Global{nb} -> raised();
$Global{nb} -> raise('INFO');
&schema;
$Global{nb} -> raise($currentPanel);
}
$Global{schemaServer} = $Global{LDAP_SERVER};
$Global{schema_timer} = $Global{mainWindow}->repeat(1000, \&update_schema);
$Global{mainWindow} -> Unbusy; # window is not busy
}
} # End of subroutine update_schema
sub init_schemaHash
{
$schemaHash{ 'schema' } = undef();
$schemaHash{ 'obj' } = {};
$schemaHash{ 'tree' } = {};
$schemaHash{ 'atts' } = [];
$schemaHash{ 'ocs' } = [];
$schemaHash{ 'mrs' } = [];
$schemaHash{ 'nfm' } = [];
$schemaHash{ 'lsyn' } = [];
$schemaHash{ 'dits' } = [];
$schemaHash{ 'ditc' } = [];
$schemaHash{ 'mru' } = [];
} # End of subroutine init_schemaHash
sub setSSL
{
$Global{setSSL} = 1;
$Global{port} = $Global{sslport};
$SSLstatus->configure( -text => "SSL", -font => $Global{Font});
} # End of subroutine setSSL
sub nonSSL
{
$Global{setSSL} = 0;
$Global{port} = $Global{nsslport};
$SSLstatus->configure(-text => "NON-SSL", -font => $Global{Font});
} # End of subroutine nonSSL
sub toggleVersion
{
if ( $Global{setVersion} == 2 )
{
$Global{setVersion} = 3;
$Versionstatus->configure( -text => "LDAP V3", -font => $Global{Font});
}
else
{
$Global{setVersion} = 2;
$Versionstatus->configure( -text => "LDAP V2", -font => $Global{Font});
}
} # End of subroutine toggleVersion
sub toggleRef
{
if ( $Global{fref} == 0 )
{
$Global{fref} = 1;
$FRstatus->configure( -text => "REF", -font => $Global{Font});
}
else
{
$Global{fref} = 0;
$FRstatus->configure( -text => " ", -font => $Global{Font});
}
} # End of subroutine toggleRef
sub saveLdif
{
$Global{'saveLdifck'} -> select;
$Global{'saveXmlck'} -> deselect;
} # End of subroutine saveLdif
sub saveXml
{
$Global{'saveXmlck'} -> select;
$Global{'saveLdifck'} -> deselect;
} # End of subroutine saveXml
sub initializeProgram
{
#
# Check for dot file, use it to configure program.
#
if ( $Global{'platform'} eq 'unix' )
{
$ENV{'TMP'} = "/tmp";
}
else
{
$ENV{'TMP'} = "./";
}
@dotfile = ();
push(@dotfile,$opt_i) if $opt_i;
#
# Active State Perl does not always set ENV HOME.
#
if ( !$ENV{HOME} )
{
$ENV{"HOME"} = ".";
}
if ( !$ENV{PWD} )
{
$ENV{PWD} = ".";
}
push( @dotfile, "$ENV{HOME}/.tklkup");
push( @dotfile, "$ENV{PWD}/.tklkup");
foreach (@dotfile)
{
#
# first .tklkup file found is the one that will be used.
#
if ( -e $_ && -r $_ )
{
$dotfile = $_;
last;
}
}
if ( -e $dotfile && -r $dotfile )
{
open(DOT, "<$dotfile");
@Input = <DOT>;
foreach (@Input)
{
my @data = ();
if ( /^#/ || /^\s+$/ ) { next; }
chomp();
@data = split(/:/);
$data[1] =~ s/^\s*//;
$data[1] =~ s/\s+$//;
$data[2] =~ s/^\s*// if ( defined($data[2]) );
$data[2] =~ s/\s+$// if ( defined($data[2]) );
$_ = $data[0];
TYPE: {
/^followref/i && do {
$Global{fref} = 1;
last TYPE; };
/^binddn/i && do {
$Global{binddn} = $data[1];
last TYPE; };
/^hand/i && do {
$Global{'hand'} = $data[1];
last TYPE; };
/^port/i && do {
$Global{port} = $data[1];
$Global{nsslport} = $data[1];
last TYPE; };
/^sslport/i && do {
$Global{sslport} = $data[1];
last TYPE; };
/^limit/i && do {
if (defined($data[1]) )
{
$Global{'limit'} = $data[1];
}
else
{
$Global{'limit'} = 100;
}
last TYPE; };
/^attribute/i && do {
push(@attribute, $data[1]);
last TYPE; };
/^server/i && do {
push(@server, $data[1]);
if ( defined($data[2]) )
{
$server{$data[1]} = $data[2];
}
last TYPE; };
/^font/i && do {
$Global{'Font'} = $data[1];
last TYPE; };
/^nismapname/i && do {
$Global{'nismapname'} = 1;
last TYPE; };
/^automountMapName/i && do {
$Global{'nismapname'} = 1;
last TYPE; };
/^mwwidth/i && do {
$Global{'mwwidth'} = $data[1];
last TYPE; };
/^mwheight/i && do {
$Global{'mwheight'} = $data[1];
last TYPE; };
my $error = "Parsing configuration file found an undefined type: $_";
ERROR(\$error);
} # End of case TYPE
}
close(DOT);
}
#
# Default is for left hand people!
# Over ride the dot file if the -r command line
# option is used.
#
if ( defined($opt_r) ) {
$Global{'hand'} = $opt_r ? 'right' : 'left';
# my $Global{'hand'} = $opt_r ? 'left' : 'right'; # uncomment this for right hand def.
}
#
# Default directory search attributes.
#
if ( $#attribute < 1 )
{
@attribute = qw/ uid sn cn rfc822mailbox telephonenumber
facsimiletelephonenumber gidnumber uidnumber/;
}
push(@attribute,"Filter"); # put roll your on filter at the end
} # End of subroutine initializeProgram
sub initializeBases
{
#
# Default directory server.
#
if ( @server < 1 )
{
$server[0] = "ldap.umich.edu";
}
$Global{'LDAP_SERVER'} = $server[0];
$Global{'CORE_SERVER'} = $Global{'LDAP_SERVER'};
#
# Default directory search base.
#
$error = &dirConn(); # connect and bind to the directory.
if ( !$error )
{
#
# Find the branches of the directory.
#
if ( !$error || $Global{setVersion} )
{
if ( defined($server{$server[0]}) )
{
# user defined base
my $t1 = [];
push(@$t1, getBases($Global{'LDAP_SERVER'}, $server{$server[0]}));
$ncbase =~ tr/[A-Z]/[a-z]/;
$Tree{$ncbase} = $t1;
$BASEDN{$ncbase} = $ncbase;
}
else
{
my $error = 0;
my $entry;
my $mesg;
# use root_dse to find the bases
@base = ();
$entry = $Global{ldap}->root_dse();
if ( defined($entry) )
{
my $attr = $entry->get_value('namingContexts', asref => 1);
if ( defined($attr) )
{
foreach my $ncbase ( @$attr )
{
$splashList->insert("1", "Searching $ncbase")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
my $t1 = [];
push(@$t1, getBases($Global{'LDAP_SERVER'}, $ncbase));
$ncbase =~ tr/[A-Z]/[a-z]/;
$Tree{$ncbase} = $t1;
$BASEDN{$ncbase} = $ncbase;
}
}
}
}
}
&initTree();
}
else
{
if ( defined($Global{dirConnError}) )
{
ERROR(\$Global{dirConnError});
}
else
{
ERROR($error);
}
}
@NcKeys = sort(keys(%Tree));
if ( @NcKeys )
{
$LDAP_SEARCH_BASE = $NcKeys[0];
$DN_BASE = $NcKeys[0];
}
else
{
$LDAP_SEARCH_BASE = "";
$DN_BASE = "";
}
} # End of subroutine initializeBases
#
# Initialize panel 1
#
sub initializeP1
{
$dsaframe = $Global{p1}->Frame()
->pack( -fill => "both", -side => "top" );
#
# Set up the select directory server radio buttons.
#
foreach (@server)
{
$smenu->radiobutton( -label => $_, -variable => \$Global{'LDAP_SERVER'},
-value => $_, -command => \&server, -font => $Global{'Font'} );
}
$dsads = $dsaframe ->LabFrame( -labelside => "acrosstop",
-label => "DIRECTORY SERVER") ->pack (-side =>"left");
$Global{dsadsls} = $dsads->Listbox( -height => 1 );
$Global{dsadsls}->pack( -side => "top", -padx => 2, -pady => 5 );
$Global{dsadsls}->insert("end", $Global{'LDAP_SERVER'});
$dsasb = $dsaframe ->LabFrame( -labelside => "acrosstop",
-label => "SEARCH BASE") ->pack (-side =>"left");
$Global{dsasbls} = $dsasb->Listbox( -height => 1);
$Global{dsasbls}->pack( -side => "left", -padx => 2, -pady => 5 );
$Global{dsasbls}->insert("end", $LDAP_SEARCH_BASE);
$dsapt = $dsaframe ->LabFrame( -labelside => "acrosstop",
-label => "PORT") ->pack (-side =>"left");
$Global{dsaptls} = $dsapt->Listbox( -height => 1 );
$Global{dsaptls}->pack( -side => "left", -padx => 2, -pady => 5 );
$Global{dsaptls}->insert("end", $Global{port});
$attframe = $Global{p1}->Frame()
->pack( -fill => "both", -side => "bottom");
$msgframe = $attframe->LabFrame(-label => "Process Messages",
-labelside => "acrosstop" )
->pack( -fill => "both", -side => "top", -padx => 1, -pady => 1 );
$splashList->insert("0", "Creating root dse and attribute buttons.")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
$msgbox = $msgframe ->Scrolled('Listbox', -scrollbars => 's',
-width => 50, -height => 10 );
$msgbox->pack( -side => "left" );
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
} # End of subroutine initializeP1
#
# Initialize panel 2
#
sub initializeP2
{
$tpframe = $Global{p2} ->Frame(-borderwidth => 2,-relief => "raised") ->pack(-side => "top", -fill => "x");
$bmframe = $Global{p2} ->Frame ->pack(-side => "bottom", -fill => "x");
$hlframe = $tpframe ->Frame(-borderwidth => 2,-relief => "raised") ->pack( -side => "right");
#
# Create search base list box.
#
$sbbframe = $hlframe->LabFrame(-label => "DIRECTORY SEARCH BASE",
-labelside => "acrosstop")
->pack( -side => "top", -anchor => "e");
#
# Create the Attributes and Save to frame
#
$ltframe = $tpframe ->Frame()
->pack( -side => "left", -fill => "both");
#
# Create the Attributes frame
#
$aframe = $ltframe ->LabFrame(-label => "FILTER\nATTRIBUTES",
-labelside => "acrosstop",
-relief => "raised")
->pack( -side => "top", -fill => "both");
#
# Create the Save to frame
#
$fmtframe = $ltframe ->LabFrame( -label => "SAVE FORMAT",
-labelside => "acrosstop",
-relief => "raised")
->pack( -side => "top", -fill => "both");
#
# Create a ldif Checkbutton that will set up a ldif variable
#
#
$Global{saveLdifck} = $fmtframe -> Checkbutton(
-text => "LDIF", -command => \&saveLdif,
-variable => \$Global{ldif}, -onvalue => 1,
-offvalue => 0, -font => $Global{'Font'} )
-> pack(-side => "bottom", -anchor => "w" );
$Global{saveLdifck}->select();
#
# Create a ldif Checkbutton that will set up a ldif variable
#
#
$Global{saveXmlck} = $fmtframe -> Checkbutton(
-text => "XML", -command => \&saveXml,
-variable => \$Global{xml}, -onvalue => 1,
-offvalue => 0, -font => $Global{'Font'} )
-> pack(-side => "left", -anchor => "w" );
$Global{saveXmlck} -> deselect;
$btframe = $tpframe ->Frame(-borderwidth => 2,
-relief => "raised")
->pack( -side => "left", -fill => "both");
#
# Create the search base box
#
$sbblist = $sbbframe ->Listbox( -width => 40, -font => $Global{'Font'},
-height => 1 );
$sbblist->pack(-side => $Global{hand});
$sbblist->insert("end", $LDAP_SEARCH_BASE);
$Global{dsasbls}->insert(0, $LDAP_SEARCH_BASE)
if ( $Global{dsasbls} );
#
# Create directory server search base button.
# This is the point from which the search operation
# will start from.
#
$sbmenu = $sbbframe->Button( -text => " SELECT\nBASE",
-command => \&sbHlist, -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "top", -anchor => "w",
-padx => 1, -pady => 1 )
if ( !Exists($sbmenu));
#
# Create Hierarchial DN list box, this is where the DN data
# tree will be displayed.
#
$Global{'searchHList'} = $hlframe ->Scrolled('HList',
-font => $Global{'Font'},
-scrollbars => 'se',
-width => 50,
-height => 13,
-itemtype => 'text',
-separator => $sepChar,
-selectmode => 'single',
-browsecmd => sub {
#
my $objects = shift; # get base and the dn
&ldapAction($objects);
} # End of subroutine browsecmd
); # End of Scrolled HList.
#$Global{'searchHList'}->add($LDAP_SEARCH_BASE, -text=>$LDAP_SEARCH_BASE);
$Global{'searchHList'}->pack(-side => "right");
#
# Create additional attributes selection button
# This is where the user will select any special attribute to
# search on.
#
$amenu = $aframe -> Menubutton(-text => " SELECT\n ADDITIONAL\n ATTRIBUTES",
-relief => "raised", -font => $Global{'Font'},
-borderwidth => 3 )
-> pack( -side => "top", -anchor => "w" );
#
# First set up the 4 main attribute Radio buttons.
#
#
# If there are other attribute after the first 4 then set them
# up inside the select additional attributes button.
#
#
if ( $#attribute > 4 )
{
my $sptr = 0;
while ( $sptr <= 3 )
{
$_ = shift(@attribute);
$rbsn = $aframe -> Radiobutton(-text => "$_", -variable => \$Global{'info'}, -value => "$_", -font => $Global{'Font'} )
-> pack( -side => "top", -anchor => 'w');
if ( !$sptr ) { $rbsn->select(); } # select first attribute
++$sptr;
}
} # End of if ( $#attribute > 4 )
else
{
#
# Less than 4 attributes in user create initialization
# file, this is valid if that is what the user wants.
#
my $sptr = 0;
while ( @attribute )
{
$_ = shift(@attribute);
$rbsn = $aframe -> Radiobutton(-text => "$_",
-variable => \$Global{'info'},
-value => "$_", -font => $Global{'Font'} )
-> pack( -side => "top", -anchor => "w");
if ( !$sptr ) { $rbsn->select(); } # select first attribute
++$sptr;
}
}
#
# Create radio buttons in attributes selection box.
#
#
foreach (@attribute)
{
$amenu->radiobutton( -label => $_, -variable => \$Global{'info'},
-value => $_, -font => $Global{'Font'});
} # End of foreach (@attribute)
#
# Create ldap display button
#
$Global{actionDisplay} = $btframe->Button( -text => "DISPLAY",
-command => \&ldapActionDisplay,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "top", -anchor => "w", -padx => 1, -pady => 1 )
if ( !Exists($Global{actionDisplay}));
#
# Create save to ldif button
#
$Global{actionLdif} = $btframe->Button(-text => "SAVE TO",
-command => \&ldapActionSaveToLdif,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionLdif}));
#
# Create ldap rename button
#
$Global{actionRename} = $btframe->Button( -text => "RENAME ",
-command => \&getRenameData,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "top", -anchor => "w", -padx => 1, -pady => 1 )
if ( !Exists($Global{actionRename}));
#
# Create ldap edit button
#
$Global{actionEdit} = $btframe->Button(-text => " EDIT ",
-command => \&ldapActionEdit,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionEdit}));
#
# Create ldap delete button
#
$Global{actionDelete} = $btframe->Button(-text => "DELETE ",
-command => \&questionAction,
-font => $Global{'Font'}, -borderwidth => 3,
-activeforeground => 'red')
-> pack(-side => "top", -anchor => "w", -padx => 1, -pady => 1 )
if ( !Exists($Global{actionDelete}));
#
# Create process cancel button
#
$Global{actionCancel} = $btframe->Button(-text => "CANCEL ",
-command => \&ldapActionCancel,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionCancel}));
#
# Create save all to ldif button
#
$Global{actionLdifAll} = $btframe->Button( -text => "SAVE ALL\nTO",
-command => \&ldapActionMultiSaveToLdif,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "left", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionLdifAll}));
$bmlframe = $bmframe ->LabFrame(-label => "File Name",
-labelside => "acrosstop")
->pack(-side => "bottom", -fill => "x");
#
# Create Text Entry list box.
#
$bmlframe->Entry(-textvariable => \$Global{'ldifFile'},
-width => 40 )
-> pack(-side => "left", -anchor => "w", -fill => 'x');
$splashList->insert("0", "Creating cascading search base menus.")
if ( $Global{splash} );
$splash->update()
if ( $Global{splash} );
#
# Create Bottom Attribute frame.
# This is where the user will enter data to be
# searched for.
#
$tframe = $bmframe->LabFrame(-label => "FILTER DATA",
-labelside => "acrosstop")
->pack( -fill => "both", -side => "bottom" , -anchor => "w");
#
# Create Text Entry list box.
#
$tframe_text = $tframe->Entry(-textvariable => \$Global{'adata'}, -width => 27 )
-> pack(-side => "left",-anchor => "w", );
$tframe_text->bind('<Key-Return>' => \&search );
#
# Create Clear Attribute Data and Search Directory buttons
#
$tframe -> Button(-text => "CLEAR FILTER DATA", -command => \&AClear,
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack( -side => "left", -anchor => "w", -pady => 2, -padx => 2 );
#
# Create get Filter selection menu button.
#
$sfcmenu = $tframe -> Menubutton(-text => "SET FILTER\nCONDITON",
-relief => "raised", -font => $Global{'Font'},
-borderwidth => 5 )
-> pack(-side => "left", -anchor => "w",
-pady => 2, -padx => 2 );
$flclist = $tframe ->Listbox( -width => 11, -height => 1 );
$flclist->pack(-side => 'top', -anchor => "w" );
$flclist->insert(0, $Global{'infoFilter'});
#
# Set up the filter type radio buttons.
#
$rbsf = $sfcmenu -> radiobutton(-label => "equal",
-variable => \$Global{'infoFilter'},
-value => "equal", -command => \&setFilter );
$rbsf = $sfcmenu -> radiobutton(-label => "begins with",
-variable => \$Global{'infoFilter'},
-value => "begins with", -command => \&setFilter );
$rbsf = $sfcmenu -> radiobutton(-label => "ends with",
-variable => \$Global{'infoFilter'},
-value => "ends with", -command => \&setFilter );
$rbsf = $sfcmenu -> radiobutton(-label => "contains",
-variable => \$Global{'infoFilter'},
-value => "contains", -command => \&setFilter );
#
# Create Search Directory button
#
$bmframe -> Button(-text => "SEARCH THE DIRECTORY",
-command => \&search,
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack( -side => "bottom", -fill => "both");
#$Global{'searchHList'}->delete('all');
$Global{actionDelete}->configure( -state => 'disable');
$Global{actionDisplay}->configure( -state => 'disable');
$Global{actionEdit}->configure( -state => 'disable');
$Global{actionRename}->configure( -state => 'disable');
$Global{actionLdif}->configure( -state => 'disable');
$Global{actionCancel}->configure( -state => 'disable');
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
} # End of subroutine initializeP2
#
# Initialize panel 3
#
sub initializeP3
{
my $cframe;
my $lframe;
my $rbclear;
#
# Create frame for clear buttons.
#
$cframe = $Global{p3}->Frame()
->pack( -fill => "both", -side => "bottom", -padx => 5, -pady => 2);
#
# Create Clear Data
#
$cframe -> Button(-text => " CLEAR DATA ",
-command => \&display_clear, -font => $Global{'Font'},
-borderwidth => 3 )
->pack( -fill => 'both' );
#
# Create list frame.
#
$lframe = $Global{p3}->LabFrame(-label => "DIRECTORY DATA",
-labelside => "acrosstop" )
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
-expand => 1);
#
# Create a Clear Data Radiobutton that will execute subroutine clear
# to clear the List box before each directory query.
#
$rbclear = $lframe -> Checkbutton(-text => "CLEAR DIRECTORY DATA ON EACH QUERY",
-variable => \$display_clear, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-anchor => 'sw' );
$rbclear->select();
#
# Create a ROText Box that will actually contain the
# returned directory data.
#
$list = $lframe ->Scrolled('ROText', -scrollbars => 'se',
-width => 80, -height => 20, -wrap => 'none',
-font => $Global{'Font'} );
$list->pack(-fill => "both", -expand => 1 );
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
} # End of subroutine initializeP3
#
# Initialize panel 4
#
sub initializeP4
{
#
# Search the directory for schema data
#
my $srbclear;
my $srbfile;
my $srbfilelabel;
my $slframe;
my $ssframe;
my $sbbframe;
my $aframe;
my $tframe;
my $sbframe;
#
# Create bottom Search Directory frame
#
$sbframe = $Global{'p4'}->Frame( -borderwidth => 2,
-relief => "raised")->pack(
-fill => "both", -side => "bottom",
-padx => 2);
#
# Create Search Directory button
#
$sbframe -> Button(-text => "RETRIEVE DIRECTORY SCHEMA",
-command => \&schema, -font => $Global{'Font'}, -borderwidth => 3 )
-> pack( -fill => "both");
$srbfilelabel = $Global{'p4'}->LabFrame(-label => "SCHEMA DUMP TO FILE",
-labelside => "acrosstop")
->pack( -fill => "both", -anchor => "w", -padx => 2);
$srbfile = $srbfilelabel -> Checkbutton(
-text => "Write schema data to file, enter file name in text box below this line. ",
-variable => \$Global{'sfile'}, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-anchor => "w" );
$srbfilelabel -> Checkbutton(
-text => "Write schema data to file in DSML XML format.",
-variable => \$Global{'xml'}, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-anchor => "w" );
#
# Create Text Entry list box.
#
$srbfilelabel->Entry(-textvariable => \$Global{'fdata'}, -width => 25 )
-> pack(-fill => 'x');
#
# Create list frame.
#
$slframe = $Global{'p4'}->LabFrame(-label => "DIRECTORY SCHEMA DATA",
-labelside => "acrosstop")
->pack( -fill => "both", -side => "top",
-expand => 1);
#
# Create a Clear Data Radiobutton that will execute subroutine clear
# to clear the List box before each directory query.
#
$selframe = $slframe -> LabFrame(-label => "DISPLAY SELECTED OBJECTS",
-labelside => "acrosstop" )
->pack( -side => $Global{'hand'},
-expand => 1, -fill => "both" );
$sellframe = $selframe->Frame( -borderwidth => 0,
-relief => "raised")->pack(
-fill => "both", -side => "top",
-padx => 0, -pady => 0);
$sellAll = $sellframe -> Checkbutton(-text => "ALL",
-variable => \$selectAll, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-side => "top", -anchor => 'w' );
$sellAll->select();
$sellObj = $sellframe -> Checkbutton(-text => "objectClasses",
-variable => \$selectObj, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-side => "top", -anchor => 'w' );
$sellMatch = $sellframe -> Checkbutton(-text => "matchingRules",
-variable => \$selectMatch, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-side => "top", -anchor => 'w' );
$sellAtt = $sellframe -> Checkbutton(-text => "attributeType",
-variable => \$selectAtt, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-side => "top", -anchor => 'w' );
$sellsyn = $sellframe -> Checkbutton(-text => "ldapsyntaxes",
-variable => \$selectSyn, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-side => "top", -anchor => 'w' );
$sellnf = $sellframe -> Checkbutton(-text => "nameforms",
-variable => \$selectNf, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-side => "top", -anchor => 'w' );
$selldsr = $sellframe -> Checkbutton(-text => "ditstructurerules",
-variable => \$selectDsr, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-side => "top", -anchor => 'w' );
$selldcr = $sellframe -> Checkbutton(-text => "ditcontentrules",
-variable => \$selectDcr, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-side => "top", -anchor => 'w' );
$sellmru = $sellframe -> Checkbutton(-text => "matchingruleuse",
-variable => \$selectMru, -onvalue => 1, -offvalue => 0,
-font => $Global{'Font'} )
-> pack(-side => "top", -anchor => 'w' );
$sellframe -> Button(-text => "SHOW HIERARCHIAL\nOBJECTCLASS TREE",
-command => \&Hierarchial, -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "bottom" );
#
# Create Clear Attribute Data and Search Directory buttons
#
$slframe ->Button(-text => " CLEAR DATA ",
-command => \&schema_clear, -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "bottom", -fill => "both", -padx => 5 );
#
# Create a ROText Box that will actually contain the
# returned directory data.
#
$schema_list = $slframe ->Scrolled('ROText', -scrollbars => 'se',
-width => 50, -height => 20, -wrap => 'none',
-font => $Global{'Font'} );
$schema_list->pack( -side => "bottom" );
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
} # End of subroutine initializeP4
#
# Initialize panel 5
#
sub initializeP5
{
$ldifframe = $Global{p5} ->LabFrame(-label => "LDIF FILE NAME")
->pack(-side => "top", -fill => "x");
#
# Create Text Entry list box.
#
$ldifframe->Entry(-textvariable => \$Global{'createLdifFile'},
-width => 25 )
-> pack(-fill => 'x');
#
# Create Create Ldif Entry button
#
$Global{createLdifEntry} = $ldifframe->Button(
-text => "CREATE/MODIFY ENTRY FROM LDIF FILE",
-command => \&ldapActionCreateLdifEntry,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "top", -anchor => "w", -padx => 5, -pady => 5 )
if ( !Exists($Global{createLdifEntry}));
$eframe = $Global{p5} ->Frame(-borderwidth => 2,-relief => "raised")
->pack(-side => "top", -anchor => 'e');
$cteframe = $eframe ->LabFrame(-label => "MANUALLY CREATE ENTRY")
->pack(-side => "top", -anchor => 'e');
#
# Create dn base button.
#
$dnmenu = $cteframe->Button( -text => " SELECT\nDN BASE",
-command => \&sbHlist, -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "right", -anchor => "e",
-padx => 5, -pady => 5 )
if ( !Exists($dnmenu));
#
# Create the search base box
#
$dnblist = $cteframe ->Listbox( -width => 40, -font => $Global{'Font'},
-height => 1 );
$dnblist->pack(-side => "right", -anchor => 'e', -padx => 5, -pady => 5 );
$dnblist->insert("end", $DN_BASE);
#
# create attribute action button
#
$cteframe->Button(-text => "Create The\nEntry",
-font => $Global{'Font'},
-borderwidth => 3,
-command => \&getObjectAttributes,
-relief => 'raised' ) ->pack();
} # End of subroutine initializeP5
#
# Initialize panel 5a
#
sub initializeP5a
{
my $ocs = $schemaHash{'ocs'};
my $obj = $schemaHash{'obj'};
my $tree = $schemaHash{'tree'};
my $schema = $schemaHash{'schema'};
my @tmpKeys;
my @must;
my @may;
my $colist;
$Global{ceObject} = {};
my $optr = 0;
#
# Create Hierarchial list box, this is where the objectclass data
# tree will be displayed.
#
$Global{'olist'} = $eframe->Scrolled('HList',
-font => $Global{'Font'},
-scrollbars => 'se',
-width => $Global{'max'},
-height => 20,
-itemtype => 'text',
-separator => $sepChar,
-selectmode => 'single',
-browsecmd => sub {
#
my $objects = shift;
my $oid;
my $colist;
my $ab;
#my @objectclasses = ();
my $objectclasses = [];
@$objectclasses = split(/$sepChar/,$objects);
$schema = $schemaHash{'schema'};
$colist = $Global{'colist'};
$obj = $schemaHash{'obj'};
$Global{entryData} = {};
$Global{entryData}->{objectClass} = [];
$Global{entryData}->{may} = [];
$Global{entryData}->{must} = [];
my $var = $$objectclasses[-1];
# foreach my $var (@var)
# {
if ( !(exists($Global{ceObject}->{$var})) )
{
#
# create attribute action button
#
$ab = $colist->Button(-text => $var,
-font => $Global{'Font'},
-borderwidth => 3,
-relief => 'raised' );
$Global{ceObject}->{$var} = [];
$Global{ceObject}->{$var}->[0] = $ab;
$Global{ceObject}->{$var}->[1] = $objects;
$colist->windowCreate("end", -window => $ab );
$ab->configure( -command => [ \&deleteObjectclass, \$ab, $var ] );
# position to the next row.
$colist->insert("end", "\n");
}
# }
} # End of subroutine browsecmd
) -> pack( -side => "top", -anchor => 'e')
if ( !Tk::Exists($Global{'olist'}) ) ; # End of Scrolled HList.
#
# Create a ROText Box that will contain the selected objectclass(s)
# for the new entry.
#
$Global{'colist'} = $eframe ->Scrolled('Text', -scrollbars => 'se',
-width => $Global{'max'}, -height => 20, -wrap => 'none',
-font => $Global{'Font'} )
->pack( -side => "top", -anchor => 'e' )
if ( !Tk::Exists($Global{'colist'}) ) ; # End of Scrolled HList.
#
# Create Hierarchial list box, this is where the objectclass data
# tree will be displayed.
#
#
#$Global{'colist'} = $eframe ->Listbox( -width => $Global{'max'},
# -height => 20 )
# -> pack( -side => "top", -anchor => 'e')
# if ( !Tk::Exists($Global{'colist'}) ) ; # End of Scrolled HList.
@tmpKeys = sort(keys(%$tree));
my $base;
$base = "";
#
# Create Hierarchial list box data tree,
# and display data.
#
eval{
foreach ( @tmpKeys )
{
if ( $$tree{$_} ->[0] == 0 )
{
$$tree{$_} ->[0] = 1;
$Global{'olist'}->add($_, -text=>$_); # do the base.
}
$base = $_;
$array = $$tree{$_};
$ptr = 0;
foreach my $var ( @$array )
{
if ( !$ptr )
{
$ptr = 1;
next;
}
$_ = $base . $sepChar . $var;
$Global{'olist'}->add($_, -text => $var);
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 1;
}
}
}
$Global{'olist'}->pack(-side => "right");
};
print "$@" if ( defined($@));
@tmpKeys = sort(keys(%$tree));
#
# Reset objectClass array.
#
foreach ( @tmpKeys )
{
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 0;
}
}
} # End of subroutine initializeP5a
sub histSearch_clear {
#
# Clear out text in List Box
#
$Global{'searchList'}->delete("1.0", "end");
} # End of clear subroutine
sub histSearch_cancel{
$Global{'searchList'}->destroy if Tk::Exists($Global{'searchList'});
$Global{'searchHList'}->destroy if Tk::Exists($Global{'searchHList'});
} # End of cancel subroutine
sub deleteObjectclass
{
my ($aba, $var) = @_;
my $ab;
my $colist = $Global{colist};
$ab = $Global{ceObject}->{$var}->[0];
$ab->destroy;
delete($Global{ceObject}->{$var});
#
# if no objects, clear the ROTEXT box.
#
$Global{colist}->delete("1.0","end")
if ( !(keys(%{$Global{ceObject}})) );
}
#
# Create the Search base window to display the
# search base tree.
#
sub createSearchBaseWindow
{
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
#
# Create Main Bind Window
#
$Global{'sbWindow'} = MainWindow->new;
$Global{'sbWindow'}->title("Select Search Base");
$Global{'sbWindow'}->geometry("+$x+$y");
#
# Create process accept button
#
$Global{'sbWindow'}->Button( -text => "ACCEPT SELECTED DN", -command => \&sbaccept,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
#
# Create process cancel button
#
$Global{'sbWindow'}->Button(-text => "CANCEL BASE CHANGE",
-command => \&sbcancel,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -padx => 5, -pady => 5 ) ;
my $sbdnframe = $Global{'sbWindow'}->Frame()
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
$Global{sbtree} = $sbdnframe->Scrolled("Tree",
-width => 50,
-height => 20,
-separator => $sepChar,
-indent => 35,
-scrollbars => 'sw',
-selectmod => 'single',
-browsecmd => sub {
my $objects = shift;
my %tree = %BASEDN;
$Global{SelectedDN} = $tree{$objects};
}
)->pack(-fill => "both", -expand => 1);
sub sbcancel
{
$Global{'sbWindow'}->withdraw if Tk::Exists($Global{'sbWindow'});
} # End of cancel subroutine
sub sbaccept
{
if ( exists($Global{SelectedDN}) )
{
$LDAP_SEARCH_BASE = $Global{SelectedDN};
$DN_BASE = $LDAP_SEARCH_BASE;
$sbblist->insert(0 , $LDAP_SEARCH_BASE);
$dnblist->insert(0 , $LDAP_SEARCH_BASE);
$Global{dsasbls}->insert(0, $LDAP_SEARCH_BASE)
if ( $Global{dsasbls} );
delete($Global{SelectedDN});
$Global{'sbWindow'}->withdraw if Tk::Exists($Global{'sbWindow'});
}
} # End of sbaccept subroutine
sub sbHlist
{
if (Tk::Exists($Global{'sbWindow'}))
{
$Global{'sbWindow'}->deiconify();
$Global{mainWindow}->update;
#$Global{'sbWindow'}->raise();
$Global{mainWindow}->update;
}
else
{
&createSearchBaseWindow();
&initTree();
}
}
} # End of createSearchBaseWindow subroutine
sub initTree
{
my $onvar;
my $bvar;
my $cvar;
my $t1v;
my $t1;
my $t2;
my $t2K;
my @t2Keys;
my $path;
my $size;
my $wack;
my $nvar;
my @keys = sort(keys(%Tree));
foreach $nvar (@keys)
{
$onvar = $nvar;
$t1v = $Tree{$nvar};
# print "t1 : " ,Dumper($t1v), "\n";
$Global{sbtree}->add($nvar, -text => $nvar);
foreach $bvar (@$t1v)
{
$cvar = canonical_dn($bvar, casefold => "lower" );
$adn = $cvar;
$cvar =~ s/$nvar//;
chop($cvar) if ($cvar =~ /,$/);
# print $bvar,"\n";
# print $cvar,"\n";
$path = "$nvar" . $sepChar;
$t1 = ldap_explode_dn($cvar, casefold => "lower" );
$size = @$t1;
# print "t1 size == $size\n";
while ($size > 1)
{
$t2 = pop(@$t1);
@t2Keys = keys(%$t2);
while (@t2Keys)
{
$t2K = shift( @t2Keys);
$t2size = @t2Keys;
$path .= "$t2K=$$t2{$t2K}";
$path .= "+" if ($t2size > 0 );
}
$path .= $sepChar;
$size = @$t1;
}
# chop($path) if ( $path =~ /\|$/ );
$text = "";
$t2 = pop(@$t1);
@t2Keys = keys(%$t2);
while (@t2Keys)
{
$wack = shift(@t2Keys);
$t2size = @$t2Keys;
$text .= "$wack=$$t2{$wack}";
$text .= "+" if ($t2size > 0 );
}
$path .= $text;
# print "path == $path\n";
# print "text == $text\n";
$path = $text if ( !length($path)) ;
$BASEDN{$path} = $adn;
$Global{sbtree}->add($path, -text => $text);
}
$Global{sbtree}->setmode($onvar,'close');
$Global{sbtree}->close($onvar);
}
$Global{sbtree}->autosetmode();
} # End of subroutine initTree
sub destroyTree
{
}
#
# Get the attributes of the selected objectClasses
#
sub getObjectAttributes
{
my $oid;
my $ahash;
my $alArray;
my @objectclasses = ();
my @tmp;
my $hash = $Global{ceObject};
my @hashKeys = keys(%$hash);
foreach my $hvar ( @hashKeys)
{
@tmp = split(/$sepChar/,$Global{ceObject}->{$hvar}->[1]);
foreach my $nvar (@tmp)
{
if ( !(grep(/$nvar/,@objectclasses)) )
{
push(@objectclasses,$nvar);
}
}
}
return if (!@objectclasses); # can not create an entry with no objectclass.
#
# If this is a posixAccount or shadowAccount, automatically put
# posixAccount, shadowAccount, and account as objectclasses for
# the new entry.
#
push(@objectclasses, "posixAccount")
if ( grep(/shadowAccount/,@objectclasses) &&
!( grep(/posixAccount/,@objectclasses) ) );
push(@objectclasses, "shadowAccount")
if ( grep(/posixAccount/,@objectclasses) &&
!( grep(/shadowAccount/,@objectclasses) ) );
push(@objectclasses, "account")
if ( grep(/shadowAccount/,@objectclasses) &&
grep(/posixAccount/,@objectclasses) &&
!( grep(/account/,@objectclasses) ) );
my $schema = $schemaHash{'schema'};
$obj = $schemaHash{'obj'};
$Global{entryData} = {};
$Global{entryData}->{objectClass} = [];
$Global{entryData}->{may} = [];
$Global{entryData}->{must} = [];
foreach my $var (@objectclasses)
{
$Global{mainWindow}->update;
$oid = $$obj{$var}->[0];
#
# Get the various other items associated with
# this objectclass.
#
my $ahash = $schema->objectclass( $oid );
#
# Get the objectclass name.
#
push( @{$Global{entryData}->{objectClass}},$$ahash{'name'});
if ( $$ahash{must} )
{
$alArray = $$ahash{must};
if ( ref($alArray) eq 'ARRAY' )
{
my $aMust = $Global{entryData}->{must};
foreach my $avar ( @$alArray )
{
push(@{$Global{entryData}->{must}}, $avar )
if ( !(grep(/$avar/,@$aMust)) );
}
}
else
{
push(@{$Global{entryData}->{must}}, $alArray )
if ( !(grep(/$alArray/,@{$Global{entryData}})) );
}
}
if ( $$ahash{may} )
{
$alArray = $$ahash{may};
if ( ref($alArray) eq 'ARRAY' )
{
my $aMay = $Global{entryData}->{may};
foreach my $avar ( @$alArray )
{
push(@{$Global{entryData}->{may}}, $avar )
if ( !(grep(/$avar/,@$aMay)) );
}
}
else
{
push(@{$Global{entryData}->{may}}, $alArray )
if ( !(grep(/$alArray/,@{$Global{entryData}})) );
}
}
}
&makeTheEntry;
} # End of subroutine getObjectAttributes
#
# Search the directory for data
#
sub search
{
my $mesg;
my $error;
my %opt = (
'd' => 0
);
$Global{mainWindow} -> Busy(-recurse => 1); # window is busy
#
# Destroy the dn history list if it exists.
#
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
#
# Parameter(s) to return
#
if ( $Global{'setVersion'} == 3 )
{
#
# Default to return everything.
#
$Global{att_wanted} = [ "*",
"aci",
"createTimeStamp",
"modifyTimeStamp",
"creatorsName",
"modifiersName" ];
}
else
{
#
#
# If you have only version 2 ldap servers you will need to
# to add the attributes that you want data returned for to
# this list.
#
#
$Global{att_wanted} = [ "cn" ,
"sn",
"mail",
"modifyTimeStamp",
"creatorsName",
"modifiersName" ];
}
#
# Set Filter options.
#
if ( $Global{'info'} eq "Filter" )
{
$match = $Global{'adata'};
}
else
{
if ( $Global{'infoFilter'} =~ /^equal$/ )
{
$match = "(" . $Global{'info'} . '=' . $Global{'adata'} . ")";
}
elsif ( $Global{'infoFilter'} =~ /^begins with$/ )
{
$match = "(" . $Global{'info'} . '=' . $Global{'adata'} . "*)";
}
elsif ( $Global{'infoFilter'} =~ /^ends with$/ )
{
$match = "(" . $Global{'info'} . '=*' . $Global{'adata'} . ")";
}
elsif ( $Global{'infoFilter'} =~ /^contains$/ )
{
$match = "(" . $Global{'info'} . '=*' . $Global{'adata'} . "*)";
}
else
{
$match = "(" . $Global{'info'} . '=' . $Global{'adata'} . ")";
}
}
$error = 0; # initialize error flag.
$Global{filter} = Net::LDAP::Filter->new($match) or $error = 1;
if ( $error == 1 )
{
$error = "Bad filter $match.";
ERROR(\$error);
$Global{mainWindow} -> Unbusy; # window is busy
return;
}
if ( !defined($Global{ldap}) )
{
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$error = "search $Global{dirConnError}";
ERROR(\$error);
}
else
{
ERROR($error);
}
$Global{mainWindow} -> Unbusy; # window is busy
return;
}
}
#
# Display the DN search results list box.
#
$msgbox->delete("0.0", "end");
$msgbox->update;
$Global{'records'} = 0; # initialize record count.
$Global{'searchResults'} = {}; # initialize results hash.
$mesg = $Global{ldap}->search(
base => $LDAP_SEARCH_BASE,
filter => $Global{filter},
attrs => $Global{att_wanted},
callback => \&print_entry,
);
if ( $mesg->code && $mesg->code != 48 )
{
ERROR($mesg->code);
}
#
# Create Hierarchial DN list box data tree,
# and display data.
#
eval
{
#
# Create the base point.
#
$Global{'searchHList'}->add($LDAP_SEARCH_BASE, -text=>$LDAP_SEARCH_BASE);
$results = $Global{'searchResults'};
@dnKeys = sort(keys(%$results));
#
# build the hierachical list using the DN
#
foreach my $dnvar ( @dnKeys )
{
$var = $$results{$dnvar}; # get entry data array
$shbase = $LDAP_SEARCH_BASE . $sepChar . $$var[0]; # create new leaf
$Global{'searchHList'}->add($shbase, -text => $$var[0]); # add leaf to tree.
}
$Global{'searchHList'}->pack(-side => "right");
}; # End of eval
ERROR( \$@ ) if ( $@ );
#
# Get and print out the record attributes.
#
sub print_entry {
my($mesg,$entry) = @_;
my @ref = ();
my $dn;
my $max;
my $data = [];
my $information = {};
if ( !defined($entry) )
{
return;
}
$dn = $entry->dn; # store the entry dn
++$Global{'records'};
$msgbox->delete("0.0", "end")
if ( !($Global{'records'} % 10 ));
$msgbox->update if ( !($Global{'records'} % 10 ));
$msgbox->insert("0.0", "Entries found: $Global{'records'}")
if ( !($Global{'records'} % 10 ));
$msgbox->update if ( !($Global{'records'} % 10 ));
#
#
#
@ref = $mesg->referrals();
if ( @ref )
{
foreach (@ref )
{
my $rvar = "LDAP Referral: $_";
ERROR(\$rvar);
}
}
else
{
#
# Get a list of record attributes
#
my @attrs = sort $entry->attributes;
$max = 0;
#
# Calculate each attribute`s text length.
# We use this to create a pretty print out in the
# List Box
#
foreach (@attrs) { $max = length($_) if length($_) > $max }
#
# Get attribute`s data
#
foreach (@attrs) {
# my $attr = $entry->get_value($_, asref => 1);
my $attr = [];
@$attr = $entry->get_value($_);
next unless $attr;
if ( /^jpegPhoto/i )
{
#
# record jpegPhoto data.
#
$encoded = encode_base64(@$attr[0]);
$$information{$_} = $encoded;
next;
}
$$information{$_} = $attr; # record ldap data
next;
}
}
push(@$data, $dn); # dn of entry
push(@$data, $max); # max attribute string lenght
push(@$data, $information);
${$Global{'searchResults'}}{$dn} = $data;
}
$Global{mainWindow} -> Unbusy; # window is not busy
} # End of search subroutine
sub AClear {
#
# Clear out text in Attribute Box
#
$Global{'adata'} = "";
} # End of AClear subroutine
#
# Change to a new directory server.
#
sub server
{
my $widget;
my $ptr;
my $mesg;
my $error;
$error = 0;
$currentPanel = $Global{nb} -> raised();
$Global{nb} -> raise('INFO');
$Global{ldap}->unbind if ( defined($Global{ldap}) );
$Global{ldap} = undef if ( defined($Global{ldap}) );
#
# Put directory server name in list box
#
$Global{'slist'}->insert(0 , $Global{'LDAP_SERVER'});
$sslist->insert(0 , $Global{'LDAP_SERVER'}) if ( Exists($sslist) ) ;
$Global{dsadsls}->insert(0, $Global{'LDAP_SERVER'})
if ( $Global{dsadsls} );
#
# Destroy the dn history list if it exists.
#
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
$Global{mainWindow} -> Busy(-recurse => 1); # window is busy
$Global{mainWindow} -> update; # Allow Tk to update
$ptr = 1;
%Tree = (); # Delete the old stuff.
%BASEDN = (); # Delete the old stuff.
@NcKeys = (); # Delete the old stuff.
$Global{'sbtree'}->delete("all");
$msgbox->delete("0.0", "end");
$msgbox->update();
$error = dirConn();
if ( !$error )
{
if ( $Global{'CORE_SERVER'} ne $Global{'LDAP_SERVER'} && defined($server{$Global{'LDAP_SERVER'}} ) )
{
# user defined base
my $t1 = [];
push(@$t1, getBases($Global{'LDAP_SERVER'}, $server{$Global{'LDAP_SERVER'}}));
$ncbase =~ tr/[A-Z]/[a-z]/;
$Tree{$ncbase} = $t1;
$BASEDN{$ncbase} = $ncbase;
}
elsif ( $Global{setVersion} == 3 )
{
my $entry;
# use root_dse to find the bases
$entry = $Global{ldap}->root_dse();
if ( defined($entry) )
{
my $attr = $entry->get_value('namingContexts', asref => 1);
if ( defined($attr) )
{
foreach my $ncbase ( @$attr )
{
$Global{mainWindow}->update;
my $t1 = [];
push(@$t1, getBases($Global{'LDAP_SERVER'}, $ncbase));
$ncbase =~ tr/[A-Z]/[a-z]/;
$Tree{$ncbase} = $t1;
$BASEDN{$ncbase} = $ncbase;
}
}
}
}
#
# Create the search base tree
#
&initTree();
@NcKeys = sort(keys(%Tree));
}
else
{
if ( defined($Global{dirConnError}) )
{
ERROR(\$Global{dirConnError});
$msgbox->insert("1", "$Global{dirConnError}");
$msgbox->update;
}
else
{
ERROR($error);
}
}
if ( @NcKeys)
{
$LDAP_SEARCH_BASE = shift (@NcKeys);
$DN_BASE = $LDAP_SEARCH_BASE;
}
else
{
$LDAP_SEARCH_BASE = "";
$DN_BASE = "";
}
$sbblist->insert(0 , $LDAP_SEARCH_BASE);
$dnblist->insert(0 , $LDAP_SEARCH_BASE);
$Global{dsasbls}->insert(0, $LDAP_SEARCH_BASE)
if ( $Global{dsasbls} );
$Global{'CORE_SERVER'} = $Global{'LDAP_SERVER'};
$Global{mainWindow} -> update; #
$Global{mainWindow} -> Unbusy; # window is not busy
$Global{nb} -> raise($currentPanel);
} # End of server subroutine
sub base {
#
# Put directory server search base into the list box.
#
$sbblist->insert(0 , $LDAP_SEARCH_BASE);
$Global{dsasbls}->insert(0, $LDAP_SEARCH_BASE)
if ( $Global{dsasbls} );
} # End of base subroutine
sub dnbase {
# Put dn base into the list box.
$dnblist->insert(0 , $DN_BASE);
} # End of dnbase subroutine
sub setFilter {
#
# Put search filter conditions into the list box.
#
$flclist->insert(0 , $Global{'infoFilter'});
} # End of setFilter subroutine
#
# Make the correction and bind to the directory server.
#
sub dirConn
{
my $error;
$error = 0;
$Global{dirConnError} = undef();
#
# Make the connection to the directory server
#
if ( $Global{port} == 636 || $Global{'setSSL'} )
{
$bindcommand = 'require Net::LDAPS; new Net::LDAPS( $Global{LDAP_SERVER}, timeout => 1, port => $Global{port}, debug => $opt{d} ) ';
if ( $Global{'platform'} eq 'MSWin32')
{
$error = "This program currently does not support SSL on Microsoft Windows systems.";
ERROR(\$error);
return 1;
}
$Global{ldap} = eval $bindcommand;
if ($@)
{
$msgbox->insert("0.0", $@) if ($@ && Tk::Exists($msgbox)) ;
return -1;
}
if ( !($Global{ldap}->isa('Net::LDAPS') ) )
{
$Global{dirConnError} = "LDAPS connection error to $Global{'LDAP_SERVER'}.";
return -1;
}
}
else
{
$Global{ldap} = new Net::LDAP( $Global{'LDAP_SERVER'},
timeout => 1,
port => $Global{port},
debug => $opt_d,
) or $error = 1;
if ( $error )
{
$Global{dirConnError} = "LDAP connection error to $Global{'LDAP_SERVER'}.";
return 1;
}
}
$mesg = $Global{ldap}->bind( password => "$Global{'bindpw'}",
dn => "$Global{'binddn'}",
version => $Global{'setVersion'},
);
if ( $mesg->code && $mesg->code != 48 )
{
# $errstr = $mesg->code;
# ERROR($errstr);
return $mesg->code;
}
return 0;
} # End of subroutine dirConn
#
# Connect and bind to the referral directory server
#
sub dirRConn
{
my ($url) = @_;
my $error;
$error = 0;
$Global{dirConnError} = undef();
#
# Make the connection to the directory server
#
if ( $Global{port} == 636 || $Global{'setSSL'} )
{
$bindcommand = 'require Net::LDAPS; new Net::LDAPS( $url, timeout => 1, debug => $opt{d} ) ';
if ( $Global{'platform'} eq 'MSWin32')
{
$error = "This program currently does not support SSL on Microsoft Windows systems.";
ERROR(\$error);
return 1;
}
$Global{rldap} = eval $bindcommand;
if ($@)
{
$msgbox->insert("0.0", $@) if ($@ && Tk::Exists($msgbox)) ;
return -1;
}
if ( !($Global{rldap}->isa('Net::LDAPS') ) )
{
$Global{dirConnError} = "LDAPS connection error to $url.";
return -1;
}
}
else
{
$Global{rldap} = new Net::LDAP( $url,
timeout => 1,
debug => $opt_d,
) or $error = 1;
if ( $error )
{
$Global{dirConnError} = "LDAP connection error to $url.";
return 1;
}
}
$mesg = $Global{rldap}->bind( password => "$Global{'bindpw'}",
dn => "$Global{'binddn'}",
version => $Global{'setVersion'},
);
if ( $mesg->code && $mesg->code != 48 )
{
# $errstr = $mesg->code;
# ERROR($errstr);
return $mesg->code;
}
return 0;
} # End of subroutine dirRConn
#
# Disconnect from the directory server.
#
sub dirRUConn
{
$Global{rldap}->disconnect;
delete($Global{rldap});
return 0;
} # End of subroutine dirRUConn
#
# Detect and record the sub-bases, or branches, of the directory.
#
sub getBases()
{
my $mesg;
my ( $host, $base ) = @_;
my @base = ();
my $ptr;
my $match;
my $error = 0; # initialize error flag.
if ( $Global{'nismapname'} )
{
#
# Solaris Native LDAP enabled
#
#$match = "(|(ou=*)(nismapname=*)(objectClass=organizationalUnit))"; #search only for ou entries.
$match = "(|(objectClass=nisMap)(objectClass=organizationalUnit)(objectClass=automountMap))"; #search only for ou entries.
}
else
{
$match = "(objectClass=organizationalUnit)"; #search only for ou entries.
}
my $f = Net::LDAP::Filter->new($match) or $error = 1;
if ( $error )
{
$error = "getBases subroutine Bad filter $match";
ERROR(\$error);
return @base;
}
$base[0] = $base;
$ptr = 0;
while ( $ptr < @base )
{
if ( @base < $Global{'limit'} )
{
$splashList->insert("1", "Searching $base")
if ( defined( $splash) );
$splash->update()
if ( defined( $splash) );
$msgbox->insert("0", "Searching $base")
if ( defined( $msgbox) );
$msgbox->update()
if ( defined( $msgbox) );
my @new_base = calBase($base, $f );
push(@base, @new_base);
}
$base = $base[++$ptr];
}
shift(@base); # get rid of the namingContext entry
return @base;
} # End of subroutine getBases()
sub calBase()
{
my ( $base, $f ) = @_;
my $mesg;
my $entry;
my $errstr;
my $error = 0;
my @new_base = ();
$mesg = $Global{ldap}->search(
base => $base,
filter => $f,
attrs => [ "cn","nismapname","automountMapName" ],
scope => "one",
);
#
# Check for an error on search
# Search call work, but there was an ldap error.
#
if ( $mesg->code && $mesg->code != 11 )
{
$errstr = $mesg->code;
ERROR($errstr);
return @new_base;
}
else
{
$entry = $mesg->entry;
return @new_base unless defined($entry);
$count = $mesg->count();
for($i = 0 ; $i < $count ; $i++)
{
my $entry = $mesg->entry($i);
$dn = $entry->dn;
$dn = canonical_dn($dn,casefold => "lower");
$dn =~ tr/[A-Z]/[a-z]/;
$_ = $dn;
#
# Record only dn that start with ou=, or in some cases nismapname.
# Normal entrys can be mixed in with these objects.
#
if ( $Global{'nismapname'} && ( /^ou=/ || /^nismapname/i || /^automountMapName/i ) )
{
push(@new_base, $dn); # record only dn that start with ou=
}
elsif ( /^ou=/ )
{
push(@new_base, $dn); # record only dn that start with ou=
}
}
return @new_base;
}
} # End of subroutine calBase()
#
# Determine new mainWindow position.
#
sub globalPos
{
my @pos;
@pos = split(/\+/,$Global{'mainWindow'}->geometry());
$Global{'horz'} = $pos[1];
$Global{'vert'} = $pos[2];
} # End of subrountine globalPos
sub root_cancel
{
$Global{'rootWindow'}->destroy if Tk::Exists($Global{'rootWindow'});
} # End of subrountine root_cancel
#
# Display jpegPhoto in separate window if Tk::JPEG is used.
#
sub displayPhoto
{
my ($picture, $dn) = @_;
my $jpegFile = $ENV{'TMP'} ."/jpegfile.$$";
#
# Store the jpeg data to a temp file.
#
open(TMP, "+>$jpegFile");
$| = 1;
print TMP $picture;
close(TMP);
if ( !-e "$jpegFile" )
{
my $str = "Could not create temporary jpeg file $jpegFile";
ERROR( \$str );
return;
}
#
# Create a TK window to display the jpeg picture.
#
my $mw = MainWindow->new();
$mw->title("JPEG PHOTO DISPLAY");
my $list = $mw ->Listbox( -height => 1, width => length($dn) );
$list->pack( -side => "top" );
$list->insert("end", $dn);
my $image = $mw->Photo(-file => $jpegFile, -format => "jpeg" );
$mw->Label(-image => $image)->pack(-expand => 1, -fill => 'both');
$mw->Button(-text => 'CLOSE WINDOW', -command => [destroy => $mw])->pack;
MainLoop;
unlink $jpegFile;
} # End of displayPhoto
#
# Create Main Error Window
#
sub ERROR {
my ($errcode ) = @_;
my $errmsg;
return if ($errcode == 48 && $Global{'setVersion'} == 3 ); # Anonymous bind error, not really an error.
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
if ( ref($errcode) )
{
$errmsg = $$errcode;
}
else {
$errmsg = ldap_error_text($errcode);
}
my @errmsg = split(/\n/,$errmsg);
#
# Create Main Error Window
#
if ( ! Exists($Global{'errorWindow'} ) )
{
$Global{'errorWindow'} = MainWindow->new;
$Global{'errorWindow'}->title("ERROR MESSAGES");
$Global{'errorWindow'}->geometry("+$x+$y");
#
# Create process dismiss button
#
$Global{'errorWindow'}->Button( -text => "DISMISS", -command => \&dismiss,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
$errlist = $Global{'errorWindow'} ->Scrolled(Listbox, -scrollbars => 'se',
-width => 70, -height => 10 );
$errlist->pack(-fill => "both", -expand => 1 );
}
$errlist->insert("end", "Error Code: $errcode") if ( !ref($errcode) );
$errlist->insert("end", "") if ( !ref($errcode) );
foreach my $msg ( @errmsg )
{
$errlist->insert("end", $msg);
}
sub dismiss{
$Global{'errorWindow'}->destroy() if Tk::Exists($Global{'errorWindow'});
$errlist = undef();
} # End of dismiss subroutine
} # End of ERROR subroutine
#
# LDAP Error check, some return codes are not really errors.
# You can retry the ldap action after waiting a while.
#
sub CheckError {
my ( $error ) = @_;
#
# Check for DSA busy or internal error
#
if ( $Global{loopCount} > 61 ) {
return 0; # return an error condition.
}
++$Global{loopCount}; # Increment the loop counter.
if ( $error =~ /too busy/ ||
$error =~ /Server encountered an internal error/ )
{
#
# DSA Busy.
#
sleep 1;
return 1; # No error, try again
}
else {
#
# DSA did not return "DSA busy" message
#
return 0; # error
}
} # End of subrountine CheckError
#
# Create Main Bind Window
#
sub BIND {
$dn_data = "";
$pw_data = "";
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
if ( !Tk::Exists( $Global{'bindWindow'} ) )
{
#
# Create Main Bind Window
#
$Global{'bindWindow'} = MainWindow->new;
$Global{'bindWindow'}->title("SET BIND CREDENTIALS");
$Global{'bindWindow'}->geometry("+$x+$y");
#
# Create process accept button
#
$Global{'bindWindow'}->Button( -text => "ACCEPT", -command => \&accept,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
#
# Create process cancel button
#
$Global{'bindWindow'}->Button(-text => "CANCEL", -command => \&cancel,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -padx => 5, -pady => 5 ) ;
my $binddnframe = $Global{'bindWindow'}->LabFrame(-label => "DN",
-labelside => "acrosstop")
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
#
# Create DN Entry text box.
#
$dn_data = $Global{binddn} if ( length($Global{binddn}) );
$binddnframe->Entry(-textvariable => \$dn_data, -width => 25 )
-> pack(-fill => 'x');
my $bindpwframe = $Global{'bindWindow'}->LabFrame(-label => "PASSWORD",
-labelside => "acrosstop")
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
#
# Create Password Entry text box.
#
$bindpwdata = $bindpwframe->Entry(-show => '*', -textvariable => \$pw_data,
-width => 25, -font => $Global{'Font'} )
-> pack(-fill => 'x');
$bindpwdata->bind('<Key-Return>' => \&accept );
sub cancel{
$Global{'bindWindow'}->destroy() if Tk::Exists($Global{'bindWindow'});
$Global{'bindWindow'} = undef();
} # End of cancel subroutine
sub accept{
my $mesg;
if (defined($Global{ldap}) )
{
#
# Connect to directory server
#
$mesg = $Global{ldap}->bind( password => "$pw_data",
dn => "$dn_data",
version => $Global{'setVersion'},
);
if ( $mesg->code && $mesg->code != 48 )
{
$errstr = $mesg->code;
ERROR($errstr);
}
else
{
$Global{'bindWindow'}->Busy(-recurse => 1);
$Global{'binddn'} = $dn_data;
$Global{'bindpw'} = $pw_data;
&server;
$Global{'bindWindow'}->Unbusy;
}
}
$Global{'bindWindow'}->destroy() if Tk::Exists($Global{'bindWindow'});
$Global{'bindWindow'} = undef();
} # End of accept subroutine
}
} # End of BIND subroutine
#
# Create Main Port Window
#
sub PORT {
$port_data = $Global{port};
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
#
# Create Main Port Window
#
$Global{'portWindow'} = MainWindow->new;
$Global{'portWindow'}->title("DIRECTORY PORT");
$Global{'portWindow'}->geometry("+$x+$y");
#
# Create process accept button
#
$Global{'portWindow'}->Button( -text => "ACCEPT", -command => \&portAccept,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
#
# Create process cancel button
#
$Global{'portWindow'}->Button(-text => "CANCEL", -command => \&portCancel,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -padx => 5, -pady => 5 ) ;
$Global{'portWindow'}->Label(-text => "Port 389 default")
->pack( -side => "top", -anchor => 'w', -pady => 1 );
$Global{'portWindow'}->Label(-text => "Port 636 ssl default")
->pack( -side => "top", -anchor => 'w', -pady => 1 );
#
# Create a ssl Checkbutton that will set up ssl variable
# to set ssl if not port 636.
#
#$Global{'portWindow'} -> Checkbutton(
# -text => "SSL connection",
# -variable => \$Global{'setSSL'},
# -font => $Global{'Font'} )
# -> pack(-side => "top", -anchor => "w" );
$PSSLstatus = $Global{'portWindow'} -> Label -> pack(-side => "top", -anchor => "w" );
if ( $Global{setSSL} )
{
$PSSLstatus->configure( -text => "SSL", -font => $Global{Font});
}
else
{
$PSSLstatus->configure(-text => "NON-SSL", -font => $Global{Font});
}
my $portframe = $Global{'portWindow'}->LabFrame(-label => "PORT",
-labelside => "acrosstop")
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 5 );
#
# Create Port Entry text box.
#
$portframe->Entry(-textvariable => \$port_data, -width => 10 )
-> pack(-fill => 'x');
sub portCancel{
$Global{'portWindow'}->destroy() if Tk::Exists($Global{'portWindow'});
$Global{'portWindow'} = undef();
} # End of cancel subroutine
sub portAccept{
$Global{port} = $port_data;
if ( $Global{setSSL} ) { $Global{sslport} = $port_data;}
else { $Global{nsslport} = $port_data;}
$Global{dsaptls}->insert(0, $Global{port});
$Global{'portWindow'}->destroy() if Tk::Exists($Global{'portWindow'});
$Global{'portWindow'} = undef();
} # End of accept subroutine
} # End of PORT subroutine
#
# Create Schema Display Window
#
sub print_loop()
{
my $list = shift;
my $ocs = shift;
my $Title = shift;
#my $method = shift;
my $asize;
my $ahash;
my $var;
foreach $ahash ( @$ocs)
{
$list->insert("end", "$Title\n");
#
# Get and display the data for this object
#
my @hkeys = keys(%$ahash);
foreach $var (@hkeys)
{
# Step thru the hash keys
next if ( $var =~ /type/); # do not care about type
$alArray = $$ahash{$var};
if ( ref($alArray) eq 'ARRAY' )
{
# it is a n array pointer so there is probably a list.
my $asize = @$alArray; # get the size of the list.
#
# if the array has size then print the array
# else ignore the array.
#
if ( $asize )
{
# Okay, there is something in the array.
$list->insert("end", "\t$var: ");
foreach $a ( @$alArray )
{
$list->insert("end", "$a ");
}
$list->insert("end", "\n");
}
}
else
{
# There is not an array
if ( $alArray == 1)
{
# it is just information attribute for the object
$list->insert("end", "\t$var\n");
}
else
{
$list->insert("end", "\t$var: $alArray\n");
}
}
}
}
} # End of subroutine print_loop
sub schema_clear {
#
# Clear out text in List Box
#
$schema_list->delete("1.0", "end");
} # End of clear subroutine
#
#
# Get the directory schema
#
sub schema
{
my $mesg;
my $error = 0;
$schemaHash{'obj'} = {};
$schemaHash{'tree'} = {};
$msgbox->insert("0.0", "Retrieving schema information.");
$msgbox->update;
&schema_clear();
$Global{'max'} = 0; # Reset objectclass name lenght.
my $dt = "/tmp/schema.dat.$$";
if ( ! defined($Global{ldap}) )
{
#
# Connect to directory server
#
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$schema_list->insert("end", "$Global{dirConnError}\n");
}
else
{
ERROR($error);
}
return;
}
}
#
# Get the schema, tries to read rootdse, if unable assumes cn=schema.
# This is NOT always the case.
#
$schema = undef();
my @items;
my @item;
my $dsml;
$schemaHash{'schema'} = $Global{ldap}->schema();
if ( defined($schemaHash{'schema'}) )
{
if ( $Global{'sfile'} && defined($schemaHash{'schema'}) )
{
if ( $Global{'xml'} )
{
#
# write XML text to file instead of text box
#
# @xml_data = ();
# $dsml = Net::LDAP::DSML->new( output => \@xml_data, pretty_print => 1 );
open(FXML, ">$Global{'fdata'}");
$dsml = Net::LDAP::DSML->new( output => *FXML, pretty_print => 1 );
$dsml->write_schema($schemaHash{'schema'});
$dsml->end_dsml;
close(FXML);
}
else
{
#
# write straight text to file instead of text box
#
$schemaHash{'schema'}->dump( $Global{'fdata'} );
}
$schema_list->insert("end",
"Schema data written to file: $Global{'fdata'}\n");
$Global{'sfile'} = 0;
$Global{'fdata'} = "";
$Global{'xml'} = 0;
return;
}
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
$ra_atts = [];
#
# Get the attributes
#
@$ra_atts = $schemaHash{'schema'}->all_attributes();
$schemaHash{'atts'} = $ra_atts;
#
# Display the attributes
#
if ( $selectAll || $selectAtt )
{
&print_loop($schema_list, $schemaHash{'atts'}, "attributeType")
if ( defined($schemaHash{'atts'}) );
}
$ra_atts = [];
#
# Get the schema objectclasses
#
@$ra_atts = $schemaHash{'schema'}->all_objectclasses();
$schemaHash{'ocs'} = $ra_atts;
#
# Calculate the text length of each objectclass string.
#
foreach my $var (@$ra_atts)
{
$Global{'max'} = length($$var{'name'})
if length($$var{'name'}) > $Global{'max'} ;
}
#
# Add 6 to the max objectclass string size,
# got to allow for graphics information.
#
$Global{'max'} += 6;
#
# Display the objectclasses
#
if ( $selectAll || $selectObj )
{
&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses")
if ( defined($schemaHash{'ocs'}) );
}
#
# Get the schema matchingrules
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_matchingrules();
$schemaHash{'mrs'} = $ra_atts;
#
# Display the matchingrules
#
if ( $selectAll || $selectMatch )
{
&print_loop($schema_list, $schemaHash{'mrs'}, "matchingRules" )
if ( defined($schemaHash{'mrs'}) );
}
#
# Get the schema matchingruleuse
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_matchingruleuses();
$schemaHash{'mru'} = $ra_atts;
#
# Display the matchingruleuse
#
if ( $selectAll || $selectMru )
{
&print_loop($schema_list, $schemaHash{'mru'}, "matchingRuleUse" )
if ( defined($schemaHash{'mru'}) );
}
#
# Get the schema ldapsyntaxes
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_syntaxes();
$schemaHash{'lsyn'} = $ra_atts;
#
# Display the ldapsyntaxes
#
if ( $selectAll || $selectSyn )
{
&print_loop($schema_list, $schemaHash{'lsyn'}, "ldapSyntax" )
if ( defined($schemaHash{'lsyn'}) );
}
#
# Get the schema nameForms
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_nameforms();
$schemaHash{'nfm'} = $ra_atts;
#
# Display the nameForms
#
if ( $selectAll || $selectNf )
{
&print_loop($schema_list, $schemaHash{'nfm'}, "nameForms" )
if ( defined($schemaHash{'nfm'}) );
}
#
# Get the schema ditstructurerules
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_ditstructurerules();
$schemaHash{'dits'} = $ra_atts;
#
# Display the ditstructurerules
#
if ( $selectAll || $selectDsr )
{
&print_loop($schema_list, $schemaHash{'dits'}, "ditstructurerules" )
if ( defined($schemaHash{'dits'}) );
}
#
# Get the schema ditcontentrules
#
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_ditcontentrules();
$schemaHash{'ditc'} = $ra_atts;
#
# Display the ditcontentrules
#
if ( $selectAll || $selectDcr )
{
&print_loop($schema_list, $schemaHash{'ditc'}, "ditcontentrules" )
if ( defined($schemaHash{'ditc'}) );
}
$Global{'max'} = 50 if ( $Global{'max'} > 50 );
&objTree(); # Create the objectClass tree
$Global{'olist'}->delete('all') if Tk::Exists($Global{'olist'});
$Global{mainWindow} -> update; # Allow Tk to update
&initializeP5a(); # Finish making panel 5
} # End of if ( defined($schema) )
else
{
$schema_list->insert("end", "The schema object was return undefined.\n");
$schema_list->insert("end", "There are several problems that can cause\n");
$schema_list->insert("end", "this situation.\n");
$schema_list->insert("end", "1. Your server may require you to be bound\n");
$schema_list->insert("end", " to the directory as the directory\n");
$schema_list->insert("end", " administrator. Bind to the directory\n");
$schema_list->insert("end", " as the directory administrator and \n");
$schema_list->insert("end", " retry pulling the schema data.\n");
$schema_list->insert("end", "\n");
$schema_list->insert("end", "2. Your server is a version 2 LDAP server\n");
$schema_list->insert("end", " or the version 3 LDAP radio button is in\n");
$schema_list->insert("end", " the version 2 position. Version 2 LDAP\n");
$schema_list->insert("end", " servers will not return schema data.\n");
}
} # End of schema subroutine
sub objTree
{
my $ocs = $schemaHash{'ocs'};
my $obj = $schemaHash{'obj'};
#$schemaHash{'tree'} = {};
my $tree = $schemaHash{'tree'};
my $schema = $schemaHash{'schema'};
my @tmpKeys;
my $size;
my $Path;
my $done;
my @sup;
my @name;
my $name;
my $SUP;
my $array;
if ( !defined($ocs) || !defined($tree) ||
!defined($obj) || !defined($schema) )
{
#
# No schema data available
#
my $error = "LDAP Schema data is not available.";
ERROR(\$error);
return;
}
#
# Get the schema objectClasses
#
foreach my $aobj ( @$ocs)
{
#
# Get the oid number of the objectclass.
#
my $oid;
undef($oid);
$oid = $$aobj{'oid'};
next if ( !defined($oid) );
@sup = $$aobj{'sup'}[0];
@name = $$aobj{'name'};
$$obj{"$name[0]"} = [ "$oid", "$sup[0]" ]; # store data
}
#
# get objectclass hash keys.
#
@tmpKeys = sort(keys(%$obj)) if (defined($$obj{'top'}));
$$tree{'top'} = [0,]; # pre-load top objectclass.
foreach (@tmpKeys)
{
next if ( $_ eq "" || $_ eq "top" );
$done = 0; # initialize done flag
$Path = ""; # initialize objectclass Path
$name = $_;
while ( !$done )
{
$SUP = $$obj{$_}->[1]; # get current objectclass's superior
$SUP = "top" if ( $SUP eq "" ); # on null superior, make top superior
if ( $Path eq "" )
{
$Path = $SUP; # Start objectclass path.
}
else
{
$Path = $SUP . $sepChar . $Path; # add new objectclass to path.
}
$done = 1 if ( $SUP eq 'top' ) ; # when we reach objectclass top we are done.
$_ = $SUP; # walk back up the chain
}
if ( defined($$tree{$Path}) )
{
#
# Path key has already been initialized, add current objectclass
# to list.
#
$array = $$tree{$Path};
push(@$array,$name);
}
else
{
#
# Path key needs to be initialized, add current objectclass
# to list.
#
$$tree{$Path} = [0, "$name"];
}
}
#
# Allow mainWindow to update
#
$Global{'mainWindow'}->update;
}
sub Hierarchial
{
&globalPos();
my $x = $Global{'horz'};
my $y = $Global{'vert'} + 200 ;
my $ocs = $schemaHash{'ocs'};
my $obj = $schemaHash{'obj'};
my $tree = $schemaHash{'tree'};
my $schema = $schemaHash{'schema'};
my @tmpKeys;
my $size;
my $Path;
my $done;
my @sup;
my @name;
my $name;
my $SUP;
my $array;
#
# Set up the Tk windows.
#
#
if ( ! Exists($Global{'histWindow'} ) )
{
eval
{
$Global{'histWindow'} = MainWindow->new();
$Global{'histWindow'}->title("HIERARCHICAL OBJECTCLASS DISPLAY WINDOW");
};
ERROR(\$@) if ( $@ );
}
else
{
my $wstate = $Global{'histWindow'}->state();
if ( $wstate =~ /iconic/ || $wstate =~ /withdrawn/ )
{
$Global{'histWindow'}->deiconify()
if Tk::Exists($Global{'histWindow'});
$Global{'histWindow'}->raise()
if Tk::Exists($Global{'histWindow'});
}
}
$Global{'histWindow'}->geometry("+$x+$y");
#
# Create label box
#
if ( !Exists($Global{'label'}) )
{
$Global{'label'} = $Global{'histWindow'}->Label()->pack;
}
$hbutton = $Global{'histWindow'}->Button(
-text => "CLOSE HIERARCHICAL DISPLAY WINDOW",
-command => \&hist_cancel, -font => $Global{'Font'},
-borderwidth => 5 )
-> pack(-fill => "both", -padx => 2, -pady => 2 )
if ( Exists($Global{'histWindow'} ) &&
!Exists($hbutton ) );
#
# Create list box, this is where the selected objectclass data will
# be displayed.
#
if ( !Exists($Global{'list'}) )
{
$Global{'list'} = $Global{'histWindow'}->Scrolled('ROText',
-scrollbars => 'se', -width=>50, -wrap => "none",
-font => $Global{'Font'}, -height => 20 )
->pack(-side => "left");
}
#
# Create Hierarchial list box, this is where the objectclass data
# tree will be displayed.
#
if ( !Exists($Global{'hlist'}) )
{
$Global{'hlist'} = $Global{'histWindow'}->Scrolled('HList',
-font => $Global{'Font'},
-scrollbars => 'se',
-width => $Global{'max'},
-height => 20,
-itemtype => 'text',
-separator => $sepChar,
-selectmode => 'single',
-browsecmd => sub {
#
my $objects = shift;
my $oid;
my @objectclasses = ();
@objectclasses = split(/$sepChar/,$objects);
$Global{'list'}->delete("1.0", "end");
$Global{'label'}->configure(-text=>$objects);
$Global{'list'}->insert("end", " \n");
foreach my $var (@objectclasses)
{
$Global{mainWindow}->update;
$oid = $$obj{$var}->[0];
#
# Get the various other items associated with
# this objectclass.
#
my $ahash = $schema->objectclass( $oid );
my @hkeys = sort(keys(%$ahash));
#
# Get and display the objectclass name.
#
$alArray = $$ahash{'name'};
$Global{'list'}->insert("end", "name: $alArray\n");
foreach $varr (@hkeys)
{
# Step thru the hash keys
next if ( $varr =~ /name/); # already done name.
next if ( $varr =~ /type/); # do not care about type
$alArray = $$ahash{$varr};
if ( ref($alArray) eq 'ARRAY' )
{
# it is a n array pointer so there is probably a list.
my $asize = @$alArray; # get the size of the list.
#
# if the array has size then print the array
# else ignore the array.
#
if ( $asize )
{
# Okay, there is something in the array.
$Global{'list'}->insert("end", "\t$varr: ");
foreach $a ( @$alArray )
{
$Global{'list'}->insert("end", "$a ");
}
$Global{'list'}->insert("end", "\n");
}
}
else
{
# It is not an array
if ( $alArray == 1)
{
# it is just and information attribute for the object
$Global{'list'}->insert("end", "\t$varr\n");
}
else
{
$Global{'list'}->insert("end", "\t$varr: $alArray\n");
}
}
}
$Global{'list'}->insert("end", " \n");
$Global{'list'}->insert("end", "--------------------------------------------------\n");
$Global{'list'}->insert("end", " \n");
}
} # End of subroutine browsecmd
); # End of Scrolled HList.
@tmpKeys = sort(keys(%$tree));
my $base;
$base = "";
#
# Create Hierarchial list box data tree,
# and display data.
#
eval{
foreach ( @tmpKeys )
{
if ( $$tree{$_} ->[0] == 0 )
{
$$tree{$_} ->[0] = 1;
$Global{'hlist'}->add($_, -text=>$_); # do the base.
}
$base = $_;
$array = $$tree{$_};
$ptr = 0;
foreach my $var ( @$array )
{
if ( !$ptr )
{
$ptr = 1;
next;
}
$_ = $base . $sepChar . $var;
$Global{'hlist'}->add($_, -text => $var);
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 1;
}
}
}
$Global{'hlist'}->pack(-side => "right");
};
print "$@" if ( defined($@));
@tmpKeys = sort(keys(%$tree));
#
# Reset objectClass array.
#
foreach ( @tmpKeys )
{
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 0;
}
}
}
sub hist_clear {
#
# Clear out text in List Box
#
$Global{'list'}->delete("1.0", "end");
} # End of clear subroutine
sub hist_cancel{
$Global{'list'}->destroy if Tk::Exists($Global{'list'});
$Global{'hlist'}->destroy if Tk::Exists($Global{'hlist'});
$Global{'histWindow'}->destroy if Tk::Exists($Global{'histWindow'});
} # End of cancel subroutine
} # End of subroutine Hierarchial
#
# Create Accept/Cancel Window
#
sub questionAction {
&globalPos();
my $x = $Global{'horz'} + 0;
my $y = $Global{'vert'} + 50;
#
# Create Main Window
#
$Global{'answerWindow'} = MainWindow->new;
$Global{'answerWindow'}->title("CONFIRM DECISION");
$Global{'answerWindow'}->geometry("+$x+$y");
#
# Create process accept button
#
$Global{'answerWindow'}->Button( -text => "ACCEPT", -command => \&doAction,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
#
# Create process cancel button
#
$Global{'answerWindow'}->Button(-text => "CANCEL", -command => \&cancelAction,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -padx => 5, -pady => 5 ) ;
sub cancelAction{
$Global{'answerWindow'}->destroy() if Tk::Exists($Global{'answerWindow'});
delete($Global{'answerWindow'});
} # End of cancel subroutine
sub doAction{
$Global{'answerWindow'}->destroy() if Tk::Exists($Global{'answerWindow'});
delete($Global{'answerWindow'});
$Global{'searchHistWindow'}->destroy if Tk::Exists($Global{'searchHistWindow'});
$Global{'searchHistWindow'} = undef();
&ldapActionDelete; # Delete the entry from the directory
} # End of accept subroutine
} # End of questionAction subroutine
#
# Create ldapAction Window
#
sub ldapAction
{
$Global{'ldapActionDN'} = shift;
$Global{actionDelete}->configure( -state => 'normal');
$Global{actionDisplay}->configure( -state => 'normal');
$Global{actionEdit}->configure( -state => 'normal');
$Global{actionRename}->configure( -state => 'normal');
$Global{actionLdif}->configure( -state => 'normal');
$Global{actionCancel}->configure( -state => 'normal');
} # End of ldapAction subroutine
sub ldapActionCancel{
delete(