#!/usr/local/bin/perl -w
#---------#---------#---------#---------#---------#---------#---------#---------
#
# title:
#    read a record from directory servers using Net::LDAP
#
# description:
#    Check that the ldap port is accepting queries.
#    POD documentation at the end of the program.
#    Use 'perldoc ProgramName' to read.
#
#
# Author:       Steve
# Revision:     %A%
# Last Update:  %E%
#
# modifications:
# 15/01/01 larg
#    hacking to work for several servers. Started by crontab,
#   communicates by log file and MyTraps.
#   Also has a debug mode for checking its operation from the command line.
#
#   Note the outrageous lack of compartmentalisation into subroutines
#   due to having 6 hours to edit and test.  A hollowed out tree trunk
#   in a sea of perl fishing boats.
#
#---------#---------#---------#---------#---------#---------#---------#---------
   require 5.004; # refuse to work with old-school perl
   use strict;    # only work with the anal-retentive school of programming

   use Net::LDAP; # Graham Barr's library, not Netscape's PerLDAP
   use Net::LDAP::Util qw(ldap_error_name
                       ldap_error_text) ;       #Use for Error handling

###########################################
# Constants & Global variable declaration #
###########################################

# values needed to find the server
   use vars qw($PORT $TIMEOUT $DEFAULT_HOST);
   $PORT                = 389; # the standard port to connect to is 389.
   $TIMEOUT             = 120; # number of seconds to wait for a response


# create connect errors with this
   my %nonexistant_hosts    = (
               '1.2.3.4'       => 'nonexistant 1',
               '4.3.2.1'       => 'nonexistant 2',
               '9.9.9.9'       => 'nonexistant 3'
   );
   my %isp01_hosts    = (
               '194.73.65.130' => 'dunno',
               '194.73.65.131' => 'dunno this either'
   );

   # isp01 LDAP servers
   my %isp01_hosts        = (
               '10.216.84.153' => 'isp01lds01.isp01.com',
               '10.216.84.233' => 'isp01lds02.isp01.com',
               '10.216.84.155' => 'isp01lds03.isp01.com',
               '10.216.84.157' => 'isp01lds04.isp01.com'
   );

   # isp02 LDAP servers
   my %isp02_hosts       = (
               '10.216.4.34' => 'isp02LDS01.isp02.com',
               '10.216.4.59' => 'isp02LDS02.isp02.com',
               '10.216.4.35' => 'isp02LDS03.isp02.com',
               '10.216.4.60' => 'isp02LDS04.isp02.com'
   );

   # and here is your handy switch
#   my %hosts = %nonexistant_hosts;
   my %hosts = %isp01_hosts;

# values needed to bind to (ie. log into) a isp01 server
   use vars qw($username $password $port);
#   $username = 'cn=NONEXISTANT USER'; # create bind errors with this value
   $username = 'cn=Directory Manager';
   $password = 'password';         # bit naughty, leaving this here

# values needed to perform the search
   use vars qw($FILTER @REQUIRED_ATTRIBUTES $BASE);
   # on a isp01 server
#   $FILTER              = 'ispMail=NONEXISTANT-USER'; # create search errors with this value
   $FILTER              = 'ispMail=ioc.test@isp01.com';
   @REQUIRED_ATTRIBUTES = ('ispmailbox');
   $BASE                = 'o=isp01, c=uk';

   # on a isp01 server
#   $FILTER              = 'cn=zzz@isp01.com';
#   @REQUIRED_ATTRIBUTES = ('visp');
#   $BASE                = 'o=isp01';

# other crap
   use vars qw($VERSION $DEBUG $THIS_HOST);
   $VERSION             = '1.02';
   $DEBUG               = 0;  # see usage below for debug levels.
   my $log_file         = '/export/home/isp01/bin/ldap/ldap-client.log';
   use Sys::Hostname;
   $THIS_HOST           = hostname();
#########################################################################
# Main routine.                                                         #
#########################################################################

# check the command line
   use vars qw($opt_v $opt_d $opt_f $opt_q $DEBUG $VERBOSE $quiet $me);
   use Getopt::Std;
   $0 =~ m!([\w\-\.]+)$! || die "Called with an invalid name: $0";
   $me = $1;                            #Who am I?

   getopts('d:vf:q') || usage();        #Parse out options.
   $DEBUG     = $opt_d || 0;
   $VERBOSE   = $opt_v || 0;
   $quiet     = $opt_q || 0;            #Quiet mode?
   my $filter = $opt_f || $FILTER;
   die "You cannot specify both quiet and verbose modes.\n" if ($VERBOSE && $quiet);

   print STDERR "command line options: \n" if $DEBUG;
   print STDERR "   \$DEBUG     $DEBUG   \n" if $DEBUG;
   print STDERR "   \$VERBOSE   $VERBOSE \n" if $DEBUG;
   print STDERR "   \$quiet     $quiet   \n" if $DEBUG;
   print STDERR "   \$filter    $filter  \n" if $DEBUG;

   my @attrs = ();                      #Use a null list for all attributes
   @attrs    = @REQUIRED_ATTRIBUTES unless ($VERBOSE);

# make the connection
   my $date;    # timestamp for the log file
   my $host;    # test this
   my %status;  # and put the results in here

   foreach $host ( sort keys %hosts ) {
      print "host: $host \n" if $VERBOSE;
      $date = scalar localtime;

      print STDERR "making connection \n"       if $DEBUG;
      print STDERR "   \$TIMEOUT   $TIMEOUT \n" if $DEBUG;
      print STDERR "   \$host      $host    \n" if $DEBUG;

      my $ldap = Net::LDAP->new(
               $host,
               port    => $PORT,
               timeout => $TIMEOUT,
               debug   => $DEBUG
      );
      unless (defined $ldap) {
         $status{$host} = "[$date] $THIS_HOST: LDAP $host: unavailable: $@ " ;
         connection_error($@) if $DEBUG;
         # display the connect result
         print "   $status{$host} \n";
         next;
      }
      print STDERR "   \$ldap      $ldap \n" if $DEBUG;

# log in
      my $bind_result = $ldap->bind(
               version => 3
      );
# this generates an error but does NOT stop the client from binding
# to the server. Odd.
# This would be a fatal error on isp01 but it's normal elsewhere
#
#      if ($bind_result->code) {
#         print "a problem occurred when trying to bind.  \n" if $VERBOSE;
#         LDAPerror("search",$bind_result);
#         exit 4;
#      }
      print STDERR "   \$bind_result      $bind_result \n" if $DEBUG;

# search

      print STDERR "searching \n" if $DEBUG;
      my $search_result = LDAPsearch($ldap, $filter, \@attrs, $BASE );

# close the connection
      $ldap->unbind;

# have a look at the result code.

      print STDERR "classifying result \n" if $DEBUG;
      print STDERR "   \$search_result->code     ", $search_result->code, " \n" if $DEBUG;

      if ($search_result->code) {
         $status{$host} = "[$date] $THIS_HOST: LDAP $host: search error. code: ".$search_result->code ;
         LDAPerror("search",$search_result) if $DEBUG;
      } elsif (! check_results($search_result,\@REQUIRED_ATTRIBUTES)) {
         $status{$host} = "[$date] $THIS_HOST: LDAP $host: search error. cannot find the attributes: @REQUIRED_ATTRIBUTES \n" ;
      } else {
         $status{$host} = "[$date] $THIS_HOST: LDAP $host: ok";
      }
   # display the search result
   print "   $status{$host} \n";
   } # foreach

# if there are problems, raise a trap.
   my $ok_hosts        = 0;
   my $knackered_hosts = 0;

  # Raise a trap
  # see the man page for operation: man MyTrap
  my $trap_code;
  my $trap_msg  = <<EOT;
Please contact support.
There is a problem contacting the LDAP service from the portal web servers.

EOT

   # seek out the bad eggs...
   foreach $host ( sort keys %status ) {
      $status{$host} =~ m/ok$/ ? $ok_hosts++ : $knackered_hosts++ ;
      $trap_msg      .= "$status{$host} \n";
   }
   # ...and call the police!
   if ($knackered_hosts == 1 ) {
      $trap_code = "applicationFailureMajor";
      $trap_msg .= "\nRaise a priority 2 trap. \n";
      `MyTrap $trap_code "$trap_msg"`;
   } elsif ($knackered_hosts > 1 ) {
      $trap_code = "applicationFailureCritical";
      $trap_msg .= "\nRaise a priority 1 trap. \n";
      `MyTrap $trap_code "$trap_msg"`;
   }
   print STDERR "   \$ok_hosts         $ok_hosts \n" if $DEBUG;
   print STDERR "   \$knackered_hosts  $knackered_hosts \n" if $DEBUG;
   print STDERR "   \$trap_msg \n$trap_msg \n" if $DEBUG;

# make a log entry of the results
   print STDERR "adding lines to the log file: $log_file \n" if $DEBUG;
   open ( LOG, ">>$log_file");
   foreach $host ( sort keys %status ) {
      print LOG "$status{$host} \n";
      print STDERR "   \$status{$host}    $status{$host} \n" if $DEBUG;
   }
   close LOG;

#########################################################################
# connection_error($error_msg);                                         #
# Interpret the various connection errors and exit with a return code.  #
#########################################################################
sub connection_error {
   print STDERR "   script: $0 sub: connection_error \n" if $DEBUG;
  my($error_msg) = @_;

  if ($error_msg =~ /Connection refused/) {
    print STDERR "   LDAP connection refused.\n";
#    exit 1;
  }
  if ($error_msg =~ /Interrupted system call/) {
    print STDERR "   LDAP connection timed out.\n";
#    exit 2;
  }
  else {
    print STDERR "   Other connection failure: $error_msg!\n";
#    exit 3;
  }
}


#########################################################################
# check_results($result,\@attrs);                                       #
# Display the results of an LDAP query (if verbose), and check that we  #
# have a non-null value for each attribute we are passed. We should be  #
# passed a search result as a Net::LDAP::Search object.                 #
#########################################################################
sub check_results {
   print STDERR "   script: $0 sub: check_results \n" if $DEBUG;

   my($result,$attrs_ref) = @_;
   my($entr,$attr,@entries,%attributes_found);

  foreach $entr ($result->entries) {
    print "   DN: ",$entr->dn,"\n" if ($VERBOSE);
    foreach $attr (sort $entr->attributes){
      next if ($attr =~ /;binary$/);    #Skip binary data.
      my $value = join(',',@{$entr->get($attr)});
      print "   $attr: $value\n" if ($VERBOSE);
      $attributes_found{$attr} = 1 if ($value);
    }
  }

  #Check that we have a value for all attributes requested.
  foreach $attr (@$attrs_ref) {
    return 0 unless ($attributes_found{$attr});
  }

  return 1;
}



#########################################################################
# LDAPerror($from,$result_object);                                      #
# Print the error message stored in a search query object.              #
#########################################################################
sub LDAPerror {
   print STDERR "   script: $0 sub: LDAPerror \n" if $DEBUG;

  my ($from,$mesg) = @_;
  print STDERR "   LDAP $from failure: ", $mesg->code, " \n";
  print STDERR "   error name: ",         ldap_error_name($mesg->code), " \n";
  print STDERR "   error text: ",         ldap_error_text($mesg->code), " \n";
  print STDERR "   MessageID: ",          $mesg->mesg_id, " \n";
  print STDERR "   DN: ",                 $mesg->dn, " \n";
}



#########################################################################
# $Net_LDAP_Search_ob = LDAPsearch($ldap,$searchString,\@attrs,$base);  #
# Do a search and return the result. We set up defautls for @attrs and  #
# $base if required.                                                    #
#########################################################################
sub LDAPsearch {
   print STDERR "   script: $0 sub: LDAPsearch \n" if $DEBUG;

  my ($ldap,$searchString,$attrs,$base) = @_ ;

  # if they don't pass a base... set it for them
  if (!$base ) { $base = "o=isp01, c=uk"; }

  # if they don't pass an array of attributes...
  # set up something for them
  if (!$attrs ) { $attrs = ['cn','mail' ]; }


   print STDERR "   base    => $base         \n" if $DEBUG;
   print STDERR "   scope   => sub           \n" if $DEBUG;
   print STDERR "   filter  => $searchString \n" if $DEBUG;
   print STDERR "   attrs   => $attrs        \n" if $DEBUG;

#  my $result = $ldap->search (
#                base    => "$base",
#                scope   => "sub",
#                filter  => "$searchString"
#     );

   my $result = $ldap->search (
                base    => "$base",
                scope   => "sub",
                filter  => "$searchString",
                attrs   =>  $attrs
     );

}

#########################################################################
# usage();                                                               #
# Prints the usage message and exits.                                   #
#########################################################################
sub usage {
  print <<EoText;
Usage
   $me [Options]

Description
   Launches an LDAP query to several isp01 IDA servers
   to try to determine the ispmailbox attribute of ioc.test.

   See the POD documentation for more information: 'perldoc $me'

Options
   -d Digit   If passed a non-zero value then debug data will be sent
              to STDERR. Four bits are set to show packet traffic:
                      1   Show outgoing packets (using asn_hexdump).
                      2   Show incoming packets (using asn_hexdump).
                      4   Show outgoing packets (using asn_dump).
                      8   Show incoming packets (using asn_dump).
              Add these numbers to show traffic in both directions.
              Also displays some internal state information.
   -v         Verbose. Get all attributes from the LDAP server and
              display them.
   -f Filter  Specify the search filter. Default is
              ispMail=ioc.test\@isp01.com
   -q         Quiet. Don't print any messages.

EoText

  exit ;
}


__END__

#########################################################################
# Man page documentation in POD format.                                 #
#########################################################################
To update man pages, do something like the following. Your milage will vary :-)
export RW_LOCAL_MAN=/usr/local/man
export RW_LOCAL_DOCS=/export/home/campbels/public_html
export RW_LOCAL_DOCS=/filer/indium/isp01I-WWW/sparc-SunOS-5.6/operations/pub/isp01i


PATH=/opt/perl5004/bin:$PATH
pod2man ldap-client > $RW_LOCAL_MAN/man1/ldap-client.1
pod2html ldap-client > $RW_LOCAL_DOCS/programs/ldap-client.html

=head1 NAME

ldap-client - check that a given isp01I LDAP server is working correctly.

=head1 SYNOPSIS

ldap-client [Options]

Options:

=over 4

=item B<-v>

Verbose mode. By default, we just test for the ispmailbox attribute
and output an OK status message on success.
In Verbose mode, we also display all the attributes returned.

=item B<-q>

Quiet mode. Only print out error messages.

=item B<-f> I<Filter>

Specify the search filter to use. The default filter used is
ispMail=ioc.test@isp01.com

=item B<-d> I<Number>

Print debugging information. From the list below, add the numbers of
the options you want eg. the option '-d 3' shows traffic both ways.
           1   Show outgoing packets (using asn_hexdump).
           2   Show incoming packets (using asn_hexdump).
           4   Show outgoing packets (using asn_dump).
           8   Show incoming packets (using asn_dump).

=back

=head1 DESCRIPTION

This program uses the perl-ldap CPAN module to perform an LDAP query
on several LDAP servers. The servers are specified within the program.

The query we perform is to try to get the ispmailbox attribute when
ispMail=ioc.test@isp01.com

If any servers are unreachable, the program raises an alarm with the
support team. One missing route is classed
as a priority 2. Two or more is classed as a priority 1.

Source code for this program is in CVS on Pageboy in the ida module.

=head1 CHANGES

=over 4

=item Version 1.01

 Format the connection error messages.
 Exit with a different return code on each error status.
 Added the -f Filter switch.

=item Version 1.02

 Added Quiet mode.

=back

=head1 REQUIRES

This program requires the following CPAN modules:

=over 4

=item *

Convert-ASN1

=item *

perl-ldap

=back

=head1 AUTHOR

Steve  E<lt>F<steve@isp01.net>E<gt>

=cut
