use Carp;
use Data::Dumper;
use MIME::Base64;
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/;
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 ( $@ );
$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; $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";
getopts( 'hnrd:i:' );
Usage() if ( $opt_h );
my $debug = $opt_n ? 1 : 0;
if ( !$debug && $Global{'platform'} eq 'unix' ) {
FORK: {
if ( $pid = fork ) {
exit;
}
elsif ( defined $pid) {
&MAIN_PROCESS();
}
}
} else {
&MAIN_PROCESS();
}
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;
$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");
$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;} );
$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'});
$smenu = $mwf -> Menubutton(-text => "SELECT SERVER",
-relief => "raised", -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "left", -pady => 2, -padx => 5 );
$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});
}
$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});
}
$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);
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;} ],
];
}
sub update_schema
{
if ( $Global{schemaServer} ne $Global{CORE_SERVER} )
{
$Global{mainWindow} -> Busy(-recurse => 1); $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; }
}
sub init_schemaHash
{
$schemaHash{ 'schema' } = undef();
$schemaHash{ 'obj' } = {};
$schemaHash{ 'tree' } = {};
$schemaHash{ 'atts' } = [];
$schemaHash{ 'ocs' } = [];
$schemaHash{ 'mrs' } = [];
$schemaHash{ 'nfm' } = [];
$schemaHash{ 'lsyn' } = [];
$schemaHash{ 'dits' } = [];
$schemaHash{ 'ditc' } = [];
$schemaHash{ 'mru' } = [];
}
sub setSSL
{
$Global{setSSL} = 1;
$Global{port} = $Global{sslport};
$SSLstatus->configure( -text => "SSL", -font => $Global{Font});
}
sub nonSSL
{
$Global{setSSL} = 0;
$Global{port} = $Global{nsslport};
$SSLstatus->configure(-text => "NON-SSL", -font => $Global{Font});
}
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});
}
}
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});
}
}
sub saveLdif
{
$Global{'saveLdifck'} -> select;
$Global{'saveXmlck'} -> deselect;
}
sub saveXml
{
$Global{'saveXmlck'} -> select;
$Global{'saveLdifck'} -> deselect;
}
sub initializeProgram
{
if ( $Global{'platform'} eq 'unix' )
{
$ENV{'TMP'} = "/tmp";
}
else
{
$ENV{'TMP'} = "./";
}
@dotfile = ();
push(@dotfile,$opt_i) if $opt_i;
if ( !$ENV{HOME} )
{
$ENV{"HOME"} = ".";
}
if ( !$ENV{PWD} )
{
$ENV{PWD} = ".";
}
push( @dotfile, "$ENV{HOME}/.tklkup");
push( @dotfile, "$ENV{PWD}/.tklkup");
foreach (@dotfile)
{
if ( -e $_ && -r $_ )
{
$dotfile = $_;
last;
}
}
if ( -e $dotfile && -r $dotfile )
{
open(DOT, "<$dotfile");
@Input = <DOT>;
foreach (@Input)
{
my @data = ();
if ( /^
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);
}
}
close(DOT);
}
if ( defined($opt_r) ) {
$Global{'hand'} = $opt_r ? 'right' : 'left';
}
if ( $#attribute < 1 )
{
@attribute = qw/ uid sn cn rfc822mailbox telephonenumber
facsimiletelephonenumber gidnumber uidnumber/;
}
push(@attribute,"Filter");
}
sub initializeBases
{
if ( @server < 1 )
{
$server[0] = "ldap.umich.edu";
}
$Global{'LDAP_SERVER'} = $server[0];
$Global{'CORE_SERVER'} = $Global{'LDAP_SERVER'};
$error = &dirConn();
if ( !$error )
{
if ( !$error || $Global{setVersion} )
{
if ( defined($server{$server[0]}) )
{
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;
@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 = "";
}
}
sub initializeP1
{
$dsaframe = $Global{p1}->Frame()
->pack( -fill => "both", -side => "top" );
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" );
$Global{'mainWindow'}->update;
}
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");
$sbbframe = $hlframe->LabFrame(-label => "DIRECTORY SEARCH BASE",
-labelside => "acrosstop")
->pack( -side => "top", -anchor => "e");
$ltframe = $tpframe ->Frame()
->pack( -side => "left", -fill => "both");
$aframe = $ltframe ->LabFrame(-label => "FILTER\nATTRIBUTES",
-labelside => "acrosstop",
-relief => "raised")
->pack( -side => "top", -fill => "both");
$fmtframe = $ltframe ->LabFrame( -label => "SAVE FORMAT",
-labelside => "acrosstop",
-relief => "raised")
->pack( -side => "top", -fill => "both");
$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();
$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");
$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} );
$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));
$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;
&ldapAction($objects);
}
);
$Global{'searchHList'}->pack(-side => "right");
$amenu = $aframe -> Menubutton(-text => " SELECT\n ADDITIONAL\n ATTRIBUTES",
-relief => "raised", -font => $Global{'Font'},
-borderwidth => 3 )
-> pack( -side => "top", -anchor => "w" );
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(); } ++$sptr;
}
} else
{
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(); }
++$sptr;
}
}
foreach (@attribute)
{
$amenu->radiobutton( -label => $_, -variable => \$Global{'info'},
-value => $_, -font => $Global{'Font'});
}
$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}));
$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}));
$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}));
$Global{actionEdit} = $btframe->Button(-text => " EDIT ",
-command => \&ldapActionEdit,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionEdit}));
$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}));
$Global{actionCancel} = $btframe->Button(-text => "CANCEL ",
-command => \&ldapActionCancel,
-font => $Global{'Font'}, -borderwidth => 3)
-> pack(-side => "top", -anchor => "w", -padx => 1 )
if ( !Exists($Global{actionCancel}));
$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");
$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} );
$tframe = $bmframe->LabFrame(-label => "FILTER DATA",
-labelside => "acrosstop")
->pack( -fill => "both", -side => "bottom" , -anchor => "w");
$tframe_text = $tframe->Entry(-textvariable => \$Global{'adata'}, -width => 27 )
-> pack(-side => "left",-anchor => "w", );
$tframe_text->bind('<Key-Return>' => \&search );
$tframe -> Button(-text => "CLEAR FILTER DATA", -command => \&AClear,
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack( -side => "left", -anchor => "w", -pady => 2, -padx => 2 );
$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'});
$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 );
$bmframe -> Button(-text => "SEARCH THE DIRECTORY",
-command => \&search,
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack( -side => "bottom", -fill => "both");
$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');
$Global{'mainWindow'}->update;
}
sub initializeP3
{
my $cframe;
my $lframe;
my $rbclear;
$cframe = $Global{p3}->Frame()
->pack( -fill => "both", -side => "bottom", -padx => 5, -pady => 2);
$cframe -> Button(-text => " CLEAR DATA ",
-command => \&display_clear, -font => $Global{'Font'},
-borderwidth => 3 )
->pack( -fill => 'both' );
$lframe = $Global{p3}->LabFrame(-label => "DIRECTORY DATA",
-labelside => "acrosstop" )
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
-expand => 1);
$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();
$list = $lframe ->Scrolled('ROText', -scrollbars => 'se',
-width => 80, -height => 20, -wrap => 'none',
-font => $Global{'Font'} );
$list->pack(-fill => "both", -expand => 1 );
$Global{'mainWindow'}->update;
}
sub initializeP4
{
my $srbclear;
my $srbfile;
my $srbfilelabel;
my $slframe;
my $ssframe;
my $sbbframe;
my $aframe;
my $tframe;
my $sbframe;
$sbframe = $Global{'p4'}->Frame( -borderwidth => 2,
-relief => "raised")->pack(
-fill => "both", -side => "bottom",
-padx => 2);
$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" );
$srbfilelabel->Entry(-textvariable => \$Global{'fdata'}, -width => 25 )
-> pack(-fill => 'x');
$slframe = $Global{'p4'}->LabFrame(-label => "DIRECTORY SCHEMA DATA",
-labelside => "acrosstop")
->pack( -fill => "both", -side => "top",
-expand => 1);
$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" );
$slframe ->Button(-text => " CLEAR DATA ",
-command => \&schema_clear, -font => $Global{'Font'},
-borderwidth => 3 )
-> pack(-side => "bottom", -fill => "both", -padx => 5 );
$schema_list = $slframe ->Scrolled('ROText', -scrollbars => 'se',
-width => 50, -height => 20, -wrap => 'none',
-font => $Global{'Font'} );
$schema_list->pack( -side => "bottom" );
$Global{'mainWindow'}->update;
}
sub initializeP5
{
$ldifframe = $Global{p5} ->LabFrame(-label => "LDIF FILE NAME")
->pack(-side => "top", -fill => "x");
$ldifframe->Entry(-textvariable => \$Global{'createLdifFile'},
-width => 25 )
-> pack(-fill => 'x');
$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');
$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));
$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);
$cteframe->Button(-text => "Create The\nEntry",
-font => $Global{'Font'},
-borderwidth => 3,
-command => \&getObjectAttributes,
-relief => 'raised' ) ->pack();
}
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;
$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 = [];
@$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];
if ( !(exists($Global{ceObject}->{$var})) )
{
$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 ] );
$colist->insert("end", "\n");
}
}
) -> pack( -side => "top", -anchor => 'e')
if ( !Tk::Exists($Global{'olist'}) ) ;
$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'}) ) ;
@tmpKeys = sort(keys(%$tree));
my $base;
$base = "";
eval{
foreach ( @tmpKeys )
{
if ( $$tree{$_} ->[0] == 0 )
{
$$tree{$_} ->[0] = 1;
$Global{'olist'}->add($_, -text=>$_); }
$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));
foreach ( @tmpKeys )
{
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 0;
}
}
}
sub histSearch_clear {
$Global{'searchList'}->delete("1.0", "end");
}
sub histSearch_cancel{
$Global{'searchList'}->destroy if Tk::Exists($Global{'searchList'});
$Global{'searchHList'}->destroy if Tk::Exists($Global{'searchHList'});
}
sub deleteObjectclass
{
my ($aba, $var) = @_;
my $ab;
my $colist = $Global{colist};
$ab = $Global{ceObject}->{$var}->[0];
$ab->destroy;
delete($Global{ceObject}->{$var});
$Global{colist}->delete("1.0","end")
if ( !(keys(%{$Global{ceObject}})) );
}
sub createSearchBaseWindow
{
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
$Global{'sbWindow'} = MainWindow->new;
$Global{'sbWindow'}->title("Select Search Base");
$Global{'sbWindow'}->geometry("+$x+$y");
$Global{'sbWindow'}->Button( -text => "ACCEPT SELECTED DN", -command => \&sbaccept,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
$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'});
}
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'});
}
}
sub sbHlist
{
if (Tk::Exists($Global{'sbWindow'}))
{
$Global{'sbWindow'}->deiconify();
$Global{mainWindow}->update;
$Global{mainWindow}->update;
}
else
{
&createSearchBaseWindow();
&initTree();
}
}
}
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};
$Global{sbtree}->add($nvar, -text => $nvar);
foreach $bvar (@$t1v)
{
$cvar = canonical_dn($bvar, casefold => "lower" );
$adn = $cvar;
$cvar =~ s/$nvar//;
chop($cvar) if ($cvar =~ /,$/);
$path = "$nvar" . $sepChar;
$t1 = ldap_explode_dn($cvar, casefold => "lower" );
$size = @$t1;
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;
}
$text = "";
$t2 = pop(@$t1);
@t2Keys = keys(%$t2);
while (@t2Keys)
{
$wack = shift(@t2Keys);
$t2size = @$t2Keys;
$text .= "$wack=$$t2{$wack}";
$text .= "+" if ($t2size > 0 );
}
$path .= $text;
$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();
}
sub destroyTree
{
}
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);
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];
my $ahash = $schema->objectclass( $oid );
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;
}
sub search
{
my $mesg;
my $error;
my %opt = (
'd' => 0
);
$Global{mainWindow} -> Busy(-recurse => 1); $Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
if ( $Global{'setVersion'} == 3 )
{
$Global{att_wanted} = [ "*",
"aci",
"createTimeStamp",
"modifyTimeStamp",
"creatorsName",
"modifiersName" ];
}
else
{
$Global{att_wanted} = [ "cn" ,
"sn",
"mail",
"modifyTimeStamp",
"creatorsName",
"modifiersName" ];
}
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;
$Global{filter} = Net::LDAP::Filter->new($match) or $error = 1;
if ( $error == 1 )
{
$error = "Bad filter $match.";
ERROR(\$error);
$Global{mainWindow} -> Unbusy; 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; return;
}
}
$msgbox->delete("0.0", "end");
$msgbox->update;
$Global{'records'} = 0; $Global{'searchResults'} = {};
$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);
}
eval
{
$Global{'searchHList'}->add($LDAP_SEARCH_BASE, -text=>$LDAP_SEARCH_BASE);
$results = $Global{'searchResults'};
@dnKeys = sort(keys(%$results));
foreach my $dnvar ( @dnKeys )
{
$var = $$results{$dnvar}; $shbase = $LDAP_SEARCH_BASE . $sepChar . $$var[0]; $Global{'searchHList'}->add($shbase, -text => $$var[0]); }
$Global{'searchHList'}->pack(-side => "right");
};
ERROR( \$@ ) if ( $@ );
sub print_entry {
my($mesg,$entry) = @_;
my @ref = ();
my $dn;
my $max;
my $data = [];
my $information = {};
if ( !defined($entry) )
{
return;
}
$dn = $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
{
my @attrs = sort $entry->attributes;
$max = 0;
foreach (@attrs) { $max = length($_) if length($_) > $max }
foreach (@attrs) {
my $attr = [];
@$attr = $entry->get_value($_);
next unless $attr;
if ( /^jpegPhoto/i )
{
$encoded = encode_base64(@$attr[0]);
$$information{$_} = $encoded;
next;
}
$$information{$_} = $attr;
next;
}
}
push(@$data, $dn); push(@$data, $max); push(@$data, $information);
${$Global{'searchResults'}}{$dn} = $data;
}
$Global{mainWindow} -> Unbusy; }
sub AClear {
$Global{'adata'} = "";
}
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}) );
$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} );
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
$Global{mainWindow} -> Busy(-recurse => 1); $Global{mainWindow} -> update;
$ptr = 1;
%Tree = (); %BASEDN = (); @NcKeys = (); $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'}} ) )
{
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;
$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;
}
}
}
}
&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; $Global{nb} -> raise($currentPanel);
}
sub base {
$sbblist->insert(0 , $LDAP_SEARCH_BASE);
$Global{dsasbls}->insert(0, $LDAP_SEARCH_BASE)
if ( $Global{dsasbls} );
}
sub dnbase {
$dnblist->insert(0 , $DN_BASE);
}
sub setFilter {
$flclist->insert(0 , $Global{'infoFilter'});
}
sub dirConn
{
my $error;
$error = 0;
$Global{dirConnError} = undef();
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 )
{
return $mesg->code;
}
return 0;
}
sub dirRConn
{
my ($url) = @_;
my $error;
$error = 0;
$Global{dirConnError} = undef();
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 )
{
return $mesg->code;
}
return 0;
}
sub dirRUConn
{
$Global{rldap}->disconnect;
delete($Global{rldap});
return 0;
}
sub getBases()
{
my $mesg;
my ( $host, $base ) = @_;
my @base = ();
my $ptr;
my $match;
my $error = 0;
if ( $Global{'nismapname'} )
{
$match = "(|(objectClass=nisMap)(objectClass=organizationalUnit)(objectClass=automountMap))"; }
else
{
$match = "(objectClass=organizationalUnit)"; }
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); return @base;
}
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",
);
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;
if ( $Global{'nismapname'} && ( /^ou=/ || /^nismapname/i || /^automountMapName/i ) )
{
push(@new_base, $dn); }
elsif ( /^ou=/ )
{
push(@new_base, $dn); }
}
return @new_base;
}
}
sub globalPos
{
my @pos;
@pos = split(/\+/,$Global{'mainWindow'}->geometry());
$Global{'horz'} = $pos[1];
$Global{'vert'} = $pos[2];
}
sub root_cancel
{
$Global{'rootWindow'}->destroy if Tk::Exists($Global{'rootWindow'});
}
sub displayPhoto
{
my ($picture, $dn) = @_;
my $jpegFile = $ENV{'TMP'} ."/jpegfile.$$";
open(TMP, "+>$jpegFile");
$| = 1;
print TMP $picture;
close(TMP);
if ( !-e "$jpegFile" )
{
my $str = "Could not create temporary jpeg file $jpegFile";
ERROR( \$str );
return;
}
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;
}
sub ERROR {
my ($errcode ) = @_;
my $errmsg;
return if ($errcode == 48 && $Global{'setVersion'} == 3 );
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);
if ( ! Exists($Global{'errorWindow'} ) )
{
$Global{'errorWindow'} = MainWindow->new;
$Global{'errorWindow'}->title("ERROR MESSAGES");
$Global{'errorWindow'}->geometry("+$x+$y");
$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();
}
}
sub CheckError {
my ( $error ) = @_;
if ( $Global{loopCount} > 61 ) {
return 0; }
++$Global{loopCount};
if ( $error =~ /too busy/ ||
$error =~ /Server encountered an internal error/ )
{
sleep 1;
return 1; }
else {
return 0;
}
}
sub BIND {
$dn_data = "";
$pw_data = "";
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
if ( !Tk::Exists( $Global{'bindWindow'} ) )
{
$Global{'bindWindow'} = MainWindow->new;
$Global{'bindWindow'}->title("SET BIND CREDENTIALS");
$Global{'bindWindow'}->geometry("+$x+$y");
$Global{'bindWindow'}->Button( -text => "ACCEPT", -command => \&accept,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
$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 );
$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 );
$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();
}
sub accept{
my $mesg;
if (defined($Global{ldap}) )
{
$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();
} }
}
sub PORT {
$port_data = $Global{port};
&globalPos();
my $x = $Global{'horz'} + 150;
my $y = $Global{'vert'} + 150;
$Global{'portWindow'} = MainWindow->new;
$Global{'portWindow'}->title("DIRECTORY PORT");
$Global{'portWindow'}->geometry("+$x+$y");
$Global{'portWindow'}->Button( -text => "ACCEPT", -command => \&portAccept,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
$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 );
$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 );
$portframe->Entry(-textvariable => \$port_data, -width => 10 )
-> pack(-fill => 'x');
sub portCancel{
$Global{'portWindow'}->destroy() if Tk::Exists($Global{'portWindow'});
$Global{'portWindow'} = undef();
}
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();
} }
sub print_loop()
{
my $list = shift;
my $ocs = shift;
my $Title = shift;
my $asize;
my $ahash;
my $var;
foreach $ahash ( @$ocs)
{
$list->insert("end", "$Title\n");
my @hkeys = keys(%$ahash);
foreach $var (@hkeys)
{
next if ( $var =~ /type/);
$alArray = $$ahash{$var};
if ( ref($alArray) eq 'ARRAY' )
{
my $asize = @$alArray; if ( $asize )
{
$list->insert("end", "\t$var: ");
foreach $a ( @$alArray )
{
$list->insert("end", "$a ");
}
$list->insert("end", "\n");
}
}
else
{
if ( $alArray == 1)
{
$list->insert("end", "\t$var\n");
}
else
{
$list->insert("end", "\t$var: $alArray\n");
}
}
}
}
}
sub schema_clear {
$schema_list->delete("1.0", "end");
}
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;
my $dt = "/tmp/schema.dat.$$";
if ( ! defined($Global{ldap}) )
{
$error = dirConn();
if ( $error == 1 )
{
if ( defined($Global{dirConnError}) )
{
$schema_list->insert("end", "$Global{dirConnError}\n");
}
else
{
ERROR($error);
}
return;
}
}
$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'} )
{
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
{
$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;
}
$Global{'mainWindow'}->update;
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_attributes();
$schemaHash{'atts'} = $ra_atts;
if ( $selectAll || $selectAtt )
{
&print_loop($schema_list, $schemaHash{'atts'}, "attributeType")
if ( defined($schemaHash{'atts'}) );
}
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_objectclasses();
$schemaHash{'ocs'} = $ra_atts;
foreach my $var (@$ra_atts)
{
$Global{'max'} = length($$var{'name'})
if length($$var{'name'}) > $Global{'max'} ;
}
$Global{'max'} += 6;
if ( $selectAll || $selectObj )
{
&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses")
if ( defined($schemaHash{'ocs'}) );
}
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_matchingrules();
$schemaHash{'mrs'} = $ra_atts;
if ( $selectAll || $selectMatch )
{
&print_loop($schema_list, $schemaHash{'mrs'}, "matchingRules" )
if ( defined($schemaHash{'mrs'}) );
}
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_matchingruleuses();
$schemaHash{'mru'} = $ra_atts;
if ( $selectAll || $selectMru )
{
&print_loop($schema_list, $schemaHash{'mru'}, "matchingRuleUse" )
if ( defined($schemaHash{'mru'}) );
}
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_syntaxes();
$schemaHash{'lsyn'} = $ra_atts;
if ( $selectAll || $selectSyn )
{
&print_loop($schema_list, $schemaHash{'lsyn'}, "ldapSyntax" )
if ( defined($schemaHash{'lsyn'}) );
}
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_nameforms();
$schemaHash{'nfm'} = $ra_atts;
if ( $selectAll || $selectNf )
{
&print_loop($schema_list, $schemaHash{'nfm'}, "nameForms" )
if ( defined($schemaHash{'nfm'}) );
}
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_ditstructurerules();
$schemaHash{'dits'} = $ra_atts;
if ( $selectAll || $selectDsr )
{
&print_loop($schema_list, $schemaHash{'dits'}, "ditstructurerules" )
if ( defined($schemaHash{'dits'}) );
}
$ra_atts = [];
@$ra_atts = $schemaHash{'schema'}->all_ditcontentrules();
$schemaHash{'ditc'} = $ra_atts;
if ( $selectAll || $selectDcr )
{
&print_loop($schema_list, $schemaHash{'ditc'}, "ditcontentrules" )
if ( defined($schemaHash{'ditc'}) );
}
$Global{'max'} = 50 if ( $Global{'max'} > 50 );
&objTree(); $Global{'olist'}->delete('all') if Tk::Exists($Global{'olist'});
$Global{mainWindow} -> update; &initializeP5a();
} 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");
}
}
sub objTree
{
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;
if ( !defined($ocs) || !defined($tree) ||
!defined($obj) || !defined($schema) )
{
my $error = "LDAP Schema data is not available.";
ERROR(\$error);
return;
}
foreach my $aobj ( @$ocs)
{
my $oid;
undef($oid);
$oid = $$aobj{'oid'};
next if ( !defined($oid) );
@sup = $$aobj{'sup'}[0];
@name = $$aobj{'name'};
$$obj{"$name[0]"} = [ "$oid", "$sup[0]" ];
}
@tmpKeys = sort(keys(%$obj)) if (defined($$obj{'top'}));
$$tree{'top'} = [0,];
foreach (@tmpKeys)
{
next if ( $_ eq "" || $_ eq "top" );
$done = 0; $Path = "";
$name = $_;
while ( !$done )
{
$SUP = $$obj{$_}->[1]; $SUP = "top" if ( $SUP eq "" ); if ( $Path eq "" )
{
$Path = $SUP; }
else
{
$Path = $SUP . $sepChar . $Path; }
$done = 1 if ( $SUP eq 'top' ) ; $_ = $SUP;
}
if ( defined($$tree{$Path}) )
{
$array = $$tree{$Path};
push(@$array,$name);
}
else
{
$$tree{$Path} = [0, "$name"];
}
}
$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;
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");
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 ) );
if ( !Exists($Global{'list'}) )
{
$Global{'list'} = $Global{'histWindow'}->Scrolled('ROText',
-scrollbars => 'se', -width=>50, -wrap => "none",
-font => $Global{'Font'}, -height => 20 )
->pack(-side => "left");
}
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];
my $ahash = $schema->objectclass( $oid );
my @hkeys = sort(keys(%$ahash));
$alArray = $$ahash{'name'};
$Global{'list'}->insert("end", "name: $alArray\n");
foreach $varr (@hkeys)
{
next if ( $varr =~ /name/); next if ( $varr =~ /type/);
$alArray = $$ahash{$varr};
if ( ref($alArray) eq 'ARRAY' )
{
my $asize = @$alArray; if ( $asize )
{
$Global{'list'}->insert("end", "\t$varr: ");
foreach $a ( @$alArray )
{
$Global{'list'}->insert("end", "$a ");
}
$Global{'list'}->insert("end", "\n");
}
}
else
{
if ( $alArray == 1)
{
$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");
}
}
);
@tmpKeys = sort(keys(%$tree));
my $base;
$base = "";
eval{
foreach ( @tmpKeys )
{
if ( $$tree{$_} ->[0] == 0 )
{
$$tree{$_} ->[0] = 1;
$Global{'hlist'}->add($_, -text=>$_); }
$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));
foreach ( @tmpKeys )
{
if ( defined($$tree{$_}) )
{
$$tree{$_}->[0] = 0;
}
}
}
sub hist_clear {
$Global{'list'}->delete("1.0", "end");
}
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'});
}
}
sub questionAction {
&globalPos();
my $x = $Global{'horz'} + 0;
my $y = $Global{'vert'} + 50;
$Global{'answerWindow'} = MainWindow->new;
$Global{'answerWindow'}->title("CONFIRM DECISION");
$Global{'answerWindow'}->geometry("+$x+$y");
$Global{'answerWindow'}->Button( -text => "ACCEPT", -command => \&doAction,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
$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'});
}
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;
} }
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');
}
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');
}
sub ldapActionCreateEntry
{
if ( !Exists($Global{'olist'}) )
{
&initializeP5a(); }
}
sub makeTheEntry
{
&globalPos();
my $x = $Global{'horz'} + 100;
my $y = $Global{'vert'} + 100;
%Creation = ();
if (! Exists($Global{'createWindow'}) )
{
$Global{'createWindow'} = MainWindow->new;
$Global{'createWindow'}->title("CREATE DIRECTORY ENTRY");
$Global{'createWindow'}->geometry("+$x+$y");
$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');
$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',
-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");
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 => ${$_} );
${$_} = $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 => ${$_} );
${$_} = $createlist->Label(-width => 65, -anchor => 'w',
-text => $Creation{objectClass}->[$ptr]);
$createlist->windowCreate("end", -window => ${$_} );
$createlist->insert("end", "\n"); ++$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 => ${$_} );
${$_} = $createlist->Entry(-width => 65,
-textvariable => \$Creation{$_}->[0] );
$createlist->windowCreate("end", -window => ${$_} );
$createlist->insert("end", "\n"); }
$createMe = $Global{'createWindow'}->Button(
-text => "CREATE ENTRY",
-command => \&create_entry, -font => $Global{'Font'},
-borderwidth => 5 )
-> pack(-fill => "both", -padx => 2, -pady => 2 ) ;
}
}
sub create_cancel
{
$Global{ceObject} = undef();
$Global{colist}->delete("1.0","end");
$Global{'createWindow'}->destroy if Tk::Exists($Global{'createWindow'});
$Global{'createWindow'} = undef();
}
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);
}
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} )
{
@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;
}
}
}
if ( $do_it )
{
&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;
}
}
else
{
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
}
else
{
$do_it = 0;
}
}
%Creation = ();
&create_cancel;
}
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;
$Global{nb}->raise("SEARCH DISPLAY");
delete($Global{'ldapActionDN'});
if ( $display_clear ) { &display_clear(); }
@DNs = split(/$sepChar/,$objects);
$dataArray = $Global{'searchResults'};
$data = $$dataArray{$DNs[1]}; $dn = $$data[0]; $max = $$data[1]; $info = $$data[2]; @infoKeys = sort(keys(%$info)); $text = sprintf "%${max}s: %s\n",'dn',$dn;
$list->insert("end", $text); foreach my $var (@infoKeys)
{
if ( $var =~ /^jpegPhoto/i )
{
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); next;
}
my $values = $$info{$var}; foreach my $Value ( @$values)
{
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);
}
}
$list->insert("end", "-----------------------------------------------------------------------------\n");
$list->insert("end", "\n");
}
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 $indexCount;
my $text;
if ( !$Global{'ldapActionDN'} )
{
&ldapActionCancel();
return;
}
my $objects = $Global{'ldapActionDN'};
&ldapActionCancel();
return if Tk::Exists($Global{'editWindow'});
&displayEdit();
@DNs = split(/$sepChar/,$objects);
$dataArray = $Global{'searchResults'};
$data = $$dataArray{$DNs[1]}; $dn = $$data[0]; my $tmpdn = $dn; $Global{'entryDN'} = $dn; $max = $$data[1]; $info = $$data[2]; @tmp1 = sort(keys(%$info));
foreach my $attrKey ( @tmp1 )
{
if ( $attrKey =~ /createTimeStamp/i || $attrKey =~ /modifyTimeStamp/i ||
$attrKey =~ /creatorsName/i || $attrKey =~ /modifiersName/i )
{
next;
}
push( @infoKeys, $attrKey );
}
$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 );
$lb = $elist->Entry(-width => 85,
-textvariable => \$tmpdn);
$elist->windowCreate("end", -window => $lb );
$elist->insert("end", "\n");
my $sptr = 0;
foreach my $var (@infoKeys)
{
$$Global{'multi'}[$sptr] = 0;
$text = sprintf "%${max}s",$var;
my $values = $$info{$var};
$$Global{'multi'}[$sptr] = 1 if (@$values > 1);
foreach my $Value ( @$values )
{
if ( $var =~ /;binary$/ ) { next; }
$ab = $elist->Button(-text => $text,
-font => $Global{'Font'},
-borderwidth => 3,
-relief => 'raised' );
$elist->windowCreate("end", -window => $ab );
$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 ] );
$elist->insert("end", "\n");
}
++$sptr;
}
$lb = $elist->Entry(-width => 85,
-textvariable => \$blank);
$elist->windowCreate("end", -window => $lb );
$elist->insert("end", "\n");
}
sub changeAttribute
{
my ( $ab, $lb, $Value, $attr, $mv ) = @_;
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");
$Global{'changeWindow'}->Button(-text => "CANCEL ATTRIBUTE EDIT",
-command => \&change_cancel,
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack(-fill => "both", -padx => 2, -pady => 2 ) ;
$acframe = $Global{'changeWindow'}->Frame()
->pack( -fill => "both", -side => "bottom", -padx => 5, -pady => 2);
$acframe -> Button(-text => " ACCEPT DATA CHANGE ",
-command => \&makeChanges,
-font => $Global{'Font'},
-borderwidth => 3 )
->pack( -fill => 'both' );
$outerframe = $Global{'changeWindow'}->Frame()
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
-expand => 1);
$alframe = $outerframe->LabFrame(-label => "ATTRIBUTE DATA",
-labelside => "acrosstop" )
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
-expand => 1);
$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'} )
{
$Global{'newAttributeFrame'} = $outerframe->LabFrame(
-label => "NEW ATTRBUTE NAME",
-labelside => "acrosstop" )
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
-expand => 1);
$Global{'newAttribute'} = $Global{'newAttributeFrame'}->Text(
-width => 80, -height => 1,
-wrap => 'none',
-font => $Global{'Font'} );
$Global{'newAttribute'}->pack(-fill => "both", -expand => 1 );
$Global{'newAttributeReady'} = 1 ;
}
$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'}) )
{
$Global{'changeWindow'}->Button(-text => "DELETE",
-command => [\&delete_data, $attr, $Value],
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack(-side => $Global{'hand'},
-padx => 2, -pady => 2 ) ;
$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;
}
sub replace_data {
my ( $attr, $Value, $tbox,$mv ) = @_;
if ( $$Global{'multi'}[$mv] )
{
$Global{'tmpDELETE'}{$$attr} = $$Value;
$Global{'tmpADD'}{$$attr} = $$tbox->get('1.0','1.end');
}
else
{
$Global{'tmpREPLACE'}{$$attr} = $$tbox->get('1.0','1.end');
}
}
sub add_data {
my ( $attr, $Value, $tbox ) = @_;
my $newAttribute;
if ( $Global{'newAttributeReady'} )
{
$newAttribute = $Global{'newAttribute'}->get('1.0','1.end');
$Global{'tmpADD'}{$newAttribute} = $$tbox->get('1.0','1.end');
}
else
{
$Global{'tmpADD'}{$$attr} = $$tbox->get('1.0','1.end');
}
}
sub makeChanges
{
my $tmp = $Global{'tmpADD'};
my @Keys = sort(keys(%$tmp));
if ( @Keys )
{
foreach my $var ( @Keys)
{
$Global{'add'}{$var} = $Global{'tmpADD'}{$var};
}
$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};
}
$Global{tmpDELETE} = {};
}
$tmp = $Global{'tmpREPLACE'};
@Keys = sort(keys(%$tmp));
if ( @Keys )
{
foreach my $var ( @Keys)
{
$Global{'replace'}{$var} = $Global{'tmpREPLACE'}{$var};
}
$Global{tmpREPLACE} = {};
}
$Global{'changeWindow'}->destroy if Tk::Exists($Global{'changeWindow'});
}
sub change_cancel
{
$Global{tmpADD} = {};
$Global{tmpDELETE} = {};
$Global{tmpREPLACE} = {};
$Global{'multi'} = [];
$Global{'changeWindow'}->destroy if Tk::Exists($Global{'changeWindow'});
}
}
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); $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} )
{
@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;
}
}
}
if ( $do_it )
{
&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;
}
} else
{
print "Delete check busy now\n" if ( $debug );
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
} } else
{
$do_it = 0;
}
}
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
$Global{nb}->raise('SEARCH');
}
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";
$task = '$Global{ldap}->add($entry)';
}
else
{
$type = "change";
$op = $$entry{changes};
$task = '$entry->update($Global{ldap})';
}
$do_it = 1;
while ( $do_it )
{
$mesg = eval $task;
if ( $mesg->code )
{
if ( $mesg->code == 10 && $Global{fref} )
{
@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;
}
}
}
if ( $do_it )
{
&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;
} } else
{
print "Delete check busy now\n" if ( $debug );
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
} else
{
$do_it = 0;
}
} } }
$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;
}
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) );
}
}
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); $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) );
}
}
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} )
{
@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;
}
}
}
if ( $do_it )
{
&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;
}
} else
{
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
} else
{
$do_it = 0;
}
}
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
$Global{nb}->raise('SEARCH');
}
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);
$Global{'RenameDN'} = $DNs[1];
@rdnData = split(/,/,$DNs[1]);
$rdn = shift(@rdnData);
foreach my $var (@rdnData)
{
$super .= $var . ",";
}
chop($super);
$Global{'renameWindow'} = MainWindow->new;
$Global{'renameWindow'}->title("MODDN INFORMATION");
$Global{'renameWindow'}->geometry("+$x+$y");
$Global{'renameWindow'}->Button( -text => "ACCEPT", -command => \&rdnAccept,
-font => $Global{'Font'}, -borderwidth => 3 )
-> pack(-side => "bottom", -padx => 5, -pady => 5 ) ;
$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 );
my $t1 = $newrdnframe->Entry(-textvariable => \$Global{'newrdn'}, -width => 25 )
-> pack(-fill => 'x');
$t1->insert("end", $rdn);
$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 );
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'} );
}
sub rdnAccept{
$Global{'renameWindow'}->destroy() if Tk::Exists($Global{'renameWindow'});
$Global{'searchHistWindow'}->destroy if Tk::Exists($Global{'searchHistWindow'});
$Global{'renameWindow'} = undef();
$Global{'searchHistWindow'} = undef();
&ldapActionRename();
delete( $Global{'newsuperior'});
delete( $Global{'newrdn'});
delete( $Global{'deleteoldrdn'} );
delete( $Global{'RenameDN'} );
delete($Global{'index'}) if ( defined($Global{'index'}));
}
}
sub display_clear
{
$list->delete("1.0", "end");
}
sub displayEdit()
{
my $ecframe;
my $elframe;
my $erbclear;
&globalPos();
my $x = $Global{'horz'} + 75;
my $y = $Global{'vert'} + 75;
if (!Exists($Global{'editWindow'}) )
{
$Global{'editWindow'} = MainWindow->new;
$Global{'editWindow'}->title("ENTRY EDIT DISPLAY");
$Global{'editWindow'}->geometry("+$x+$y");
$Global{'editWindow'}->Button(-text => "CANCEL ENTRY EDIT",
-command => \&edit_cancel,
-font => $Global{'Font'}, -borderwidth => 5 )
-> pack(-fill => "both", -padx => 2, -pady => 2 ) ;
$ecframe = $Global{'editWindow'}->Frame()
->pack( -fill => "both", -side => "bottom", -padx => 5, -pady => 2);
$ecframe -> Button(-text => " CHANGE DATA ",
-command => \&changeEntry, -font => $Global{'Font'},
-borderwidth => 3 )
->pack( -fill => 'both' );
$elframe = $Global{'editWindow'}->LabFrame(-label => "ENTRY DATA",
-labelside => "acrosstop" )
->pack( -fill => "both", -side => "top", -padx => 5, -pady => 2,
-expand => 1);
$elist = $elframe ->Scrolled('Text', -scrollbars => 'se',
-width => 80, -height => 20, -wrap => 'none',
-font => $Global{'Font'} );
$elist->pack(-fill => "both", -expand => 1 );
$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'});
}
}
sub add_new_attribute
{
$Global{'add_new_attribute'} = 1;
changeAttribute( 1,1,1,1);
delete($Global{'add_new_attribute'});
}
sub changeEntry
{
my $errstr;
my $mesg;
my $rmesg;
my $error = 0; 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;
}
}
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} )
{
@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;
}
}
}
if ( $do_it )
{
&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;
}
}
else
{
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
}
else
{
$do_it = 0;
}
}
delete( $Global{'add'} );
}
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} )
{
@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;
}
}
}
if ( $do_it )
{
&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;
}
}
else
{
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
}
else
{
$do_it = 0;
}
}
delete( $Global{'delete'} );
}
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} )
{
@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;
}
}
}
if ( $do_it )
{
&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;
}
}
else
{
$errstr = $mesg->code;
$errstr = ldap_error_text($errstr);
if ( !(CheckError($errstr) ) )
{
$errstr = $mesg->code;
ERROR($errstr);
return;
}
}
}
else
{
$do_it = 0;
}
}
delete( $Global{'replace'} );
}
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'});
$Global{'searchHList'}->delete('all') if Tk::Exists($Global{'searchHList'});
$Global{nb}->raise('SEARCH');
}
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;
}
if ( ! Exists($Global{'rootWindow'} ) )
{
$Global{'rootWindow'} = MainWindow->new();
$Global{'rootWindow'}->title("ROOT DSE ENTRY");
$Global{'rootWindow'}->geometry("+$x+$y");
}
if ( !Exists($Global{'labelDSE'}) )
{
$Global{'labelDSE'} = $Global{'rootWindow'}->Label()->pack;
}
$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'} ) );
if ( !Exists($Global{'listDSE'}) )
{
$Global{'listDSE'} = $Global{'rootWindow'}->Scrolled('ROText',
-scrollbars => 'se', -width=>50, -wrap => "none",
-font => $Global{'Font'}, -height => 10 )
->pack();
}
else
{
$Global{'listDSE'}->delete("1.0", "end");
}
foreach $attr (@Attributes)
{
$base = $root->get_value( $attr, asref => 1);
foreach (@$base)
{
$Global{'listDSE'}->insert("end", "$attr: $_\n");
}
}
}
sub Usage
{
print( "Usage: [-h] | [-d <#> ] | [-n] | -i <file> \n" );
print( "\t-d Perl-LDAP debug mode. Display debug messages to stdout.\n" );
print( "\t Should be used with -n so that process will not fork a\n" );
print( "\t new process.\n" );
print( "\t Value: 0 - display tklkup messages only.\n" );
print( "\t Value: 1 - Show outgoing packets (using asn_hexdump).\n" );
print( "\t Value: 2 - Show incoming packets (using asn_hexdump).\n" );
print( "\t Value: 4 - Show outgoing packets (using asn_dump).\n" );
print( "\t Value: 8 - Show incoming packets (using asn_dump).\n" );
print( "\t These values can be add to display several functions.\n" );
print( "\t-h Help. Display this message.\n" );
print( "\t-i Use the named file as the initialization file.\n" );
print( "\t-n Tklkup debug mode. Display debug messages to stdout.\n" );
print( "\n" );
print( "\t Perldoc pod documentation is included in this script.\n" );
print( "\t To read the pod documentation do the following;\n" );
print( "\t perldoc <script name>\n" );
print( "\n" );
print( "\n" );
exit( 1 );
}
__END__
=head1 NAME
tklkup - A script to do LDAP directory lookups, edits, and displaying directory schema information.
=head1 SYNOPSIS
This script is used to lookup and edit information from a LDAP
directory server. It is GUI based with several buttons for
selecting directory servers, search bases, attributes and
for enabling the Directory Schema Search window.
This script has been tested on Solaris, RedHat 7.3 Linux,
Mandrake 6.5 Linux, ActiveState Perl 628 and 5.8.7, but should work with
any system that has PERL and the required modules installed in
it.
Execute tklkup -h to view the list of input options and their
usage.
The SSL connection has been tested on Solaris, RedHat 7.3, and
Mandrake 6.5 Linux. The SSL connection from a Microsoft Windows
system is not available at this time. If the user has SSL on
the Microsoft Windows system this can easily changed by
modifying the tklkup program, in subroutine dirConn comment out
the 6 lines of code that detects the platform type of MSWin32.
There are 2 files associated with the tklkup program in this
tar file; dot.tklkup, and tklkup.
About the files.
=over 4
=item dot.tklkup
dot.tklkup - This is the initialization file that should be put
into each users home directory as I<.tklkup>.
This file will have to be setup properly before the user
can expect the tklkup script to work properly. The odds of this
initialization file being setup correctly for anyone is I<ZERO>.
However the script can be run with this file to get a feel
for how the script will look.
It allows the user to customize how tklkup will look and
work for them.
If the .tklkup files does not exist in a users home
directory the program has a set of built-in defaults
that it will use.
To be used this file must have user read permission.
There are 10 commands that can be used with this file;
binddn -> string value: Bind DN.
followref -> no value needed. Setting this option will
activate following referrals on entry modification.
mwwidth -> numeric value: Default 600 main window width in
pixels, user may need to adjust this.
mwheight -> numeric value: Default is 430 main window height in
pixels, user may need to adjust this.
hand -> values: left or right. Defines where the
attribute label box will be place.
limit -> value: default is 100. Limits the number of
search base(s) detected.
port -> value: default is 389. User should set this
to match their needs.
nismapname -> Solaris Native LDAP uses nismapname to define
the automounter directory branches. Default
is to not use Solaris Native LDAP. Uncomment
this line in the dot.tklkup file to enable this
option.
attribute -> attribute upon which the data search will be
based. One attribute per line. There is one
additional attribute that is always listed without
any action by the user; Filter. This attribute
allows the user to enter the I<COMPLETE> filter
that will used to search for data.
server -> name of the directory server that you wish
to conduct the data search.
One server per line.
Each line can have one of two formats
server: server name
or
server: server name: base
The I<server: server name> format will try to use the
root_dse function to define the base.
It the root_dse returns the namingContexts attribute,
that information will be use to determine the search
base(s).
If the root_dse returns undefined or has no namingContexts
attribute, a null string will be the search base.
In this case the user will have to define a search base
in the server command of the .tklkup file.
The I<server: server name: base> format will
cause each of the defined servers to have it's
own special initial search base and use this initial
search base to find all of the other search bases.
This is an attempt to do auto search base detection.
Using this method has one I<draw back>, when changing
to a different directory server there is a possible
I<delay> on displaying the new server name and
search base. This is due to the fact that TK and
it's MainLoop() process are not multi-tasking.
The new search base has to be acquired and setup before
MainLoop() takes control of the process.
Depending on the number of search bases this time period
can be quite a few seconds.
When switching between servers with the same base, the
search base will I<not> be updated. This too can have
a I<draw back> if there are new search bases in the
new server but it saves time.
None of this is a problem if all of your servers have
the same DIT layouts. Just define them with the
same search base, there should be little or no delay
when switching to the new server.
=back
Now a word about directory branch, or search base, detection.
There are many things that can prevent this function from working
properly. Several version 2 LDAP servers that this was tested
on required that you be bound to the server.
None of the version 3 LDAP servers required this.
If this function does not work for you, provide a bind DN and
password. The normal mode of operation for this function is an
anonymous bind situation.
Some of the ldap servers I worked with would never return the
information I expected, auto detection never functioned on these
systems.
There is one college ldap server on the Internet that has so
many bases that it takes over an hour to figure out all the
search bases. The only way the operator knows that the
script is still working is because search limit exceeded messages
are displayed on the console that initiated the tklkup script.
Who wants to wait a hour while the script figures this out.
If you decide to use auto search base detection you will just have
to try it and hope it works.
-------------------------------------------------------------------
=head1 tklkup
tklkup - PERL executable file.
You may need to change the first line of the PERL tklkup script
to point to your file pathname of perl.
When executed tklkup will display a window on your
computer. The graphical user interface, GUI, has
several sections to it.
If tklkup is run on a HPUX, Sun, or Linux system the
tklkup process will fork and run in background mode.
If tklkup is run in debug mode or on a system that is not
listed above it will I<NOT> fork and will run in in
foreground mode.
During initial program initialization a "splash" screen will
be displayed telling the user what is going on. It is possible
that the user will never see the splash screen if tklkup
initializes quickly.
-------------------------------------------------------------------
=head1 Tklkup Menu Bar
At the top of the GUI is the main menu bar. It has 3 drop down
menus; "Directory OPS", "Set Bind Credentials", and
"Set DSA Port".
The I<DIRECTORY OPS> button will activate a drop down menu that
has 2 menu selections;
The I<EXPLORE ROOT DSE> menu will attempt to obtain the
root dse entry for the selected directory server. If the root
dse entry is obtained a separate window will be displayed that
will display the information obtained from the root dse entry.
If the root dse entry can not be obtained then an error message
window will be displayed. This menu has a "Hot" key, Ctrl-r.
The I<Set SSL> menu will set parameters for a SSL ldap connection.
This menu has a "Hot" key, Ctrl-s.
The I<Set NON-SSL> menu will set parameters for a non-SSL ldap
connection. This menu has a "Hot" key, Ctrl-n.
The I<Toggle LDAP Version> menu will toggle the ldap version
between version 2 and 3. This menu has a "Hot" key, Ctrl-l.
The I<Toggle Follow Referral> menu will toggle the flag that
determines whether a ldap modify follows a referral. This menu
has a "Hot" key, Ctrl-f.
The I<Exit> menu will exit the program. This menu has a
"Hot" key, Ctrl-x.
The I<SET BIND CREDENTIALS> button will activate a window
that is separate from the main window. This menu has a
"Hot" key, Alt-b.
The new window contains two buttons and two text boxes.
At the top of the window is a Cancel button, pressing
this button will cancel the operation of setting the
bind DN and password.
The DN text box is where the user will enter the DN
to bind with. If the user has the binddn option in the .tklkup
file, the binddn will be displayed in the DN text box.
The PASSWORD text box is where the user will enter the password
for the DN. Star "*" will be shown for the characters
as they are typed into the text box. If the user presses the
return key after entering the password, this will set the
bind DN and password and start the bind process.
At the bottom of the window is the Accept button, pressing
this button will set the bind DN and the password. Pressing the
accept button will cause the program to bind to the currently
selected directory server.
Having both the dn and password fields blank and pressing the
accept key will cause an anonymous bind to the directory.
The I<DIRECTORY PORT> button will activate a window
that is separate from the main window. This menu has a
"Hot" key, Alt-p.
The new window contains two buttons, and one text box. If the
user needs to change the TCP connection port, this is where it
is done.
At the top of the window is a Cancel button, pressing
this button will cancel the operation of setting the
port number.
The text box is where the user will enter the port
number to connect. Display in the text box is the
current port number.
At the bottom of the window is the Accept button, pressing
this button will set the port number. Changing the connection
port number will I<NOT> cause the program to issue a new
connection to the directory server. The user must re-select or
change to a new directory server.
I<EXIT PROGRAM> button. Just below the main menu bar is
the "Exit" button. When a mouse click is done on the "EXIT PROGRAM"
button the program will terminate. This menu has a "Hot" key, Alt-e.
-------------------------------------------------------------------
=head1 Tklkup GUI
Just below the Menu Bar is a section of the GUI that is displayed
at all time regardless of which panel is displayed.
The I<SELECT SERVER> button will activate a
drop down menu. From the menu the user will select the
"RadioButton" that corresponds to the directory server the
user wishes to use. When selected the "RadioButton" diamond
will turn red in color. This menu is a designed to be a
"I<tear off>" menu, selecting the "---------------" line will
cause the pull down menu to become a separate window that
is still somewhat controlled by the GUI. The
DIRECTORY SERVER text box will display the directory name
that is selected. If the GUI is icon-ed or exited, the tear
off window will follow the actions of the GUI. All other
actions like moving or closing just the torn off window
must be done by the user's window manager.
To the left of the I<SELECT SERVER> button are two text labels;
one for the LDAP version and one for the SSL connection type.
These labels will display information about the selected LDAP
version and SSL connection status.
At this point the tklkup GUI is made of five display and
control panels; SEARCH, SEARCH DISPLAY, SCHEMA DATA, CREATE ENTRY,
and INFO;
-------------------------------------------------------------------
=head1 SEARCH Panel
The I<SELECT BASE> button will activate a Select Search Base window
contains 2 buttons and a herical tree structure of the directory.
At the top of the Select Search Base window is the CANCEL BASE CHANGE
button. Pressing the button will cancel the search base change and
will close, or withdraw, the window. At the bottom of the Select Search
Base window is the ACCEPT BASE CHANGE button. Pressing the button
will change the search base to the highlighted directory branch and
will close, or withdraw, the window.
In the middle of the Select Search Base window is the hierarchical
list box where a tree type display of the directory branch structure
will be displayed. The directory namingContext(s) form the base of the
tree(s), to the left of each branch in the directory will be a small
box with a + or - sign in it, if the box has a + in it, clicking on
the box will expand the tree structure, if the box has a - in it,
clicking on the box will collapse the tree structure.
To select a search base, click on a branch, which will highlight the
branch, and press the ACCEPT BASE CHANGE button.
The I<SELECT ADDITIONAL ATTRIBUTES> button will activate a
drop down menu. From the menu the user will select the
"RadioButton" that corresponds to the attribute the
user wishes to use in the filter of the directory search. When
selected the "RadioButton" diamond will turn red in color. This
menu is a designed to be a "I<tear off>" menu, selecting the
"---------------" line will cause the pull down menu to
become a separate window that is still somewhat controlled
by the GUI. If the GUI is icon-ed or exited, the tear off
window will follow the actions of the GUI. All other
actions like moving or closing just the torn off window
must be done by the user's window manager.
The I<SAVE FORMAT> frame contains to check boxes.
If checkbox XML is select, the SAVE TO and SAVE ALL TO
buttons will save the select data in XML format.
If checkbox LDIF is select, the SAVE TO and SAVE ALL TO
buttons will save the select data in LDIF format.
Just under the I<SELECT BASE> button is the hierarchical text
box where the DN results of the directory search will be displayed.
If there were valid results returned from the search a list of DN
entry(s) will be displayed in the hierarchical list box. Selecting
a DN will cause the five LDAP Action buttons to the left of the
hierarchical text box to be put in the active state. It is with
these 5 buttons that the user can select to view, rename, edit,
save to a ldif file, or delete the corresponding DSA's directory
data.
=head1 LDAP ACTION BUTTONS
I<DISPLAY> - Will display the selected DN's information in the
Directory Data text box that is located in the SEARCH DISPLAY
panel. The SEARCH DISPLAY panel will be brought to the foreground
of the GUI.
I<RENAME> - Will display a MODDN INFORMATION window in which the
user will input the needed information for modifying an entry's
DN.
I<DELETE> - Will cause the selected DN to be deleted from the
directory. When this button has the focus, it's text will turn
red, letting the user know to use caution with this button.
I<EDIT> - Will cause a Entry Edit Display window with the
corresponding entry data in it. It is from this window that the
user can change directory data. This window is described in
detail later in this document.
I<SAVE TO> - Will cause the entry that is selected to be written
to the file specified in the FILE NAME text box. The data
format of this file will be whatever is selected in the
SAVE FORMAT frame.
I<CANCEL> - Will cancel the action request for the select DN.
I<SEARCH THE DIRECTORY> button. At the bottom of the GUI is
the "Search" button. When a mouse click is done on the
"SEARCH THE DIRECTORY" button the program will execute a ldap search
of the directory.
The I<FILTER DATA> text box is where the user will enter
the data to be searched for. The program will automatically
put the beginning and ending parenthesis around the data.
If the I<Filter> attribute is selected this is where the
I<COMPLETE> filter is entered, the program will not modify this
string in any way.
If the user presses the Enter key while the I<FILTER DATA> text box
has the key board focus, a ldap search for the filter data will be
executed. This action is the same as pressing the
I<SEARCH THE DIRECTORY> button.
The I<CLEAR FILTER DATA> button will clear out the text
that appears in the Attribute Data text box.
The I<SET FILTER CONDITION> button will activate a drop down menu.
From the menu the user will select the "RadioButton" that
corresponds to the filter conditions the user wishes to use
in the directory search. When selected the "RadioButton"
diamond will turn red in color. This menu is a designed
to be a "I<tear off>" menu, selecting the
"---------------" line will cause the pull down menu to
become a separate window that is still somewhat controlled
by the GUI. If the GUI is icon-ed or exited, the tear off
window will follow the actions of the GUI. All other
actions like moving or closing just the torn off window
must be done by the user's window manager.
The four filter conditions control how the search filter
will be created. Just to the side of the I<SET FILTER CONDITION>
button is a text box that displays the filter condition
that is selected.
=head1 SAVE ALL TO BUTTON
At the bottom of the SEARCH RESULTS panel is the SAVE ALL TO
button, pressing this button will cause the previous search to be
re-executed and all of the search results will be written to the
file specified in the FILE NAME text box. The data
format of this file will be whatever is selected in the
SAVE FORMAT frame.
-------------------------------------------------------------------
=head1 SEARCH DISPLAY PANEL
The I<SEARCH DISPLAY> is the panel where data for the
selected DN is displayed. Data is displayed in the read only
Directory Data text box. Associated with the Directory Data
text box is the "RadioButton" that determines how often the
data in the directory text box is cleared. If the "CheckButton"
is selected, colored red, the directory data text box will be
cleared out before each directory query. If the "CheckButton"
is not selected the directory data text box will NOT be cleared
out until the Clear Data button in clicked or the
CLEAR DIRECTORY DATA ON EACH QUERY "RadioButton" is selected.
The Directory Data text box is where the results of the
directory search will be displayed. With the cursor
in the Directory Data text box you have access to additional
functions when you depress the mouse "action" button.
When the "action" mouse button is depressed a small text box
with 4 additional functions will be displayed inside the
Directory Data text box. These 4 functions are;
File -> This function exits the window. You can not edit
the Directory Data text box because it is created
as a read only text box.
Edit -> This function gives the user 3 additional functions;
Copy -> I do not know what this function does.
Select All -> Highlights/Selects all of the text in
the Directory Data text box.
Unselect All -> Unselects all of the text in
the Directory Data text box.
Select/Unselect are used in-conjunction with the
Copy function.
Search -> This function gives the user 4 additional
functions.
Find, Find Next, Find Previous -> These functions
find text in the Directory Data text box.
Replace -> This function allows you to replace the
text that is selected. However this is just
a fake replacement as you can not edit the
Directory Data text box because it is created
as a read only text box.
View -> This function gives the user 3 additional
functions.
Goto Line -> When selected will prompt the
user for a line number, the line number being
the line number the user wishes to see.
What Line -> When selected will tell the user
what line number the cursor is on.
Wrap -> When selected will prompt the user
to choose how to do line wrapping in the
Directory Data text box.
The CLEAR DATA button will clear out the text that
appears in the Directory Data text box.
=head2 JPEG Photo Display.
If the Tk::JPEG module is installed in the user's Perl system,
when a jpegPhoto attribute is read a separate I<JPEG PHOTO DISPLAY>
window will be display. Inside this window will be the jpeg photo,
a list box containing the DN of the entry, and a I<CLOSE WINDOW> button.
If the Tk::JPEG module is I<NOT> installed in the user's Perl
system, nothing will be displayed for the jpegPhoto.
-------------------------------------------------------------------
=head1 MODDN INFORMATION WINDOW
The I<RENAME> button will activate a window that is separate from
the main window.
The new window contains two buttons, two text boxes and one
checkbutton.
The text boxes are initialized with data that corresponds the
DN that was selected in the Search Results window. It is in
these text boxes that the user will enter the data needed for the
modrdn operation to take place.
At the top of the window is a Cancel button, pressing
this button will cancel the operation of modifying the DN.
The Newrdn text box is where the user will enter the new RDN
for the selected entry.
The Newsuperior RDN text box is where the user will enter the new
superior RDN, or branch DN, for the selected entry.
At the bottom of the window is the Accept button, pressing
this button will set the new RDN and the superior RDN.
The I<DELETE OLD RDN DATA> check box controls whether the old
entry information is deleted or not deleted. When the check box
is selected, colored red, the old entry information will be deleted.
This is the default action for this button.
Unselecting the check box will cause the entry data to not be deleted.
-------------------------------------------------------------------
=head1 ENTRY EDIT DISPLAY Window.
It is from this window that the user can modify an entry's data.
There can only be one of these windows active at a time.
Attributes that contain I<binary> information can I<NOT> be modified
with this program.
At the top of the window is the I<CANCEL ENTRY EDIT> button. Pressing
this button will cancel all pending data changes for this entry. It
will also cause the window to be destroyed.
At the bottom of the window is the I<CHANGE DATA> button. Pressing
this button will cause all of the pending data changes to take
place.
Just above the I<CHANGE DATA> button is the I<ADD ATTRIBUTE> button.
Pressing this button gives the user the option of entering a new
attribute name and value so that this information can be put into
the entry.
In the middle of the window is the I<ENTRY DATA> box. In this box
is the all of the entry's current attributes along with their data.
Each line in the box is broken up into two parts; the attribute button and
the attribute data list box. There is one attribute and data pair per
line. Multi-valued attributes have one line per attribute value.
The first line in the I<ENTRY DATA> box will be the DN of the entry.
This line can not be edited.
To edit an attribute, press the button that has the attributes name on
it. This will cause a I<ATTRIBUTE MODIFICATION> window to be displayed.
This window is described in detail later in this documentation.
When the user has finished making changes, press the I<CHANGE DATA> button.
This will start the process of making the change(s) in the LDAP
directory. If any errors occur a error window will appear. After the
error window is dismissed the I<ENTRY EDIT DISPLAY> window will still
be active. The user can at this point do what ever it takes to correct
the problem.
If no errors occur the I<ENTRY EDIT DISPLAY> window and the
I<SEARCH RESULTS> windows will be destroyed. This is due to the fact
that the data in both windows is no longer valid. The user must
research the LDAP directory to get the new updated information.
-------------------------------------------------------------------
=head1 ATTRIBUTE MODIFICATION Window.
It is from this window that the user can modify an attribute's data.
There can only be one of these windows active at a time.
At the top of the window is the I<CANCEL ATTRIBUTE EDIT> button. Pressing
this button will cancel all pending data changes for this attribute. It
will also cause the window to be destroyed.
At the bottom of the window is the I<ACCEPT DATA CHANGE> button. Pressing
this button will cause all of the current data changes to be put into
the pending data change queue.
In the middle of the window is the attribute data text box. It is in
this text box that the user will find the current data for the attribute
the user selected. Depending on the operation the user wants to do the
user can change the data or leave the data as is.
Below the attribute data text box are three buttons, ADD, DELETE, and
REPLACE.
=head2 ADD operations.
If the user wishes to add a new value to an attribute; the user should
enter the new data in the attribute data text box and then press
the I<ADD> button.
=head2 DELETE operations.
If the user wishes to delete the value from an attribute; the user should
not bother the data in the attribute data text box and should press
the I<DELETE> button.
=head2 REPLACE operations.
The attribute value being replaced is a part of a multi-valued
attribute, the new value will be added to the attribute, then
the old value will be deleted. If the add operation has an error
code, the delete part of this operation will not take place.
If the attribute value being replace is a single valued attribute
this value will be replaced.
When the user done with the changes the user should press the
I<ACCEPT DATA CHANGES> button. This will move the data changes onto
the pending data change queue and close the window.
-------------------------------------------------------------------
=head1 DIRECTORY DELETE CONFIRM WINDOW.
When the DELETE button is selected, before the actual deletion
takes place, a window will be displayed with a Cancel and Accept
buttons. This gives the user a fail safe in case the user selects
the DELETE button by accident. Pressing the Cancel will cancel
the delete request, pressing the Accept button will cause the
directory entry to be deleted.
-------------------------------------------------------------------
=head1 SCHEMA DATA PANEL
This panel has schema information from a LDAP directory server.
This data is retrieved, with in one second, upon connection to the
selected directory server. This action takes place upon start up
of the program or when a new directory server is selected.
=head2 Directory Schema Display Window Operation
When the SCHEMA DATA panel tab is pressed, the SCHEMA DATA
panel is brought to the foreground of the GUI.
When the Write Data To File RadioButton is selected the
LDAP Schema data will be written to the file listed
in the text box below the RadioButton text. By selecting
the DSML XML RadionButton, the data will be written to the
file in XML format. Once the data has been written to the file a
message will be written to the DIRECTORY SCHEMA DATA text box
stating that the data has been written to a file and will list
the file name. Upon completion of the schema dump operation
the RadioButton and text in the file name text box will be reset.
At the bottom of the GUI is the "Retrieve Directory Schema" button.
When a mouse click is done on the "Retrieve Directory Schema"
button the script will query the directory server for schema information
and then write the information to the file.
Associated with the Directory Schema Data text box is a series of
"CheckButtons" that determines what of the schema objects will be
displayed. There are 9 Checkbuttons; ALL, objectClass, matchingRules,
attributeTypes, ldapsyntaxes, nameforms, ditstructurerules,
ditcontentrules, and matchingruleuse. If the "CheckButton" is
selected, colored red, then schema objects of that type will be
displayed in the Directory Schema Data text box.
If the "CheckButton" is not selected, gray in color, then schema
objects of this type will not be displayed in the Directory Schema
Data text box. By default the ALL CheckButton is select.
The Directory Schema Data text box is where the results of the
directory search will be displayed. With the cursor
in the Directory Data text box you have access to additional
functions when you depress the mouse "action" button.
When the "action" mouse button is depressed a small text box
with 4 additional functions will be displayed inside the
Directory Data text box. These 4 functions are;
File -> This function exits the window. You can not edit
the Directory Data text box because it is created
as a read only text box.
Edit -> This function gives the user 3 additional functions;
Copy -> I do not know what this function does.
Select All -> Highlights/Selects all of the text in
the Directory Data text box.
Unselect All -> Unselects all of the text in
the Directory Data text box.
Select/Unselect are used in-conjunction with the
Copy function.
Search -> This function gives the user 4 additional
functions.
Find, Find Next, Find Previous -> These functions
find text in the Directory Data text box.
Replace -> This function allows you to replace the
text that is selected. However this is just
a fake replacement as you can not edit the
Directory Data text box because it is created
as a read only text box.
View -> This function gives the user 3 additional
functions.
Goto Line -> When selected will prompt the
user for a line number, the line number being
the line number the user wishes to see.
What Line -> When selected will tell the user
what line number the cursor is on.
Wrap -> When selected will prompt the user
to choose how to do line wrapping in the
Directory Data text box.
The Clear Data button will clear out the text that
appears in the Directory Schema Data text box.
The I<SHOW HIERARCHICAL OBJECTCLASS TREE> will cause one of two
windows to be displayed. For information about these windows see
the HIERARCHICAL OBJECTCLASS section of the manual.
At the bottom of the GUI is the "Retrieve Directory Schema" button.
When a mouse click is done on the "Retrieve Directory Schema"
button the script will query the directory server for schema information.
=head1 HIERARCHICAL OBJECTCLASS Window
If no directory schema data has been obtained from the selected
directory server a error message window will be displayed stating
that no schema data is available.
If directory schema data has been obtained from the selected
directory server a separate window will be displayed.
The I<HIERARCHICAL OBJECTCLASS> window has two list boxes and
a I<CLOSE HIERARCHICAL DISPLAY WINDOW> button. The
I<CLOSE HIERARCHICAL DISPLAY WINDOW> button will destroy the
I<HIERARCHICAL OBJECTCLASS> window. In one of the list boxes will
be a hierarchical tree of all of the objectclasses obtained from the
directory server. Doing a mouse button select on one of the
objects in the tree will cause information about that objectclass
branch to be displayed in the adjacent list box. The most superior
ojectclass will be at the top of the listing, the leaf objectclass
will be at the bottom of the listing. Each objectclass is separated
by a dashed line. All information about each objectclass will be
displayed in that objectclass's section.
-------------------------------------------------------------------
=head1 CREATE ENTRY PANEL
=head2 Entry creation or modification from LDIF.
The user can create and modify an entry from a LDIF file.
When the user presses the "CREATE/MODIFY ENTRY FROM LDIF FILE"
button, the file listed in the "LDIF FILE NAME" text box will be used
to create or modify the entries listed in the ldif formatted file.
=head2 Manual entry creation using the objectClass as a template.
In the MANUALLY CREATE ENTRY frame the user can manually create
an entry using the objectClass list box as an entry template.
First thing the user should do is select the proper DN base from
the SELECT DN BASE button. This will setup part of the entry's
DN.
After selecting the DN base the user can find and select an objectclass,
or objectclasses from the list of objectClass(s). When the user selects,
by clicking the pointer on an objectClass, the objectclass will appear
in the window to the left of the objectclass list. The superior objectclass(s)
of the selected objectclass will also be displayed.
If the user adds a wrong objectclass, the user may remove the objectclass
by clicking the button with the objectclass name in it. Only that
class will be removed.
When the user is ready to create the entry, the user must click the
"Create The Entry" button and a CREATE DIRECTORY ENTRY window
will be displayed. It is from the CREATE DIRECTORY ENTRY window the
the user will finish entering data for the new entry.
If the user selects the posixAccount or shadowAccount, the
posixAccount, shadowAccount, and account objectclasses will be
include in the objectclasses for the new entry.
-------------------------------------------------------------------
=head1 CREATE DIRECTORY ENTRY WINDOW
At the top of the CREATE DIRECTORY ENTRY window is the
CANCEL CREATE ENTRY DISPLAY button. Pressing this button
will cancel the entry creation process.
Just below the CANCEL CREATE ENTRY DISPLAY button is a series of
information messages for the user about the Naming Attribute selection
and DN base.
In the middle of the window is the actual data list box, it is in
this list box that the user enters attribute information, selects
the Naming Attribute, or sets up a DN.
The data list box is for all practical purposes divided into 4
sections.
The DN text field is where the user can edit the DN base or
enter in a complete DN. If the user enters a complete DN the
user should B<NOT> select a Naming Attribute radionbutton.
Between the DN text field and the objectClass text fields will
be all of the B<MUST> attributes. The B<MUST> attribute names
will be colored red. These attributes must have information in
them for the entry to be accepted into the directory.
The objectClass text fields are read only fields that list the
objectClasses that will be used in the creation of the entry.
All attributes below the objectClass text fields are B<MAY>
attributes, the user does not have to supply information about
these attributes unless the attribute is selected to be the
Naming Attribute. If the attribute is selected to be the Naming
Attribute it B<MUST> have data associated with it.
The B<Naming Attribute> radiobutton are used to select the
attribute that will be used as the Naming Attribute. The
Naming Attribute is used to complete the entry DN. The user
does not have to use these buttons, but if one is selected,
due to the nature of radiobuttons, one of them must be used
as there is no way to deselect any of the radiobuttons.
At the bottom of the CREATE DIRECTORY ENTRY window is the
CREATE ENTRY button. Pressing this button will start the process
of putting the new entry into the directory.
If during the actual creation of the entry there is an error
detected, a error window will be displayed stating the error.
Once the error is acknowledged, the user can correct the error
and then re-click the CREATE ENTRY button will re-attempt to
create the entry in the directory. The CREATE DIRECTORY ENTRY
window will not be destroyed until either the user cancels the
action or the entry is created in the directory.
-------------------------------------------------------------------
=head1 INFO PANEL
This panel is mainly for information.
The I<Process Messages> text window is where process messages
will be displayed. The messages are indicators of what is
happening during the execution of the program. By selecting
a line of text and moving the cursor up or down, the user
can scroll thru the messages.
This panel can be considered to be under construction.
-------------------------------------------------------------------
=head1 REQUIREMENTS
To use this program you will need the following.
At least PERL version 5.004. You can get a stable version of PERL
from the following URL;
http://cpan.org/src/index.html
Perl Tk800.022 module. You can get this from the following URL;
ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Tk/
If you wish to display a jpegPhoto attribute then you will need the
Perl Tk-JPEG-2.014 module. You can get this from the following URL;
ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Tk/
Perl LDAP module. You can get this from the following URL;
ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Net/
Perl Convert-ASN1 module. You can get this from the following URL;
ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Convert/
Depending on the modules loaded in your PERL system, you may need to
load the following PERL module.
Perl Digest-MD5 module. You can get this from the following URL;
ftp://ftp.duke.edu/pub/CPAN/modules/by-module/MD5/
Bundled inside each PERL module is instructions on how to install the
module into your PERL system.
-------------------------------------------------------------------
=head1 INSTALLING THE SCRIPT
Install the tklkup script anywhere you wish, I suggest
/usr/local/bin/tklkup.
Install the dot.tklkup file in each users home directory
as .tklkup. It is possible to use a central copy and
create a link in the user home directory to the central copy.
-------------------------------------------------------------------
Since the script is in PERL, feel free to modify it if it does not
meet your needs. This is one of the main reasons I did it in PERL.
If you make an addition to the code that you feel other individuals
could use let me know about it. I may incorporate your code
into my code.
=head1 AUTHOR
Clif Harden <charden@pobox.com>
If you find any errors in the code please let me know at
charden@pobox.com.
=head1 COPYRIGHT
Copyright (c) 1999-2003 Clif Harden. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.
=cut