#!/usr/bin/perl
# !/usr/local/bin/perl
#
#
# Copyright (c) 1999 Clif Harden.  All Rights Reserved
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU GENERAL PUBLIC LICENSE.
#----------------------------------------------------------------------------
#
# This program was originally written by Clif Harden.
# It is based on Graham Barr's PERL LDAP module and the PERL TK
# module.
# Both modules are available from the CPAN.org system.
#
# $Id: schema,v 1.2 2000/07/31 02:29:01 charden Exp $
#
# Purpose: This program is designed to retrieve schema data from a LDAP
#          directory and display on the graphical user interface
#          created by this program.
#
#
# Revisions:
# $Log: schema,v $
# Revision 1.2  2000/07/31 02:29:01  charden
# Changed the format of the SCHEMA DUMP TO FILE information text to
# 2 lines.  This reduces the width of the GUI.
#
# Revision 1.1  2000/07/27 14:39:17  gbarr
# Initial checkin
#
# Revision 1.8  2000/06/22 02:26:54  clif
# Added code for schema dump operation.  This involves a
# RadioButton, file name text box, and code in the search
# subroutine to do a schema dump operation.
# Condensed the search subroutine to use a common print_loop
# subroutine to print out the items associated with the
# attributes, matchingrules and objectclasses.
# Updated the pod documentation to reflect the addition of the
# schema dump functions.
#
# Revision 1.7  2000/06/18 02:51:18  clif
# Removed commented out code.
#
# Revision 1.6  2000/06/18 02:36:23  clif
# Removed old parse routine.
# Added use of items and item methods to get and display data.
# Changed the wording and look/feel of pod documentation.
#
# Revision 1.5  2000/06/08 01:13:55  clif
# Added pod I command to make .tklkup italic.
#
# Revision 1.4  2000/06/08 01:07:17  clif
# Correct wording in the pod documentation.
#
# Revision 1.3  2000/05/29 00:44:00  clif
# Changed pod documentation that discribed how the schema data
# is stored in a temp file, this information is no longer
# valid for Net::LDAP.
#
# Revision 1.2  2000/05/29 00:39:27  clif
# Changed code to use the new format of the schema methods.
# Added README.schema file as a internal pod document.
# Removed leading dashes form Net::LDAP options.  These dashes had been
# depricated.
#
# Revision 1.1  2000/05/28 18:55:34  clif
# Initial revision
#
#
#

=head1 NAME 

schema -  A script to do LDAP directory schema lookups.

=head1 SYNOPSIS


This script is used to lookup schema information from a LDAP 
directory server.  It is GUI based with a button for 
selecting directory servers.

This script has been tested on Solaris and RedHat 6.0 Linux, 
but should work with any system that has PERL and the required 
modules installed in it.

There are 2 files associated with the schema program in 
this tar file; dot.tklkup, and schema.

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 schema script to work properly.  The odds of this
initialization file being setup correctly for anyone is 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 schema will look 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 4 commands that can be used with this file;
hand, attribute, server, and base.
 
 hand -> values: left or right.  Defines where the 
                 attribute label box will be place.

 attribute -> attribute is not used by schema.

 server -> name of the directory server that you wish
           to conduct the data search. One server per line.

 base -> base is not used by schema.

-------------------------------------------------------------------

=item schema

schema - PERL executable file.  

You may need to change the first line of the PERL schema script 
to point to your file pathname of perl.

When executed schema will display a window on your
computer.  The graphical user interface, GUI, has 
several sections to it.  

Exit button.  At the top of the GUI is the "Exit"
button.  When a mouse click is done on the "Exit" button 
the program will terminate.

The SELECT DIRECTORY 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.

When the Write Data To File RadioButton is selected the 
LDAP Schema data will be written to the file listed 
in the text box below the RadioButton text.  Once the data 
has been written to the file a message will be written to the
DIRECTORY SCHEMA DATA text box stating that the data has been
written to a file and will list the file name. Upon 
completion of the schema dump operation the RadioButton and 
text in the file name text box will be reset.

The Clear Data button will clear out the text that 
appears in the Directory Schema Data text box.

The Directory Schema Data text box is where the results of the
directory search will be displayed.  With the cursor
in the Directory Data text box you have access to additional
functions when you depress the mouse "action" button.
When the "action" mouse button is depressed a small text box
with 4 additional functions will be displayed inside the 
Directory Data text box.  These 4 functions are;

 File -> This function exits the program.  You can not edit
         the Directory Data text box because it is created 
         as a read only text box.

 Edit -> This function gives the user 3 additional functions;
         Copy -> I do not know what this function does.
         Select All -> Highlights/Selects all of the text in
         the Directory Data text box.
         Unselect All -> Unselects all of the text in 
         the Directory Data text box.
         Select/Unselect are used in-conjunction with the 
         Copy function.

 Search -> This function gives the user 4 additional
         functions.
         Find, Find Next, Find Previous -> These functions
         find text in the Directory Data text box.
         Replace -> This function allows you to replace the
         text that is selected.  However this is just 
         a fake replacement as you can not edit the 
         Directory Data text box because it is created 
         as a read only text box.

 View -> This function gives the user 3 additional 
         functions.
         Goto Line ->  When selected will prompt the
         user for a line number, the line number being
         the line number the user wishes to see.
         What Line ->  When selected will tell the user
         what line number the cursor is on.
         Wrap ->  When selected will prompt the user
         to choose how to do line wrapping in the 
         Directory Data text box.
  

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 "RadioButton" is selected, colored
red, the directory data text box will be cleared out before
each directory query.  If the "RadioButton" 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.

-------------------------------------------------------------------

=item REQUIREMENTS.

To use this program you will need the following.


At least PERL 5.004 version.  You can get a stable version of PERL
from the following URl;
   http://cpan.org/src/index.html

Perl Tk800.015 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/

Depending on the modules loaded in your PERL system, you may need to
load the following 2 PERL modules.

Perl Convert-Berr module.  You can get this from the following URl;
   ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Convert/

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.

-------------------------------------------------------------------

=item INSTALLING THE SCRIPT.

Install the schema script anywhere you wish, I suggest 
/usr/local/bin/schema.

Install the dot.tklkup file in each users home directory
as .tklkup.

-------------------------------------------------------------------

=back

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 <charde@utdallas.edu>
If you find any errors in the code please let me know at 
charden@utdallas.edu.

=head1 COPYRIGHT

Copyright (c) 1999-2000 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

use Net::LDAP qw(:all);
use Net::LDAP::Filter;
use Net::LDAP::Util qw(ldap_error_name ldap_error_text);
use Net::LDAP::Constant;
use Getopt::Std;

use Tk;
use Tk::ErrorDialog;

#
# Global variables, wish I did not have to use them
# but Tk forces me to.
# Future project to resolve.
#
#

my $adata = "";
my $uid = "";
my $info = "";
my $slist;
my $sfile = 0;
my $fdata = "";

#--------------------------------------------------------
# Handle the command line parameter(s)
#--------------------------------------------------------
 
getopts( 'hdr' );
 
Usage() if ( $opt_h );

my $debug  = $opt_d ? 1 : 0;

#
#
#
# Fork this process on start up.
#
#
# If not in debug mode;
# Fork a child process and kill the parent.
# (That sounds nasty)
#

if ( !$debug ) {

        FORK: {

                if ( $pid = fork ) {
                        # this is parent process, so die
                        # 
                        exit;
                        } 
                elsif ( defined $pid) {
                        # this is the child process, so keep on running
                        #
                        &MAIN_PROCESS();                

                        } # End of elsif in FORK.

        } # End of FORK block.


} # End of if.
else {
        #
        # in debug mode, so do not fork but continue to run.
        #
        &MAIN_PROCESS();
        } # End of else


sub MAIN_PROCESS {

my $rbuid;
my $rbcn;
my $rbsn;
my $rbmail;
my $rbclear;
my $rbfile;
my $mainWindow;
my $lframe;
my $sframe;
my $sbbframe;
my $aframe;
my $tframe;
my $bframe;
my $hand = 'left';
my @attribute = ();
my @server    = ();
my @base    = ();

#
# Check for dot file, use it to configure program.
#

my $dotfile = $ENV{"HOME"} . "/.tklkup";

if ( -e $dotfile && -r $dotfile )
{

open(DOT, "<$dotfile");

@Input = <DOT>;

foreach (@Input)
{

my @data = ();

if ( /^#/ || /^\s+$/ ) { next; }

chomp();
@data = split(/:/);

$data[1] =~ s/^\s*//;
$data[1] =~ s/\s+$//;
#$data[1] =~ s/*#*$//;

$_ = $data[0];

TYPE: {

    /^hand/i && do {
                     $hand = $data[1];
                     last TYPE; };

    /^attribute/i && do {
                     push(@attribute, $data[1]);
                     last TYPE; };

    /^server/i && do {
                     push(@server, $data[1]);
                     last TYPE; };

    /^base/i && do {
                     push(@base, $data[1]);
                     last TYPE; };

                     print "Default found undefine type:  $_";

    } # End of case TYPE

}

close(DOT);

}

#
# Default is for left hand people!
# Over ride the dot file if the -r command line
# option is used.
#

if ( defined($opt_r) ) {

$hand   = $opt_r ? 'right' : 'left';
# my $hand   = $opt_r ? 'left' : 'right'; # uncomment this for right hand def.

}

#
# Default directory server.
#
if ( $#server < 1 ) { $server[0] = "ldap.umich.edu"; }

$LDAP_SERVER = $server[0];

#
# Default directory search base.
#

$LDAP_SEARCH_BASE = "ou=People,o=University of Michigan,c=us";

#
# Create Main Window
#

$mainWindow = MainWindow->new;

$mainWindow->title("Directory Schema Search");

#
# Create process Exit button
#

$mainWindow->Button(-text => "Exit", -command => 
      sub{ exit; }  )-> pack(-fill => "both", -padx => 2, -pady => 2 ) ;

$sframe = $mainWindow->LabFrame(-label => "DIRECTORY SERVER",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "top", -padx => 2, -pady => 2 );

$slist = $sframe ->Listbox( -height => 1  );

$slist->pack(-fill => "both", -expand => 1 );

$slist->insert("end", $LDAP_SERVER);

#
# Create bottom Search Directory frame
#

$bframe = $mainWindow->Frame(-borderwidth => 2, -relief => "groove")->pack(
      -fill => "both", -side => "bottom", -padx => 2, -pady => 2);

#
# Create Search Directory button
#

$bframe -> Button(-text => "Retrieve Directory Schema", 
        -command =>  \&search ) -> pack( -fill => "both");

#
# Create directory server selection button
# This is where the user will select the directory server to
# query.
#


if ( $hand eq 'left' )
{
$smenu = $mainWindow -> Menubutton(-indicator => 1, 
                 -text => "SELECT\n DIRECTORY \nSERVER",
                 -relief => "groove" )
                 -> pack(-side => "top", -anchor => "w", -padx => 5);
}
else 
{
$smenu = $mainWindow -> Menubutton(-indicator => 1, 
                 -text => "SELECT\n DIRECTORY \nSERVER",
                 -relief => "groove" )
                 -> pack(-side => "top", -anchor => "e", -padx => 5);
}
#
# Change or add additional directory servers between the / marks on 
# the following foreach loop.
# 
#

foreach ( @server ) 
{
   $smenu->radiobutton( -label => $_, -variable => \$LDAP_SERVER,
         -value => $_, -command => \&server );

}


$rbfilelabel = $mainWindow->LabFrame(-label => "SCHEMA DUMP TO FILE",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -anchor => "w", -padx => 2, -pady => 2);

$rbfile = $rbfilelabel -> Checkbutton(-text => "Write schema data to file, enter file\nname in text box below this line.   ",
      -variable =>  \$sfile, -onvalue => 1, -offvalue => 0 )
      -> pack(-anchor => "w" );
#
# Create Text Entry list box.
#

$rbfilelabel->Entry(-textvariable => \$fdata, -width => 25 ) 
      -> pack(-fill => 'x');


#
# Create list frame.
#

$lframe = $mainWindow->LabFrame(-label => "DIRECTORY SCHEMA DATA",
      -labelside => "acrosstop")
      ->pack( -fill => "both", -side => "top", -padx => 2, -pady => 2,
      -expand => 1);

#
# Create a Clear Data Radiobutton that will execute subroutine clear
# to clear the List box before each directory query.
#

$rbclear = $lframe -> Checkbutton(-text => "Clear directory data on each query.",
      -variable =>  \$clear, -onvalue => 1, -offvalue => 0 )
      -> pack(-anchor => sw );

$rbclear->select();

#
# Create a ROText Box that will actually contain the 
# returned directory data.
#

$list = $lframe ->Scrolled('ROText', -scrollbars => 'se',
        -width => 60, -height => 20, -wrap => 'none'  );

$list->pack(-fill => "both", -expand => 1 );

#
# Create Clear Attribute Data and Search Directory buttons
#

if ( $hand eq 'left' )
{
$lframe ->Button(-text => "     Clear Data     ",
     -command =>  \&clear ) -> pack(-anchor => sw, -padx => 5 );
}
else
{
$lframe ->Button(-text => "     Clear Data     ",
     -command =>  \&clear ) -> pack(-anchor => se, -padx => 5 );
}

#
# Run the Main loop looking for events.
#

MainLoop;



sub clear {

#
# Clear out text in List Box
#

$list->delete("1.0", "end");

} # End of clear subroutine

sub AClear {

#
# Clear out text in Attribute Box
#

$adata = "";

} # End of AClear subroutine

sub server {

#
# Put directory server name in list box
#

$slist->insert(0 , $LDAP_SERVER);

} # End of server subroutine


sub attribute {

#
# Build a correct Filter string from the data
# passed from the Additional Attributes
# radiobutton selection.
#

my $tmp = "(" . $uid . "=";

$info = $tmp;

} # End of attribute subroutine


sub base {

#
# Put directory server search base into the list box.
#

$sbblist->insert(0 , $LDAP_SEARCH_BASE);

} # End of server subroutine



} # End of MAIN_PROCESS subroutine




sub print_loop()
{
my $list = shift;
my $ocs = shift;
my $Title = shift;

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

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

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

}

} # End of subroutine print_loop

#
#
# Search the directory for data
#
#
#

sub search 
{

my $error;
my $dt = "/tmp/schema.dat.$$";

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

use Getopt::Std;

my %opt = (
  'h' => 'dirserv3',
  'd' => 0
);


#
# Parameter name array.
#

#
# Get command line options.
# 

my $ldap = new Net::LDAP($LDAP_SERVER,
                         timeout => 1,
                         debug => $opt{'d'},
                        ) or $error = 1;

if ( $error == 1 )
{
   $list->insert("end",  "Connect error:  $@\n");
   return;
}

$ldap->ldapbind( password => "", dn => "") or $error = 1;

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

#
# Get the schema, assumes cn=schema.
# This is NOT always the case.
#

my @items;
my @item;

$schema = $ldap->schema();

if ( $sfile )
{
  #
  # write to file instead of text box
  #
  $schema->dump( $fdata );
  $list->insert("end",  "Schema data written to file: $fdata\n");
  $sfile = 0;
  $fdata = "";
  return;
}


#
# Get the attributes
#
 
@atts = $schema->attributes(); 

#
# Display the attributes
#
 
&print_loop($list, \@atts, "attributeType") if ( defined(@atts) );

#
# Get the schema objectclasses
#
@ocs = $schema->objectclasses(); 

#
# Display the objectclasses
#
 
&print_loop($list, \@ocs, "objectClasses") if ( defined(@ocs) );

#
# Get the schema matchingrules
#
@ocs = $schema->matchingrules(); 

#
# Display the matchingrules
#
 
&print_loop($list, \@ocs, "matchingRules" ) if ( defined(@ocs) );

} # End of search subroutine

#----------------------------------------#
# Usage() - display simple usage message #
#----------------------------------------#
sub Usage
{
   print( "Usage: [-h] | [-d]\n" );
   print( "\t-d    Debug mode.  Display debug messages to stdout.\n" );
   print( "\t      Will not fork process.\n" );
   print( "\t-h    Help.  Display this message.\n" );
   exit( 1 );
}

