389-ds-base 1.3.7.10-1ubuntu1 / usr / bin / repl-monitor

#!/usr/bin/env perl
# BEGIN COPYRIGHT BLOCK
# Copyright (C) 2001 Sun Microsystems, Inc. Used by permission.
# Copyright (C) 2007 Red Hat, Inc.
# All rights reserved.
#
# License: GPL (version 3 or any later version).
# See LICENSE for details. 
# END COPYRIGHT BLOCK
##############################################################################
#
# FILE: repl-monitor.pl
#
# SYNOPSIS:
#    repl-monitor.pl [-f configuration-file] [-h host] [-p port] [-r]
#                    [-c connection] [-a alias] [-k color] [-u refresh-url] 
#                    [-t refresh-interval] [-s] [-W]
#
#    repl-monitor.pl -v
#
# DESCRIPTION:
#    Given an LDAP replication "supplier" server, crawl over all the ldap
#    servers via direct or indirect replication agreements.
#    For each master replica discovered, display the maxcsn of the master
#    and the replication status of all its lower level replicas.
#    All output is in HTML.
#
# OPTIONS:
#    -f configuration-file
#       The configuration file contains the sections for the connection
#       parameters, the server alias, and the thresholds for different colors
#       when display the time lags between consumers and master.
#       If the Admin Server is running on Windows, the configuration-file
#       name may have format "D:/opt/replmon.conf".
#
#   The connection parameter section consists of the section name
#   followed by one of more connection parameter entries:
#
#       [connection]
#       host:port:binddn:bindpwd:bindcert
#       host:port=shadowport:binddn:bindpwd:bindcert
#       ...
#
#   where host:port default (*:*) to that in a replication agreement,
#   binddn default (*) to "cn=Directory Manager", and bindcert is the
#   pathname of cert db if you want the script to connect to the server
#   via SSL.  If bindcert is omitted, the connection will be simple
#   bind.
#   "port=shadowport" means to use shadowport instead of port if port
#   is specified in the replication agreement. This is useful when
#   for example, ssl port is specified in a replication agreement,
#   but you can't access the cert db from the machine where this
#   script is running. So you could let the script to map the ssl
#   port to a non-ssl port and use the simple bind.
#
#   A server may have a dedicated or a share entry in the connection
#   section. The script will find out the most matched entry for a given
#   server. For example, if all the ldap servers except host1 share the
#   same binddn and bindpassword, the connection section then just need
#   two entries:
#
#       [connection]
#        *:*:binddn:bindpassword:
#        host1:*:binddn:bindpassword:
#
#   If a host:port is assigned an alias, then the alias instead of
#   host:port will be displayed in The output file. Each host:port
#   can have only one alias. But each alias may be used by more than
#   one host:port.
#
#       [alias]
#       alias = host:port
#       ...
#
#   CSN time lags between masters and consumers might be displayed in
#   different colors based on their range. The thresholds for different
#   colors may be specified in color section:
#
#       [color]
#       lowmark (in minutes) = color
#       ...
# 
#   If the color section or color entry is missing, the default color
#   set is: green for [0-5) minutes lag, yellow [5-60), and red 60 and more.
#
#   The following three options (-c, -a, -k) are used if not providing a 
#   configuration file:
#
#    -c connection
#       The connection value is the same as the configuration file value(see above):
#           -c "host:port:binddn:bindpwd:bindcert"
#
#    -a alias
#       The alias value is the same as the configuration file value(see above):
#           -a "alias=host:port"
#
#    -k color
#       The color value is written as "lowmark:color".  Where the lowmark is in minutes.
#       This option is ignored if printing a plain text report.
#           -k "5=#ccffcc"
#       
#    -h host
#       Initial replication supplier's host. Default to the current host.
#
#    -p port
#       Initial replication supplier's port. Default to 389.
#
#    -r If specified, -r causes the routine to be entered without printing
#       HTML header information.  This is suitable when making multiple calls
#       to this routine (e.g. when specifying multiple, different, "unrelated"
#       supplier servers) and expecting a single HTML output. 
#
#    -t refresh-interval
#       Specify the refresh interval in seconds. This option has to be
#       jointly used with option -u.
#
#    -u refresh-url
#       The output HTML file may invoke a CGI program periodically. If
#       this CGI program in turn calls this script, the effect is that
#       the output HTML file would automatically refresh itself. This
#       is useful for continuing monitoring. See also option -t.
#
#    -s Print output in plain text, instead of HTML.
#
#    -W Prompt for connection passwords.
#
#    -?, --help
#       Print usage.
#
#    -v Print out the version of this script
# 
# DIAGNOSTICS:
#    There are several ways to invoke this script if you got error
#    "Can't locate Mozilla/LDAP/Conn.pm in @INC", or
#    "usage: Undefined variable":
#
#    0. Prerequisite: NSPR, NSS, Mozilla LDAP C SDK, PerLDAP
#
#    1. Run this perl script via repl-monitor, which sets up LD_LIBRARY_PATH
#       $ repl-monitor
#
#    2. If 1 does not work, try invoking this script as follows.
#       Assuming <MYPERLDIR> contains Mozilla/LDAP:
#       perl -I <MYPERLDIR> repl-monitor.pl
#
#############################################################################
# enable the use of our bundled perldap with our bundled ldapsdk libraries
# all of this nonsense can be omitted if the mozldapsdk and perldap are
# installed in the operating system locations (e.g. /usr/lib /usr/lib/perl5)
# this script is always invoked by repl-monitor-cgi.pl, which sets all of these
# If using this script standalone, be sure to set the shared lib path and
# the path to the perldap modules.

use strict;
use warnings;
use lib qw(/usr/lib/x86_64-linux-gnu/dirsrv/perl);

my $usage = "\nusage: $0 [-f configuration-file | --configfile configuration-file] " .
         "[-c connection, --conn connection] [-a alias, --alias alias] [-k color, --color color] " . 
         "[-h host, --host host] [-p port, --port port] [-r, --skip-header] [-s, --text] " .
         "[-u refresh-url, --url refresh-url] [-t refresh-interval, --interval refresh-interval ] " .
         "[-W, --prompt] [-?, --help] [-v | --version]\n"; 

use Getopt::Long;		# parse command line arguments
use Mozilla::LDAP::Conn;	# LDAP module for Perl
use Mozilla::LDAP::Utils qw(normalizeDN);	# LULU, utilities.
use Mozilla::LDAP::API qw(:api :ssl :apiv3 :constant); # Direct access to C API
use Time::Local; # to convert GMT Z strings to localtime
use POSIX;

#
# Global variables
#
my $product = "Directory Server Replication Monitor";
my $version = "Version 1.1";

# ldap servers given or discovered from the replication agreements:
my @servers; # = (host:port=shadowport:binddn:password:cert_db)
my $serveridx;

# entries read from the connection section of the configuration file:
my @allconnections; # = (host:port=shadowport:binddn:password:cert_db)

# aliases of ldap servers read from the configuration file:
my %allaliases; # = {$host:$port} = (alias)

# colors
my %allcolors;
my @colorkeys;

# replicas discovered on all ldap servers
my @allreplicas; # = (server#:replicaroot:replicatype:serverid:replicadn)

# ruvs retrieved from all replicas
my %allruvs; # = {replica#:masterid} = (rawcsn:decimalcsn;mon/day/year hh:mi:ss)

# agreements discovered on all ldap supplier servers:
my @allagreements; # = (supplier_replica#:consumer#:conntype:schedule:status)
# the array may take another format after the consumer replicas are located:
# @allagreements; # = (supplier_replica#:consumer_replica#:conntype:schedule:status)

# agmt maxcsns hash
my %agmtmaxcsn = ();

# ldap connection hash
my %ld; 

my ($opt_f, $opt_h, $opt_p, $opt_u, $opt_t, $opt_r, $opt_s);
my (@conns, @alias, @color);
my ($section, $interval, $now, $mm, $dd, $tt, $yy, $wday);
my ($fn, $rc, $prompt, $last_sidx);
my $supplierUrl = "";
my %passwords = ();
my $passwd = "";
$prompt = "";

#main
{
	# turn off buffered I/O
	$| = 1;

	# Check for legal options
  	GetOptions(
		'h|host=s' => \$opt_h,
		'p|port=s' => \$opt_p,
		'f|configfile=s' => \$opt_f,
		'c|conn=s' => \@conns,
		'a|alias=s' => \@alias,
		'k|color=s' => \@color,
		'u|url=s' => \$opt_u,
		't|interval=s' => \$opt_t,
		'W|prompt' => sub { $prompt = "yes"; },
		'r|skip-header' => sub { $opt_r = "1"; },
		's|text' => sub {$opt_s = "1"; },
		'help|?' => sub { print $usage; exit 0;},
		'v|version' => sub { print "$product - $version\n"; exit 0;}
	) or die "Usage error: $usage\n";

	exit -1 if &validateArgs < 0;
	exit if &read_cfg_file ($opt_f) < 0;

	$interval = $opt_t;
	$interval = 300 if ( !$interval || $interval <= 0 );

	# Get current date/time
	$now = strftime "%a %b %e %Y %H:%M:%S", localtime;

	# if no -r (Reenter and skip html header), print html header
	if (!$opt_r) {
		# print the HTML header
		&print_html_header;
	} else  {
		if($opt_s){
			print"\n";
		} else {
			# print separator for new replication set
			print "<hr width=90% size=3><br>\n";
		}
	}

	# Start with the given host and port
	# The index names in %ld are defined in Mozilla::LDAP::Utils::ldapArgs()
	&set_server_params();
	&add_server ("$ld{host}:$ld{port}:$ld{bind}:$ld{pswd}:$ld{cert}");

	$serveridx = 0;
	while ($serveridx <= $#servers) { 
		if (&get_replicas ($serveridx) != 0 && $serveridx == 0) {
			my ($host, $port, $binddn) = split (/:/, $servers[$serveridx]);
			print("Login to $host:$port as \"$binddn\" failed\n");
			exit;
		}
		$serveridx++;
	} 

	&find_consumer_replicas;
	&process_suppliers;

	# All done! - well, for the current invokation only
	# print "</body></html>\n";
	exit;  
} 

sub validateArgs
{
	$rc = 0;

	%ld = Mozilla::LDAP::Utils::ldapArgs();
	if (!$opt_f && $#conns < 0) {
		if($opt_s){
			print "Error: Missing configuration file or connection parameter.\n";
			print $usage;  
		} else {
			print "<p>Error: Missing configuration file or connection paramater.\n";
			print "<p>If you need help on the configuration file, or script usage, " .
			"Please go back and click the Help button.\n";
			#print $usage; # Don't show usage in CGI
		}
		$rc = -1;
	}
	elsif (!$opt_h) {
		chop ($ld{"host"} = `hostname`);
	}

	return $rc;
}

sub read_cfg_file
{
	($fn) = @_;
	my $tmp;
	
	# process the command line config params
	@allconnections = @conns;

	if($#alias >= 0){
		foreach $tmp (@alias){
			$tmp =~ m/^\s*(\S.*)\s*=\s*(\S+)/;
			$allaliases{$2} = $1;
		}
	}
	if($#color >= 0){
		foreach $tmp (@color){
			$tmp =~ m/^\s*(-?\d+)\s*=\s*(\S+)/;
			$allcolors{$1} = $2;
		}
	}
	
	if($opt_f){
		unless (open(CFGFILEHANDLE, $fn)) {
			if($opt_s){
				print "Error: Can't open configuration file\"$fn\": $!.\n";
			} else {
				print "<p>Error: Can't open configuration file\"$fn\": $!.\n";
				print "<p>If you need help on the configuration file, Please go back and click the Help button.\n";
			}
    			return -1;
    		}
    		$section = 0;
    		while (<CFGFILEHANDLE>) {
    			next if (/^\s*\#/ || /^\s*$/);
			chop ($_);
    		if (m/^\[(.*)\]/) {
    			$section = $1;
    		}
    		else {
    			if ( $section =~ /conn/i ) {
    				push (@allconnections, $_);
    			}
    			elsif ( $section =~ /alias/i ) {
    				m/^\s*(\S.*)\s*=\s*(\S+)/;
    				$allaliases {$2} = $1;
    			}
    			elsif ( $section =~ /color/i ) {
    				m/^\s*(-?\d+)\s*=\s*(\S+)/;
    				$allcolors {$1} = $2;
    			}
    		}
    	}
    	close (CFGFILEHANDLE);
	}
	if ( ! keys (%allcolors) ) {
		$allcolors {0} = "#ccffcc"; #apple green
		$allcolors {5} = "#ffffcc"; #cream yellow
		$allcolors {60} = "#ffcccc"; #pale pink
	}
	@colorkeys = sort ({ $a <=> $b } keys (%allcolors));
    
	return 0;
}

sub get_replicas
{
	$serveridx = $_[0];
	my ($conn, $host, $port, $shadowport, $binddn, $bindpwd, $bindcert);
	my ($others);
	my ($replica, $replicadn);
	my ($ruv, $replicaroot, $replicatype, $serverid, $masterid, $maxcsn);
	my ($type, $flag, $i);
	my ($myridx, $ridx, $cidx);
	my ($lastmodifiedat, $agreement);

	#
	# Bind to the server
	#
	if($#servers < 0 || $serveridx > $#servers + 1){
		return -1;
	}

	($host, $port, $binddn, $bindpwd, $bindcert) = split (/:/, "$servers[$serveridx]", 5);
	($port, $shadowport) = split (/=/, $port);
	$shadowport = $port if !$shadowport;

	$conn = new Mozilla::LDAP::Conn ($host, $shadowport, "$binddn", $bindpwd, $bindcert);
	return -1 if (!$conn);

	#
	# Get all the replica on the server
	#
	$myridx = $#allreplicas + 1;
	$replica = $conn->search ("cn=mapping tree,cn=config",
				"sub",
				"(objectClass=nsDS5Replica)", 0,
				qw(nsDS5ReplicaRoot nsDS5ReplicaType nsDS5Flags nsDS5ReplicaId));
	while ($replica) {
		$replicadn = $replica->getDN;
		$replicaroot = normalizeDN ($replica->{nsDS5ReplicaRoot}[0]);
		$type      = $replica->{nsDS5ReplicaType}[0];
		$flag      = $replica->{nsDS5Flags}[0];
		$serverid  = $replica->{nsDS5ReplicaId}[0];

		# flag = 0: change log is not created
		# type = 2: read only replica
		# type = 3: updatable replica
		$replicatype = $flag == 0 ? "consumer" : ($type == 2 ? "hub" : "master");

		push (@allreplicas, "$serveridx:$replicaroot:$replicatype:$serverid:$replicadn");

		$replica = $conn->nextEntry ();
	}

	#
	# Get ruv for each replica
	#
	for ($ridx = $myridx; $ridx <= $#allreplicas; $ridx++) {
		my @agmtParts;
        
		$replicaroot = $1 if ($allreplicas[$ridx] =~ /^\d+:([^:]*)/);
		# do a one level search with nsuniqueid in the filter - this will force the use of the
		# nsuniqueid index instead of the entry dn index, which seems to be unreliable in
		# heavily loaded servers
		$ruv = $conn->search($replicaroot, "one",
							 "(&(nsuniqueid=ffffffff-ffffffff-ffffffff-ffffffff)(objectClass=nsTombstone))",
							 0, qw(nsds50ruv nsruvReplicaLastModified nsds5AgmtMaxCSN));
		next if !$ruv; # this should be an error case . . .

		for ($ruv->getValues('nsds50ruv')) {
			if (m/\{replica\s+(\d+).+?\}\s*\S+\s*(\S+)/i) {
				$masterid = $1;
				$maxcsn = &to_decimal_csn ($2);
				$allruvs {"$ridx:$masterid"} = "$2:$maxcsn";
			}
		}
		
		for ($ruv->getValues('nsds5AgmtMaxCSN')) {
			# nsds5AgmtMaxCSN = "replica index(ridx);suffix;agmtname;host;port;rid;maxcsn"
			@agmtParts = split ( ";", $_);
			$agmtParts[0] =~ s/ //; # remove spaces
			$agmtParts[0] =~ lc $agmtParts[0];
			if($agmtParts[4] eq "unavailable"){
				$agmtmaxcsn{"$ridx;$agmtParts[0];$agmtParts[1];$agmtParts[2];$agmtParts[3]"} = "Unavailable";
			} else {
				$agmtmaxcsn{"$ridx;$agmtParts[0];$agmtParts[1];$agmtParts[2];$agmtParts[3]"} = $agmtParts[5];
			}
		}

		for ($ruv->getValues('nsruvReplicaLastModified')) {
			if (m/\{replica\s+(\d+).+?\}\s*(\S+)/i) {
				$masterid = $1;
				$lastmodifiedat = hex($2);
				my ($sec, $min, $hour, $mday, $mon, $year) = localtime ($lastmodifiedat);
				$mon++;
				$year += 1900;
				$hour = "0".$hour if ($hour < 10);
				$min = "0".$min if ($min < 10);
				$sec = "0".$sec if ($sec < 10);
				$allruvs {"$ridx:$masterid"} .= ";$mon/$mday/$year $hour:$min:$sec";
			}
		}
	}

	#
	# Get all agreements for each supplier replica
	#
	for ($ridx = $myridx; $ridx <= $#allreplicas; $ridx++) {
		$_ = $allreplicas[$ridx];

		# Skip consumers
		next if m/:consumer:/i;

		m/:([^:]*)$/;
		$replicadn = $1;
		my @attrlist = qw(cn nsds5BeginReplicaRefresh nsds5replicaUpdateInProgress
						  nsds5ReplicaLastInitStatus nsds5ReplicaLastInitStart
						  nsds5ReplicaLastInitEnd nsds5replicaReapActive
						  nsds5replicaLastUpdateStart nsds5replicaLastUpdateEnd
						  nsds5replicaChangesSentSinceStartup nsds5replicaLastUpdateStatus
						  nsds5ReplicaHost nsDS5ReplicaRoot
						  nsds5ReplicaPort nsDS5ReplicaBindMethod nsds5ReplicaUpdateSchedule);
		$agreement = $conn->search("$replicadn", "sub", "(objectClass=nsDS5ReplicationAgreement)",
								   0, @attrlist);
		while ($agreement) {

			my %agmt = ();
			# Push consumer to server stack if we have not already
			$host = ($agreement->getValues('nsDS5ReplicaHost'))[0];
			$port = ($agreement->getValues('nsDS5ReplicaPort'))[0];
			$cidx = &add_server ("$host:$port");
			for (@attrlist) {
			  $agmt{$_} = ($agreement->getValues($_))[0];
			}
			if ($agmt{nsDS5ReplicaBindMethod} =~ /simple/i) {
			  $agmt{nsDS5ReplicaBindMethod} = 'n';
			}
			if (!$agmt{nsds5ReplicaUpdateSchedule} ||
			    ($agmt{nsds5ReplicaUpdateSchedule} eq '0000-2359 0123456') ||
			    ($agmt{nsds5ReplicaUpdateSchedule} eq '*') ||
			    ($agmt{nsds5ReplicaUpdateSchedule} eq '* *')) 
			{
				$agmt{nsds5ReplicaUpdateSchedule} = 'always in sync';
			}
			$agmt{ridx} = $ridx;
			$agmt{cidx} = $cidx;
			push @allagreements, \%agmt;

			$agreement = $conn->nextEntry ();
		}
	}

	$conn->close;

	return 0;
}

#
# Initially, the agreements have consumer host:port info instead of
# replica info. This routine will find the consumer replica info
#
sub find_consumer_replicas
{
	my ($m_ridx);		# index of master's replica
	my ($s_ridx);		# index of supplier's replica
	my ($c_ridx);		# index of consumer's replica
	my ($c_sidx);		# index of consumer server
	my ($remainder);	#
	my ($s_replicaroot);	# supplier replica root
	my ($c_replicaroot);	# consumer replica root
	my ($j, $val);

	#
	# Loop through every agreement defined on the current supplier replica
	#
	foreach (@allagreements) {
		$s_ridx = $_->{ridx};
		$c_sidx = $_->{cidx};
		$s_replicaroot = $1 if ($allreplicas[$s_ridx] =~ /^\d+:([^:]*)/);
		$c_replicaroot = "";

		# $c_ridx will be assigned to -$c_sidx
		# if the condumer is not accessible
		# $c_sidx will not be zero since it's
		# not the first server.
		$c_ridx = -$c_sidx;	# $c_sidx will not be zero

		# Loop through consumer's replicas and find
		# the counter part for the current supplier
		# replica
		for ($j = 0; $j <= $#allreplicas; $j++) {

			# Get a replica on consumer
	    		# I'm not sure what's going on here, but possibly could be made
			# much simpler with normalizeDN and/or ldap_explode_dn
			if ($allreplicas[$j] =~ /^$c_sidx:([^:]*)/) {
				$val = $1;

				# We need to find out the consumer
				# replica that matches the supplier
				# replicaroot most.
				if ($s_replicaroot =~ /^.*$val$/i &&
					length ($val) >= length ($c_replicaroot)) {
					$c_ridx = $j;

					# Avoid case-sensitive comparison
					last if (length($s_replicaroot) == length($val));
					$c_replicaroot = $val;
				}
			}
		}
		$_->{ridx} = $s_ridx;
		$_->{cidx} = $c_ridx;
	}
}

sub process_suppliers
{
	my ($ridx, $mid, $maxcsn, $ismaster);
	$ismaster = 0;
	$mid = "";

	$last_sidx = -1;	# global variable for print html page

	for ($ridx = 0; $ridx <= $#allreplicas; $ridx++) {
		# Handle masters and hubs
		if ($allreplicas[$ridx] =~ /:master:(\d+):/i) {
			$mid = $1;
			# Skip replicas without agreements defined yet
			next if (! grep {$_->{ridx} == $ridx} @allagreements);
			$maxcsn = &print_master_header ($ridx, $mid);
			if ( "$maxcsn" ne "Unavailable" ) {
				&print_consumer_header ();
				&print_consumers ($ridx, $mid);
			}
			$ismaster = 1;
		} elsif (($ismaster == 0) && ($allreplicas[$ridx] =~ /:hub:(\d+):/i)) {
			$mid = $1;

			# Skip replicas without agreements defined yet
			next if (! grep {$_->{ridx} == $ridx} @allagreements);

			foreach my $key (keys %allruvs) {
				if ( $key =~ /$ridx:/) {
					my ($myridx, $mymid) = split ( /:/, "$key" );
					$maxcsn = &print_hub_header($myridx, $mymid);
					&print_consumer_header ();
					&print_consumers ($myridx, $mymid);
				}
			}
		}
		&print_supplier_end;
	}

	if ($mid eq "") {
		if($opt_s){
			print "The server is not a master or a hub or it has no replication agreement\n";
		} else {
			print "<p>The server is not a master or a hub or it has no replication agreement\n";
		}
	}
	if($opt_s){
		print "\n";
	}
}

sub print_master_header
{
	my ($ridx, $mid) = @_;
	my ($myruv) = $allruvs {"$ridx:$mid"};
	my ($maxcsnval) = split ( /;/, "$myruv" );
	my ($maxcsn) = &to_string_csn ($maxcsnval);
	my ($sidx, $replicaroot, $replicatype, $serverid) = split (/:/, $allreplicas[$ridx]);
	my ($sline, $slen, $ii);
    
	if ( $maxcsn eq "" ) {
		return $maxcsn;
	}

	# Print the master name
	if ( $last_sidx ne $sidx ) {
		my ($ldapurl) = $supplierUrl = &get_ldap_url ($sidx, "n/a");
		&print_legend if ( $last_sidx < 0);
		if($opt_s){
			$sline = "Supplier: $ldapurl";
			$slen = length $sline;
			print "\n$sline\n";
			for ($ii = 0; $ii < $slen; $ii++){
				print "-";
			}
			print "\n";
		} else {
			print "<p><p><hr><p>\n";
			print "\n<p><center class=page-subtitle><font color=#0099cc>\n";
			print "Supplier:&nbsp $ldapurl</center>\n";
		}
		$last_sidx = $sidx;
	} else {
		print "\n";
	}

	# Print the current replica info on the master
	if($opt_s){
		print "Replica Root: $replicaroot\n";
		print "Replica ID: $serverid\n";
		print "Max CSN: $maxcsn\n";
	} else {
		print "\n<p><table border=0 cellspacing=1 cellpadding=6 cols=10 width=100% class=bgColor9>\n";
		print "\n<tr><td colspan=10><center>\n";
		print "<font class=areatitle>Replica ID:&nbsp;</font>";
		print "<font class=text28>$serverid</font>\n";
		print "<font class=areatitle>Replica Root:&nbsp;</font>";
		print "<font class=text28>$replicaroot</font>\n";
		print "<font class=areatitle>Max CSN:&nbsp;</font>";
		print "<font class=text28>$maxcsn</font>\n";
	}
	return $maxcsn;
}

sub print_hub_header
{
	my ($ridx, $mid) = @_;
	my ($myruv) = $allruvs {"$ridx:$mid"};
	my ($maxcsnval) = split ( /;/, "$myruv" );
	my ($maxcsn) = &to_string_csn ($maxcsnval);
	my ($sidx, $last_sidx, $replicaroot, $replicatype, $serverid) = split (/:/, $allreplicas[$ridx]);

	# Print the master name
	if ( $last_sidx != $sidx ) {
		my ($ldapurl) = &get_ldap_url ($sidx, $sidx);
		&print_legend if ( $last_sidx < 0);
		if($opt_s){
			print "Hub: $ldapurl\n";
		} else {
			print "<p><p><hr><p>\n";
			print "\n<p><center class=page-subtitle><font color=#0099cc>\n";
			print "Hub:&nbsp $ldapurl</center>\n";
		}
		$last_sidx = $sidx;
	}

	# Print the current replica info on the master
	if($opt_s){
		print "\nReplica Root: $replicaroot\n";
		print "Replica ID: $serverid\n";
		print "Max CSN: $maxcsn\n-\n";
	} else {
		print "\n<p><table border=0 cellspacing=1 cellpadding=6 cols=10 width=100% class=bgColor9>\n";
		print "\n<tr><td colspan=10><center>\n";
		print "<font class=areatitle>Replica ID:&nbsp;</font>";
		print "<font class=text28>$serverid</font>\n";
		print "<font class=areatitle>Replica Root:&nbsp;</font>";
		print "<font class=text28>$replicaroot</font>\n";
		print "<font class=areatitle>Max CSN:&nbsp;</font>";
		print "<font class=text28>$maxcsn</font>\n";
	}
	return $maxcsn;
}

sub print_consumer_header
{
	if($opt_s) { return; } # we'll do the text printing in "print_consumers"
	
	#Print the header of consumer
	print "\n<tr class=bgColor16>\n";
	print "<th nowrap>Consumer</th>\n";
	print "<th nowrap>Time Lag</th>\n";
	print "<th nowrap>Supplier Max CSN</th>\n";
	print "<th nowrap>Consumer Max CSN</th>\n";
	print "<th nowrap>Last Modify Time</th>\n";
	print "<th nowrap>Supplier</th>\n";
	print "<th nowrap>Sent/Skipped</th>\n";
	print "<th nowrap>Update Status</th>\n";
	print "<th nowrap>Update Started</th>\n";
	print "<th nowrap>Update Ended</th>\n";
	print "<th nowrap colspan=2>Schedule</th>\n";
	print "<th nowrap>SSL?</th>\n";
	print "</tr>\n";
}

sub print_consumers
{
	my ($m_ridx, $mid) = @_;
	my ($ignore, $m_replicaroot) = split (/:/, $allreplicas[$m_ridx]);
	my (@consumers, @ouragreements, @myagreements);
	my ($s_ridx, $c_ridx, $s_sidx, $conntype, $schedule, $status);
	my ($c_maxcsn, $c_maxcsn_str, $c_lastmodified, $c_sidx, $lag, $markcolor);
	my ($c_replicaroot, $c_replicatype);
	my ($first_entry, $s_ldapurl, $c_ldapurl);
	my $supplier_maxcsn = "Unavailable";
	my ($nrows);
	my ($found);

	undef @ouragreements;
	$c_lastmodified = "Unavailable";
    
	# Collect all the consumer replicas for the current master replica
	push (@consumers, $m_ridx);
	foreach (@consumers) {
		$s_ridx = $_;
		for (@allagreements) {
			next if ($_->{ridx} != $s_ridx);
			$c_ridx = $_->{cidx};
			next if $c_ridx == $m_ridx;
			push @ouragreements, $_;
			$found = 0;
			foreach (@consumers) {
				if ($_ == $c_ridx) {
					$found = 1;
					last;
				}
			}
			push (@consumers, $c_ridx) if !$found;
		}
	}

	# Print each consumer replica
	my ($myruv) = $allruvs {"$m_ridx:$mid"};
	my ($m_maxcsn) = split ( /;/, "$myruv" );
	foreach (@consumers) {
		$c_ridx = $_;
		next if $c_ridx == $m_ridx;
        
		if ($c_ridx >= 0) {
			$myruv = $allruvs {"$c_ridx:$mid"};
			if ($myruv) {
				($c_maxcsn, $c_lastmodified) = split ( /;/, $myruv );
				($c_sidx, $c_replicaroot, $c_replicatype) = split (/:/, $allreplicas[$c_ridx]);
				$c_replicaroot = "same as master" if $m_replicaroot eq $c_replicaroot;
			}
		}
		else {
			# $c_ridx is actually -$c_sidx when c is not available
			$c_sidx = -$c_ridx;
			$c_maxcsn_str = "Unavailable";
			$lag = "n/a";
			$markcolor = "red";
			$c_replicaroot = "Unavailable";
			$c_replicatype = "Unavailable";
		}

		$nrows = 0;
		foreach (@ouragreements) {
		$s_ridx = $_->{ridx};
		$s_sidx = $1 if $allreplicas [$s_ridx] =~ /^(\d+):/;
		$s_ldapurl = &get_ldap_url ($s_sidx, "n/a");
		next if ($_->{cidx} != $c_ridx || $supplierUrl ne $s_ldapurl);
			$nrows++;
		}

		$first_entry = 1;
		foreach (@ouragreements) {
			$s_ridx = $_->{ridx};
			$s_sidx = $1 if $allreplicas [$s_ridx] =~ /^(\d+):/;
			$s_ldapurl = &get_ldap_url ($s_sidx, "n/a");
			next if ($_->{cidx} != $c_ridx || $supplierUrl ne $s_ldapurl);
			$conntype = $_->{nsDS5ReplicaBindMethod};
			$status = $_->{nsds5replicaLastUpdateStatus};
			$schedule = $_->{nsds5ReplicaUpdateSchedule};

			# Print out the consumer's replica and ruvs
			if(!$opt_s){ print "\n<tr class=bgColor13>\n"; }
			if ($first_entry) {
				$first_entry = 0;
				$c_ldapurl = &get_ldap_url ($c_sidx, $conntype);
				if ($c_ridx >= 0) {
					($c_maxcsn_str, $lag, $markcolor, $supplier_maxcsn) =
					&cacl_time_lag ($_->{nsDS5ReplicaRoot},
							$_->{cn},
							$_->{nsds5ReplicaHost},
							$_->{nsds5ReplicaPort},
							$s_ridx,
							$m_maxcsn,
							$c_maxcsn);
					if(!$opt_s){ $c_maxcsn_str =~ s/ /\<br\>/; }
				}
				if($opt_s){
					print "-\nConsumer: $c_ldapurl\nType: $c_replicatype\n";
					print "Time Lag: $lag\n";
					print "Supplier Max CSN: $supplier_maxcsn\n";
					print "Consumer Max CSN: $c_maxcsn_str\n";
					print "Last Modify Time: $c_lastmodified\n";
				} else {
					print "<td rowspan=$nrows width=5% class=bgColor5>$c_ldapurl<BR>Type: $c_replicatype</td>\n";
					print "<td rowspan=$nrows width=5% nowrap bgcolor=$markcolor><center>$lag</center></td>\n";
					print "<td rowspan=$nrows width=15% nowrap>$supplier_maxcsn</td>\n";
					print "<td rowspan=$nrows width=15% nowrap>$c_maxcsn_str</td>\n";
					print "<td rowspan=$nrows width=15% nowrap>$c_lastmodified</td>\n";
				}
			}
			if($opt_s){ 
				print "Supplier: $s_ldapurl\n";
			} else {
				print "<td width=5% nowrap><center>$s_ldapurl</center></td>\n";
			}
			my $changecount = $_->{nsds5replicaChangesSentSinceStartup};
			if ( $changecount =~ /^$mid:(\d+)\/(\d+) / || $changecount =~ / $mid:(\d+)\/(\d+) / ) {
				$changecount = "$1 / $2";
			}
			elsif ( $changecount =~ /^(\d+)$/ ) {
				$changecount = $changecount . " / " . "$_->{nsds5replicaChangesSkippedSinceStartup}";
			}
			else {
				$changecount = "0 / 0";
			}
			if($opt_s){
				print "Sent/Skipped: $changecount\n";
			} else {
				print "<td width=3% nowrap>$changecount</td>\n";
			}   
			my $redfontstart = "";
			my $redfontend = "";
			if ($status !~ /Error \(0\)/i) {
			  $redfontstart = "<font color='red'>";
			  $redfontend = "</font>";
			}
			elsif ($status =~ /^(\d+) /) {
				if ( $1 != 0 ) {
					# warning
					$redfontstart = "<font color='#FF7777'>";
					$redfontend = "</font>";
				}
			}
			if($opt_s){
				print "Update Status: $status\n";
				print "Update Started: ", &format_z_time($_->{nsds5replicaLastUpdateStart}), "\n";
				print "Update Ended: ", &format_z_time($_->{nsds5replicaLastUpdateEnd}), "\n";			
			} else {
				print "<td width=20% nowrap>$redfontstart$status$redfontend</td>\n";
				print "<td nowrap>", &format_z_time($_->{nsds5replicaLastUpdateStart}), "</td>\n";
				print "<td nowrap>", &format_z_time($_->{nsds5replicaLastUpdateEnd}), "</td>\n";
			}
			if ( $schedule =~ /always/i ) {
				if($opt_s){
					print "Schedule: $schedule\n";
				} else {
					print "<td colspan=2 width=10% nowrap>$schedule</td>\n";
				}
			}
			else {
				my ($ndays, @days);
				$schedule =~ /(\d\d)(\d\d)-(\d\d)(\d\d) (\d+)/;
				if($opt_s){
				    print "Schedule: $1:$2-$3:$4 ";
				} else {
				    print "<td width=10% nowrap>$1:$2-$3:$4</td>\n";
				}
				$ndays = $5;
				$ndays =~ s/(\d)/$1,/g;
				@days = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[eval $ndays];
				if($opt_s){
				    print "@days\n";
				} else {
				    print "<td width=10% nowrap>@days</td>\n";
				}
			}
			if($opt_s){
				print "SSL: $conntype\n";
			} else {
				print "<td width=3% nowrap class=bgColor5>$conntype</td>\n";
			}
		}
	}
}

sub get_supplier_maxcsn
{
	my ($ridx, $s, $cn, $h, $p) = @_;
	my $decimalcsn;
	my $csn = "Unavailable";
	# normalize suffix
	$s =~ s/ //;
	$s =~ lc $s;
	my $agmt = "$ridx;$s;$cn;$h;$p";
    
	foreach my $key (keys %agmtmaxcsn){
		if ($key eq $agmt){
			$csn = $agmtmaxcsn{$key};
			last;
		}
	}
	if($csn && $csn ne "Unavailable"){
		$decimalcsn = &to_decimal_csn ($csn);
		return "$csn:$decimalcsn";
	}
	
	return $csn;
}

sub cacl_time_lag
{
	my ($s, $cn, $h, $p, $ridx, $s_maxcsn, $c_maxcsn) = @_;
	my ($markcolor);
	my ($m_maxcsn, $csn_str, $supplier_csn_str);
	my ($s_tm, $c_tm, $lag_tm, $lag_str, $hours, $minutes);

	$m_maxcsn = get_supplier_maxcsn($ridx,$s, $cn, $h, $p);
	if($m_maxcsn ne ""){
		$s_maxcsn = $m_maxcsn;
	}
	$supplier_csn_str = &to_string_csn ($s_maxcsn);
	$csn_str = &to_string_csn ($c_maxcsn);
	
	if (!$s_maxcsn || $s_maxcsn eq "Unavailable" ||
	    !$c_maxcsn || $c_maxcsn eq "Unavailable") {
		$lag_str = "?:??:??";
		$markcolor = "white"; # True status unknown
	}
	elsif ($s_maxcsn le $c_maxcsn) {
		$lag_str = "0:00:00";
		$markcolor = &get_color (0);
	}
	else {
		my ($rawcsn, $decimalcsn) = split (/:/, $s_maxcsn);
		($s_tm) = split(/ /, $decimalcsn);

		($rawcsn, $decimalcsn) = split (/:/, $c_maxcsn);
		($c_tm) = split(/ /, $decimalcsn);
		if ($s_tm > $c_tm) {
			$lag_tm = $s_tm - $c_tm;
			$lag_str = "- ";
			$markcolor = &get_color ($lag_tm);
		}
		else {
			$lag_tm = $c_tm - $s_tm;
			$lag_str = "+ ";
			$markcolor = $allcolors{ $colorkeys[0] };	# no delay
		}
		$hours = int ($lag_tm / 3600);
		$lag_str .= "$hours:";

		$lag_tm = $lag_tm % 3600;
		$minutes = int ($lag_tm / 60);
		$minutes = "0".$minutes if ($minutes < 10);
		$lag_str .= "$minutes:";

		$lag_tm = $lag_tm % 60;
		$lag_tm = "0".$lag_tm if ($lag_tm < 10);
		$lag_str .= "$lag_tm";
	}
	return ($csn_str, $lag_str, $markcolor, $supplier_csn_str);
}

sub set_server_params
{
    my ($host, $port, $binddn, $bindpwd, $bindcert);
    
    ($host, $port, $binddn, $bindpwd, $bindcert) = split (/:/, $allconnections[0]);
    if($opt_p && $opt_p ne ""){
        $ld{port} = $opt_p
    } elsif(!$port || $port eq ""){
        $ld{port} = "389";
    } else {
        $ld{port} = $port;
    }
    if($host && $host ne ""){
        $ld{host} = $host;
    }
    if($binddn){
        $ld{bind} = $binddn;
    }
    if($bindpwd){
        $ld{pswd} = $bindpwd;
    }
    if($bindcert){
        $ld{cert} = $bindcert;
    }
}

#
# The subroutine would append a new entry to the end of
# @servers if the host and port are new to @servers.
#
sub add_server
{
	my ($host, $port, $binddn, $bindpwd, $bindcert) = split (/:/, "$_[0]");
	my ($shadowport) = $port;
	my ($domainpattern) = '\.[^:]+';
	my ($i);

	for ($i = 0; $i <= $#servers; $i++) {
		return $i if ($servers[$i] =~ /$host:\d*=$shadowport\D/i);
		return $i if ($servers[$i] =~ /$host:$port\D/i);
	}

	# Remove the domain name from the host name
	my ($hostnode) = $host;
	$hostnode = $1 if $host =~ /^(.+?)\./;
	if ($hostnode eq "*") {
		# handle wild card correctly for regex
		$hostnode = "";
	}

	# new host:port
	if (!$binddn   || $binddn eq ""   || $binddn eq "*"   ||
	    !$bindpwd  || $bindpwd eq ""  || $bindpwd eq "*"  ||
	    !$bindcert || $bindcert eq "" || $bindcert eq "*" )
	{
		#
		# Look up connection parameter in the order of
		#	host:port
		#	host:*
		#	*:port
		#	*:*
		#
		my (@myconfig, $h, $p, $d, $w, $c);
		$h = ""; $p = ""; $d = ""; $w = ""; $c = "";
		(@myconfig = grep (/^$hostnode($domainpattern)*:[0-9]+\D/i, @allconnections)) ||
		(@myconfig = grep (/^$hostnode($domainpattern)*:\*:/i, @allconnections)) ||
		(@myconfig = grep (/^\*:$port\D/, @allconnections)) ||
		(@myconfig = grep (/^\*:\*\D/, @allconnections));
		if ($#myconfig >= 0) {
			($h, $p, $d, $w, $c) = split (/:/, $myconfig[0]);
			($p, $shadowport) = split (/=/, $p);
			if(!$p || $p eq "*"){
				$p = "";
			}
			if(!$c || $c eq "*"){
				$c = "";
			}
			if(!$w || $w eq "*"){
				$w = "";
			}
		}
		if (!$binddn || $binddn eq "" || $binddn eq "*") {
			if ($d eq "" || $d eq "*") {
				$binddn = "cn=Directory Manager";
			} else {
				$binddn = $d;
			}
		}
		if($prompt eq "yes" && ($w eq "" || (!$bindpwd || $bindpwd eq "" || $bindpwd eq "*"))){
			$bindpwd = passwdPrompt($h, $p);
		} elsif ($passwd ne ""){
			$bindpwd = $passwd;
		} else {
			$bindpwd = $w if (!$bindpwd || $bindpwd eq "" || $bindpwd eq "*");
		}
		$bindcert = $c if (!$bindcert || $bindcert eq "" || $bindcert eq "*");
	}

	if ($shadowport) {
		push (@servers, "$host:$port=$shadowport:$binddn:$bindpwd:$bindcert");
	} else {
		push (@servers, "$host:$port:$binddn:$bindpwd:$bindcert");
	}
	return $i;
}

sub
passwdPrompt
{
	my ($h, $p) = @_;
	my $key = "$h:$p";
	my $pw = "";
    
	if ($passwords{$key}){
		# we already have a password for this replica     
		return $passwords{$key};
	}
	# Disable console echo
	system("/bin/stty -echo") if -t STDIN;

	while ($pw eq ""){
		if($passwd ne ""){
			print "Enter password for ($h:$p) <hit Enter to use previous password>: ";
			chomp($pw = <>);
			if ($pw eq ""){
				$pw = $passwd;
			} else {
				$passwords{$key} = $pw;
				$passwd = $pw;         
			}
		} else {
			print "Enter password for ($h:$p): ";
			chomp($pw = <>);
			$passwords{$key} = $pw;
			$passwd = $pw;
		}
	}
	# Enable console echo
	system("/bin/stty echo") if -t STDIN;

	return $pw;
}

sub get_ldap_url
{
	my ($sidx, $conntype) = @_;
	my ($host, $port) = split(/:/, $servers[$sidx]);
	my ($shadowport);
	($port, $shadowport) = split (/=/, $port);
	my ($protocol, $ldapurl);

	if ($port == 636 && $conntype eq "0" || $conntype =~ /SSL/i) {
		$protocol = "ldaps";
	}
	else {
		$protocol = "ldap";
	}
	my ($instance) = $allaliases { "$host:$port" };
	$instance = "$host:$port" if !$instance;
	if ($conntype eq "n/a") {
		$ldapurl = $instance;
	} else {
		if($opt_s){
			$ldapurl = "$instance $protocol://$host:$port/";
		} else {
			$ldapurl = "<a href=\"$protocol://$host:$port/\">$instance</a>";
		}
	}
	return $ldapurl;
}

sub to_decimal_csn
{
	my ($maxcsn) = @_;
	if (!$maxcsn || $maxcsn eq "" || $maxcsn eq "Unavailable") {
		return "Unavailable";
	}

	my ($tm, $seq, $masterid, $subseq) = unpack("a8 a4 a4 a4", $maxcsn);

	$tm = hex($tm);
	$seq = hex($seq);
	$masterid = hex($masterid);
	$subseq = hex($subseq);

	return "$tm $seq $masterid $subseq";
}

sub to_string_csn
{
	my $str = shift;
	if (!defined($str)){
		return "Unavailable";
	}
	my ($rawcsn, $decimalcsn) = split(/:/, "$str");
	if (!$rawcsn || $rawcsn eq "") {
		return "Unavailable";
	}
	if ($rawcsn eq "Unavailable"){
	    return $rawcsn;
	}
	my ($tm, $seq, $masterid, $subseq) = split(/ /, $decimalcsn);
	my ($sec, $min, $hour, $mday, $mon, $year) = localtime($tm);
	$mon++;
	$year += 1900;
	foreach ($sec, $min, $hour, $mday, $mon) {
		$_ = "0".$_ if ($_ < 10);
	}
	my ($csnstr) = "$mon/$mday/$year $hour:$min:$sec";
	$csnstr .= " $seq $subseq" if ( $seq != 0 || $subseq != 0 );
	
	return "$rawcsn ($csnstr)";
}

sub get_color
{
	my ($lag_minute) = @_;
	$lag_minute /= 60;
	my ($color) = $allcolors { $colorkeys[0] };
	
	foreach ( sort { $a <=> $b } keys %allcolors) {
		if ($lag_minute >= $_){
		    $color = $allcolors {$_};
		}
	}
	return $color;
}

# subroutine to remove escaped encoding

sub unescape 
{
	#my ($_) = @_;
	tr/+/ /;
	s/%(..)/pack("c",hex($1))/ge;
	$_;
}

sub print_html_header
{
    if(!$opt_s){
    	# print the HTML header
    
    	print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2//EN\"><html>\n";
    	print "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=UTF-8\">\n";
    	print "<head><title>Replication Status</title>\n";
    	# print "<link type=text/css rel=stylesheet href=\"master-style.css\">\n";
    	print "<style text/css>\n";
    	print "Body, p, table, td, ul, li {color: #000000; font-family: Arial, Helvetica, sans-serif; font-size: 12px;}\n";
    	print "A {color:blue; text-decoration: none;}\n";
    	print "BODY {font-family: arial, helvetica, sans-serif}\n";
    	print "P {font-family: arial, helvetica, sans-serif}\n";
    	print "TH {font-weight: bold; font-family: arial, helvetica, sans-serif}\n";
    	print "TD {font-family: arial, helvetica, sans-serif}\n";
    	print ".bgColor1  {background-color: #003366;}\n";
    	print ".bgColor4  {background-color: #cccccc;}\n";
    	print ".bgColor5  {background-color: #999999;}\n";
    	print ".bgColor9  {background-color: #336699;}\n";
    	print ".bgColor13 {background-color: #ffffff;}\n";
    	print ".bgColor16 {background-color: #6699cc;}\n";
    	print ".text8  {color: #0099cc; font-size: 11px; font-weight: bold;}\n";
    	print ".text28 {color: #ffcc33; font-size: 12px; font-weight: bold;}\n";
    	print ".areatitle {font-weight: bold; color: #ffffff; font-family: arial, helvetica, sans-serif}\n";
    	print ".page-title {font-weight: bold; font-size: larger; font-family: arial, helvetica, sans-serif}\n";
    	print ".page-subtitle {font-weight: bold; font-family: arial, helvetica, sans-serif}\n";
    	print "</style></head>\n<body class=bgColor4>\n";
    
    	if ($opt_u) {
    		print "<meta http-equiv=refresh content=$interval; URL=$opt_u>\n";
    	}
    
    	print "<table border=0 cellspacing=0 cellpadding=10 width=100% class=bgColor1>\n";
    	print "<tr><td><font class=text8>$now</font></td>\n";
    	print "<td align=center class=page-title><font color=#0099CC>";
    	print "Directory Server Replication Status</font>\n";
    
    	if ($opt_u) {
    		print "<br><font class=text8>(This page updates every $interval seconds)</font>\n";
    	}
    
    	print "</td><td align=right valign=center width=25%><font class=text8>$version";
    	print "</font></td></table>\n";
    } else {
        print "Directory Server Replication Status ($version)\n\n";
        print "Time: $now";
        if ($opt_u) {
            print " - This report updates every $interval seconds\n\n";
        } else {
            print "\n";
        }
    }
}

sub print_legend
{
	my ($nlegends) = $#colorkeys + 1;
	if($opt_s){ return; }
	print "\n<center><p><font class=page-subtitle color=#0099cc>Time Lag Legend:</font><p>\n";
	print "<table cellpadding=6 cols=$nlegends width=40%>\n<tr>\n";
	print "\n<td bgcolor=white><center>Unknown</center></td>\n";
	my ($i, $j);
	for ($i = 0; $i < $nlegends - 1; $i++) {
		$j = $colorkeys[$i];
		print "\n<td bgcolor=$allcolors{$j}><center>Within $colorkeys[$i+1] minutes</center></td>\n";
	}
	$j = $colorkeys[$i];
	print "\n<td bgcolor=$allcolors{$j}><center>Over $colorkeys[$i] minutes</center></td>\n";
	print "\n<td bgcolor=red><center>Server n/a</center></td>\n";
	print "</table></center>\n";
}

sub print_supplier_end
{
	if(!$opt_s){ print "</table>\n"; }
}

# given a string in generalized time format, convert to ascii time
sub format_z_time
{
  my $zstr = shift;
  return "n/a" if (! $zstr);
  my ($year, $mon, $day, $hour, $min, $sec) =
	($zstr =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/);
  my $time = timegm($sec, $min, $hour, $day, ($mon-1), $year);
  ($sec, $min, $hour, $day, $mon, $year) = localtime($time);
  $mon++;
  $year += 1900;
  foreach ($sec, $min, $hour, $day, $mon) {
	$_ = "0".$_ if ($_ < 10);
  }

  return "$mon/$day/$year $hour:$min:$sec";
}