##**************************************************************
##
## Copyright (C) 1990-2007, Condor Team, Computer Sciences Department,
## University of Wisconsin-Madison, WI.
## 
## Licensed under the Apache License, Version 2.0 (the "License"); you
## may not use this file except in compliance with the License.  You may
## obtain a copy of the License at
## 
##    http://www.apache.org/licenses/LICENSE-2.0
## 
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
##
##**************************************************************

use strict;
use warnings;
require 5.0;
require Exporter;

package CondorClusters;

my $RevisionString = '$Revision: 1.10 $';

# ******************************************************
# Return revision information string
# ******************************************************
sub GetRevisions( $ )
{
    my $Revisions = shift;
    if ( $RevisionString =~ /([\d\.]+)/ )
    {
	$Revisions->{"CondorClusters.pm"} = $1;
    }

   # Done
    return 1;
}
# ******************************************************

# ******************************************************
# Constructor
# ******************************************************
sub new( $ )
{
    my $class = shift;
    my $self = {};
    bless $self, $class;
    $self->_initialize( );

    return $self;
}

# ******************************************************
# Perform initializations..
# ******************************************************
sub _initialize( $ )
{
    my $self = shift;

    # Cluster list info
    $self->{Clusters} = { };		# Hash of clusters
    $self->{PoolDir} = "";
    $self->{ClusterFiles} = [];		# Array of cluster files to look for
    $self->{DefaultDomain} = "";	# The default domain name

    # These control debugging & diagnostics
    $self->{RunIt} = 1;
    $self->{Debug} = 1;
    $self->{Quiet} = 0;

    return 1;
}

# ******************************************************
# Configuration
# ******************************************************
sub Configure( $$ )
{
    my $self = shift;
    my $ConfigRef = shift;

    # Copy a lot of parameters
    $self->CopyParm( $ConfigRef, "PoolDir", "" );
    $self->CopyParm( $ConfigRef, "DefaultDomain", "" );
    $self->CopyParm( $ConfigRef, "ClusterFiles", [] );

    return 1;

} # Configure()
# ******************************************************

# ******************************************************
# Copy a parameter from the app's config or use default
# ******************************************************
sub CopyParm( $$$$ )
{
    my $self = shift;
    my $HashRef = shift;
    my $Name = shift;
    my $Default = shift;

    if ( exists $HashRef->{$Name} )
    {
	$self->{$Name} = $HashRef->{$Name};
    }
    else
    {
	$self->{$Name} = $Default;
    }

    return 1;
}
# ******************************************************

# ******************************************************
# Finalize setup
# ******************************************************
sub Setup( $ )
{
    my $self = shift;

    # Set the cluster directory
    if ( $self->{PoolDir} eq "" )
    {
	$self->{PoolDir} = "/unsup/condor/etc";
	if ( defined( $ENV{CONDOR_POOL_DIR} ) )
	{
	    $self->{PoolDir} = $ENV{CONDOR_POOL_DIR};
	}
    }

    # Cluster file
    if ( $#{$self->{ClusterFiles}} < 0 )
    {
	if ( defined( $ENV{CONDOR_CLUSTER_FILES} ) )
	{
	    foreach my $Def ( split( /,/, $ENV{CONDOR_CLUSTER_FILES} ) )
	    {
		$self->AddClusterFile( $Def, 1 );
	    }
	}
	else
	{
	    $self->AddClusterFile( $self->{PoolDir} . "/clusters.txt", 1 );
	}
	if ( defined $ENV{HOME} )
	{
	    $self->AddClusterFile( "$ENV{HOME}/.condor/clusters.txt", 0 );
	}
    }

    # Default domain name
    if ( $self->{DefaultDomain} eq "" )
    {
	my $Tmp = `hostname`;
	chomp $Tmp;
	$Tmp =~ s/^[^\.]+\.//;
	$self->{DefaultDomain} = $Tmp;
    }

    return 1;
}
# ******************************************************

# ******************************************************
# File settings
# ******************************************************
sub SetDir( $$ )
{
    my $self = shift;

    $self->{PoolDir} = shift;
    warn "Pool directory '$self->{PoolDir}' does not exit"
	if ( ! -d $self->{PoolDir} );
}
# ******************************************************

# ******************************************************
# File settings
# ******************************************************
sub AddClusterFile( $$$ )
{
    my $self = shift;
    my $File = shift;
    my $Warn = shift;

    my $r = ();
    $r->{Warn} = $Warn;
    $r->{File} = $File;

    push( @{$self->{ClusterFiles}}, $r );
}
# ******************************************************

# ******************************************************
# Domain setting
# ******************************************************
sub SetDoman( $$ )
{
    my $self = shift;

    $self->{DefaultDomain} = shift;
}
# ******************************************************

# ******************************************************
# Set debug level
# ******************************************************
sub SetDebug( $$ )
{
    my $self = shift;
    $self->{Debug} = shift;
}
# ******************************************************

# ******************************************************
# Read all cluster definitions that we know about
# ******************************************************
sub BuildClusters( $ )
{
    my $self = shift;
    my $NumRead = 0;

    # Read the cluster files
    foreach my $File ( @{$self->{ClusterFiles}} )
    {
	if ( ! $self->ReadCluster( $File->{File} ) )
	{
	    print STDERR "Warning: Can't open cluster file '$File->{File}'\n"
		if ( $File->{Warn} );
	}
	else
	{
	    $NumRead++;
	}
    }

    # Quick sanity check
    if ( ! $NumRead )
    {
	warn "Warning: No cluster files read\n";
    }

    # Build the host list
    my $Clusters = $self->{Clusters};
    foreach my $Name ( keys %{$Clusters} )
    {
	my $Cluster = $Clusters->{$Name};

	# Do we have the required fields?
	next if ( ( ! exists $Cluster->{Format} ) ||
		  ( ! exists $Cluster->{First} ) ||
		  ( ! exists $Cluster->{Last} )  );
	next if ( ( $Cluster->{Format} eq "" ) ||
		  ( $Cluster->{First} < 0 ) ||
		  ( $Cluster->{Last} < 0 ) );

	# Build the list & disable them all...
	foreach my $Num ( $Cluster->{First} .. $Cluster->{Last} )
	{
	    my $Host = sprintf( $Cluster->{Format}, $Num );
	    my $r = ();
	    $r->{Flag} = 0;
	    $r->{Status} = 0;
	    $Cluster->{Hosts}{$Host} = $r;
	    $r = ();
	}
    }

    return 1;
}
# ******************************************************

# ******************************************************
# Read the cluster definitions
# ******************************************************
sub ReadCluster( $$ )
{
    my $self = shift;
    my $ClusterFile = shift;

    # Try to open the file
    if ( ! open( DEF, $ClusterFile ) )
    {
	return 0;
    }

    # Read it
    my $Cluster;
    while( <DEF> )
    {
	chomp;
	s/\#.*$//;
	s/^\s+//;
	next if ( ! length );

	# Find section headings
	if ( /^\[\s*(\w+)\s+(\w+)\s*\]/ )
	{
	    my $Attr = lc $1;
	    my $Value = $2;

	    if ( $Attr eq "cluster" )
	    {
		$Cluster->{Name} = $Value;
		$Cluster->{First} = -1;
		$Cluster->{Last} = -1;
		$Cluster->{Format} = "";
		$Cluster->{Hosts} = {};
		$Cluster->{Status} = 1;
		$Cluster->{Domain} = $self->{DefaultDomain};
	    }
	    elsif ( $Attr eq "endcluster" )
	    {
		if ( $Cluster->{Name} ne $Value )
		{
		    print STDERR "$ClusterFile $.: Cluster name mismatch:" .
			" '$Attr'\n";
		    print STDERR " '$Value' != '$Cluster->{Name}'\n";
		    $Cluster = ();
		    next;
		}
		$self->{Clusters}{$Cluster->{Name}} = $Cluster;
		$Cluster = ();
	    }
	    else
	    {
		print STDERR
		    "$ClusterFile $.: Unknown section heading '$Attr'\n";
		last;
	    }
	    next;
	}


	# Parsed out values
	my $Attr = "";
	my $Value = "";

	if ( /^([\w]+)\:?(?:\s*[=]\s*|\s+)(.*)/ )
	{
	    my $Attr = lc( $1 );
	    my $Remain = $2;
	    my $Value = "";

	    if ( $Remain =~ /^([\"])(.*)\1/ )
	    {
		$Value = $2;
	    }
	    else
	    {
		$Value = $Remain;
	    }

	    # Grok it out..
	    if ( ( $Attr eq "hosts" ) || ( $Attr eq "host" ) )
	    {
		$Value =~ s/\s+//g;
		foreach my $Host ( split( /[,]/, $Value ) )
		{
		    my $r = ();
		    $r->{Status} = 0;
		    $Cluster->{Hosts}{$Host} = $r;
		    $r = ();
		}
	    }
	    elsif ( $Attr eq "format" )
	    {
		$Cluster->{Format} = $Value;
	    }
	    elsif ( $Attr eq "domain" )
	    {
		$Cluster->{Domain} = $Value;
	    }
	    elsif ( $Attr eq "nodes" )
	    {
		$Value =~ s/\s+//g;
		my ( $First, $Last ) = split( /[\,\-]/, $Value );
		$Cluster->{First} = $First;
		$Cluster->{Last} = $Last;
	    }
	    elsif ( $Attr eq "status" )
	    {
		$Cluster->{Status} = ( $Value =~ /^(up)|(ok)$/ );
	    }
	    elsif ( $Attr eq "file" )
	    {
		my $File;
		if ( $Value =~ /\// )
		{
		    $File = "cluster-$Value.txt"
		}
		else
		{
		    $File = $self->{PoolDir} . "/" . "cluster-$Value.txt";
		}
		$self->AddClusterFile( $File, 1 );
	    }
	    else
	    {
		print STDERR "$ClusterFile $.: Unknown attribute '$Attr'\n";
	    }
	}
	else
	{
	    print STDERR "$ClusterFile $.: invalid syntax\n";
	}
    }
    close( DEF );

    return 1;
}
# ******************************************************

# ******************************************************
# Add a cluster
# ******************************************************
sub AddCluster( $$ )
{
    my $self = shift;
    my $ClusterName = shift;

    if ( ! exists ( $self->{Clusters}{$ClusterName} ) )
    {
	my $Cluster;
	$Cluster->{Name} = $ClusterName;
	$Cluster->{First} = -1;
	$Cluster->{Last} = -1;
	$Cluster->{Format} = "";
	$Cluster->{Hosts} = {};
	$Cluster->{Status} = 1;
	$Cluster->{Domain} = $self->{DefaultDomain};

	$self->{Clusters}{$ClusterName} = $Cluster;
	$Cluster = ();
    }
}

# ******************************************************
# Add a host to cluster
# ******************************************************
sub AddHost( $$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $Host = shift;

    $self->AddCluster( $ClusterName );
    my $Cluster = $self->{Clusters}{$ClusterName};
    if ( ! exists ( $Cluster->{Hosts}{$Host} ) )
    {
	my $r = {};
	$r->{Status} = 0;
	$Cluster->{Hosts}{$Host} = $r;
	$r = ();
    }
}
# ******************************************************

# ******************************************************
# Find a host in any cluster
# ******************************************************
sub FindHost( $$$ )
{
    my $self = shift;
    my $Host = shift;
    my $Domain = shift;
    my @Clusters;

    # If the host is an FQDN, extract info from it...
    if ( $Host =~ /^(\w+)\.(.+)$/ )
    {
	$Host = $1;
	$Domain = $2 if ( ( defined $Domain ) && ( $Domain eq "" ) );
    }

    # Walk through the list of clusters
    foreach my $ClusterName ( keys %{$self->{Clusters}} )
    {
	my $Cluster = $self->{Clusters}{$ClusterName};

	push( @Clusters, $ClusterName )
	    if ( exists $Cluster->{Hosts}{$Host} );
    }

    # Return the list
    @Clusters;
}
# ******************************************************

# ******************************************************
# Get the list of cluster names
# ******************************************************
sub GetClusters( $ )
{
    my $self = shift;
    return keys %{$self->{Clusters}};
}
# ******************************************************

# ******************************************************
# Check for a cluster by name
# ******************************************************
sub CheckCluster( $$ )
{
    my $self = shift;
    my $ClusterName = shift;

    return exists $self->{Clusters}{$ClusterName};
}
# ******************************************************

# ******************************************************
# Check for a host by name in cluster
# ******************************************************
sub CheckClusterHost( $$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $Host = shift;

    return 0 if (! exists $self->{Clusters}{$ClusterName} );
    return exists $self->{Clusters}{$ClusterName}{Hosts}{$Host};
}
# ******************************************************

# ******************************************************
# Get the cluster status
# ******************************************************
sub IsClusterUp( $$ )
{
    my $self = shift;
    my $ClusterName = shift;

    return 0 if ( ! exists $self->{Clusters}{$ClusterName} );

    return $self->{Clusters}{$ClusterName}{Status};
}
# ******************************************************

# ******************************************************
# Set cluster's "flag"
# ******************************************************
sub SetClusterFlag( $$$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $Flag = shift;
    my $Value = shift;

    return 0 if ( ! exists $self->{Clusters}{$ClusterName} );

    $self->{Clusters}{$ClusterName}{Flags}{$Flag} = $Value;
}
# ******************************************************

# ******************************************************
# Get cluster's "flag"
# ******************************************************
sub GetClusterFlag( $$$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $Flag = shift;
    my $ValueRef = shift;

    # Error check
    return 0 if ( ! exists  $self->{Clusters}{$ClusterName}{Flags}{$Flag} );

    $$ValueRef = $self->{Clusters}{$ClusterName}{Flags}{$Flag};
    return 1;
}
# ******************************************************

# ******************************************************
# Get the list of host names in a cluster
# ******************************************************
sub GetHosts( $$ )
{
    my $self = shift;
    my $ClusterName = shift;

    return 0 if ( ! exists $self->{Clusters}{$ClusterName} );

    return keys %{$self->{Clusters}{$ClusterName}{Hosts}};
}
# ******************************************************

# ******************************************************
# Get a list of matching hosts
# ******************************************************
sub GetMatchingHosts( $$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $List = shift;

    # Verify that the cluster exists
    return 0 if ( ! exists $self->{Clusters}{$ClusterName} );
    my $Cluster = $self->{Clusters}{$ClusterName};

    # '*': Return them all
    if ( $List eq "*" )
    {
	return ( keys %{$Cluster->{Hosts}} );
    }

    # List specified; parse it out
    my @HostNames;
    foreach my $Expr ( split( /,/, $List ) )
    {

	# Just a single host #
	if ( $Expr =~ /^(\d+)$/ )
	{
	    my $Num = $1;
	    if ( $Cluster->{Format} eq "" )
	    {
		print STDERR "Cannot build host '$Expr': no format\n";
		next;
	    }
	    my $Host = sprintf( $Cluster->{Format}, $Num );

	    if ( ! exists $Cluster->{Hosts}{$Host} )
	    {
		print STDERR "Cannot build host '$Host': no such host\n";
		next;
	    }
	    push( @HostNames, $Host );
	}

	# Range of host
	elsif ( $Expr =~ /^(\d+)-(\d+)$/ )
	{
	    if ( $Cluster->{Format} eq "" )
	    {
		print STDERR "Cannot build host '$Expr': no format\n";
		next;
	    }
	    my $First = $1;
	    my $Last = $2;

	    if ( ( $First < $Cluster->{First} ) ||
		 ( $Last > $Cluster->{Last} ) )
	    {
		print STDERR
		    "Invalid host range '$Expr': Out of range\n";
		next;
	    }

	    foreach my $Num ( $First .. $Last )
	    {
		my $Host = sprintf( $Cluster->{Format}, $Num );
		push( @HostNames, $Host );
	    }
	}

	# Host regex
	elsif ( $Expr =~ /^\/(.*)\/$/ )
	{
	    my $RegEx = $1;

	    foreach my $Host ( keys %{$Cluster->{Hosts}} )
	    {
		if ( $Host =~ /$RegEx/ )
		{
		    push( @HostNames, $Host );
		}
	    }
	}

	# Single host by name
	else
	{
	    my $Host = $Expr;

	    if ( ! exists $Cluster->{Hosts}{$Host} )
	    {
		print STDERR
		  "'$Host': no such host in cluster '$ClusterName'\n";
		next;
	    }
	    push( @HostNames, $Host );
	}
    }

    # Get list of matching hosts
    return @HostNames;
}
# ******************************************************

# ******************************************************
# Set the status of a list of hosts
# ******************************************************
sub SetHostlistStatus( $$$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $HostList = shift;
    my $Status = shift;

    return 0 if ( ! exists $self->{Clusters}{$ClusterName} );
    my $Cluster = $self->{Clusters}{$ClusterName};
    foreach my $Host ( @{$HostList} )
    {
	$Cluster->{Hosts}{$Host}{Status} = $Status;
    }
}
# ******************************************************

# ******************************************************
# Set the status of a single hsot
# ******************************************************
sub SetHostStatus( $$$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $Host = shift;
    my $Status = shift;

    return 0 if ( ! exists $self->{Clusters}{$ClusterName} );
    my $Cluster = $self->{Clusters}{$ClusterName};
    $Cluster->{Hosts}{$Host}{Status} = $Status;
}
# ******************************************************

# ******************************************************
# Set the 'flag' for a list of hosts
# ******************************************************
sub SetHostlistFlag( $$$$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $HostList = shift;
    my $Flag = shift;
    my $Value = shift;

    return 0 if ( ! exists $self->{Clusters}{$ClusterName} );
    my $Cluster = $self->{Clusters}{$ClusterName};
    foreach my $Host ( @{$HostList} )
    {
	$Cluster->{Hosts}{$Host}{Flags}{$Flag} = $Value;
    }
}
# ******************************************************

# ******************************************************
# Set the 'flag' for a single host
# ******************************************************
sub SetHostFlag( $$$$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $Host = shift;
    my $Flag = shift;
    my $Value = shift;

    return 0 if ( ! exists $self->{Clusters}{$ClusterName} );
    my $Cluster = $self->{Clusters}{$ClusterName};
    $Cluster->{Hosts}{$Host}{Flags}{$Flag} = $Value;
}
# ******************************************************

# ******************************************************
# Get the 'flag' for a single host
# ******************************************************
sub GetHostFlag( $$$$$ )
{
    my $self = shift;
    my $ClusterName = shift;
    my $Host = shift;
    my $Flag = shift;
    my $ValueRef = shift;

    # Error check: Does the cluster exist?
    return 0 if ( ! exists $self->{Clusters}{$ClusterName} );
    my $Cluster = $self->{Clusters}{$ClusterName};

    # Now, look at the flag..
    return 0 if ( ! exists $Cluster->{Hosts}{$Host}{Flags}{$Flag} );
    $$ValueRef = $Cluster->{Hosts}{$Host}{Flags}{$Flag};
    return 1;
}
# ******************************************************
