#!/usr/bin/perl
#+##############################################################################
#                                                                              #
# File: glite-lb-msg-brokers                                                   #
#                                                                              #
# Description: manipulate messaging brokers information                        #
#                                                                              #
#-##############################################################################

#
# modules
#

use strict;
use warnings;
use Getopt::Long;
use Net::LDAP;
use Pod::Usage;

#
# constants
#

use constant LDAP_TIMEOUT  => 10;
use constant STOMP_TIMEOUT =>  5;

#
# global variables
#

our($Action, %Option);

#
# report a debugging message
#

sub debug ($$@) {
    my($level, $format, @arguments) = @_;
    my($message);

    return unless $Option{debug} >= $level;
    $message = sprintf($format, @arguments);
    $message =~ s/\s+$//;
    print(STDERR "# $message\n");
}

#
# report a warning message
#

sub warning ($@) {
    my($format, @arguments) = @_;
    my($message);

    return if $Option{quiet};
    $message = sprintf($format, @arguments);
    $message =~ s/\s+$//;
    print(STDERR "* $message\n");
}

#
# report a fatal error
#

sub fatal ($@) {
    my($format, @arguments) = @_;
    my($message);

    $message = sprintf($format, @arguments);
    $message =~ s/\s+$//;
    die("msg-brokers: $message\n");
}

#
# initialise everything
#

sub init () {
    # defaults
    $Option{bdii} = $ENV{LCG_GFAL_INFOSYS};
    $Option{debug} = 0;
    # options parsing
    GetOptions(
        "bdii=s"    => \$Option{bdii},
        "cache=s"   => \$Option{cache},
        "debug|d+"  => \$Option{debug},
        "help|h|?"  => \$Option{help},
        "manual|m"  => \$Option{manual},
        "network=s" => \$Option{network},
        "quiet|q"   => \$Option{quiet},
        "sort|s"    => \$Option{sort},
    ) or pod2usage(2);
    pod2usage(1) if $Option{help};
    pod2usage(exitstatus => 0, verbose => 2) if $Option{manual};
    # action parsing
    pod2usage(2) unless @ARGV;
    if ($ARGV[0] =~ /^(find|list)$/) {
	$Action = shift(@ARGV);
	pod2usage(2) if @ARGV;
    } else {
	warn("Unknown action: $ARGV[0]\n");
	pod2usage(2);
    }
}

#
# connect to the BDII and return the corresponding Net::LDAP object
#

sub connect_bdii () {
    my($bdii, @list, $ldap, $mesg);

    $bdii = $Option{bdii};
    fatal("unspecified BDII (use --bdii or set \$LCG_GFAL_INFOSYS)")
	unless $bdii;
    if ($bdii =~ /[\,\;]/) {
	# list of BDIIs
	@list = split(/[\,\;]+/, $bdii);
	debug(1, "using BDII list %s", "@list");
    } else {
	# single BDII
	@list = ($bdii);
	debug(1, "using single BDII %s", $bdii);
    }
    foreach $bdii (@list) {
	$ldap = Net::LDAP->new($bdii,
            port    => 2170,
            timeout => LDAP_TIMEOUT,
            async   => 1,
        );
	last if $ldap;
	if (@list == 1) {
	    fatal("could not connect to BDII %s: %s", $bdii, $@);
	} else {
	    warning("could not connect to BDII %s: %s", $bdii, $@);
	}
    }
    fatal("could not connect to any BDII") unless $ldap;
    debug(1, "connected to BDII %s", $ldap->{net_ldap_uri});
    $mesg = $ldap->bind(anonymous => 1);
    fatal("could not bind to BDII %s: %s", $ldap->{net_ldap_uri}, $mesg->error())
	if $mesg->code();
    return($ldap);
}

#
# search the BDII and return the corresponding results
#

sub search_bdii ($%) {
    my($ldap, %option) = @_;
    my($mesg);

    $option{base} = "o=grid";
    $option{timelimit} = LDAP_TIMEOUT;
    $mesg = $ldap->search(%option);
    fatal("could not search BDII %s: %s", $ldap->{net_ldap_uri}, $mesg->error())
	if $mesg->code();
    return($mesg->entries());
}

#
# query the BDII and return the list of matching messaging broker URIs
#

sub list_brokers ($) {
    my($ldap, %search, $endpoint, $match, $network, $value, @uris);
    my($proto,%uris);
    my($check) = @_;

    $ldap = connect_bdii();
    %search = (
        filter => "(&(objectClass=GlueService)(GlueServiceType=msg.broker.*)",
        attrs  => [ qw(GlueServiceEndpoint GlueServiceUniqueID) ],
    );
    $search{filter} .= "(GlueServiceStatus=OK)" if ($check);
    $search{filter} .= ")";
    foreach $endpoint (search_bdii($ldap, %search)) {
	$value = $endpoint->get_value("GlueServiceUniqueID");
	debug(2, " found endpoint %s", $value);
	%search = (
            filter => "(&(GlueServiceDataKey=cluster)(GlueChunkKey=GlueServiceUniqueID=$value))",
            attrs  => [ qw(GlueServiceDataValue) ],
	);
	$match = 0;
	foreach $network (search_bdii($ldap, %search)) {
	    $value = $network->get_value("GlueServiceDataValue");
	    debug(2, "  found network %s", $value);
	    next if defined($Option{network}) and $Option{network} ne $value;
	    $match++;
	}
	$value = $endpoint->get_value("GlueServiceEndpoint");
	if ($match) {
            $proto = '';
            if ($value =~ /^([^:]*):\/\/.*/) { $proto = $1; }
            push(@{$uris{$proto}}, $value);
	    debug(2, "  keep URI %s", $value);
	} else {
	    debug(2, "  skip URI %s", $value);
	}
    }

    foreach $proto ('stomp+ssl', 'openwire+ssl', 'stomp', 'openwire') {
	if (exists $uris{$proto}) {
            push(@uris,@{$uris{$proto}});
            delete $uris{$proto};
        }
    }
    foreach $proto (keys %uris) {
            push(@uris,@{$uris{$proto}});
    }
    
    debug(1, "got %d broker URIs from BDII", scalar(@uris));
    warning("got an empty brokers list from BDII") unless @uris;
    return(@uris);
}

#
# report the final list of messaging broker URIs
#

sub report_brokers (@) {
    my(@list) = @_;
    my($uri, $fh);

    unless (defined($Option{cache})) {
	# report only to STDOUT
	foreach $uri (@list) {
	    print("$uri\n");
	}
	return;
    }
    unless (@list) {
	# no brokers so no cache update
	warning("no brokers found so cache file not updated");
	return;
    }
    # update the cache file
    open($fh, ">", $Option{cache})
	or fatal("cannot open %s: %s", $Option{cache}, $!);
    foreach $uri (@list) {
	print($fh "$uri\n");
    }
    close($fh)
	or fatal("cannot close %s: %s", $Option{cache}, $!);
    debug(1, "cache %s updated with %d brokers", $Option{cache}, scalar(@list));
}

#
# main part
#

sub main () {
    my(@list);

    if ($Action eq "list") {
	@list = list_brokers(0);
    } elsif ($Action eq "find") {
	@list = list_brokers(1);
    } else {
	fatal("unexpected action: %s", $Action);
    }
    report_brokers(@list);
}

#
# just do it
#

init();
main();

__END__

=head1 NAME

glite-lb-msg-brokers - manipulate messaging brokers information

=head1 SYNOPSIS

B<glite-lb-msg-brokers> [I<OPTIONS>] B<find>|B<list>

=head1 DESCRIPTION

B<glite-lb-msg-brokers> has two different modes of operation. In all cases, it manipulates information about messaging brokers and reports a (possibly empty) list of broker URIs, one per line.

=over

=item B<list>

list all the URIs declared in the BDII, optionally filtered by network

=item B<find>

the B<list> functionality described above plus filter by GlueServiceStatus

=back

A fatal error (e.g. cannot contact the BDII) will halt the program.
A warning (e.g. a given URI cannot be contacted) will be reported
unless B<--quiet> is used. Both will be sent to STDERR.

The exit status will be 0 on success (with or without warnings) or
different from 0 in case of a fatal error.

=head1 OPTIONS

=over

=item B<--bdii> I<string>

specify the I<name> or I<name>:I<port> of the BDII to contact;
this can also be a list, separated by commas or semicolons;
if not set, it defaults to $LCG_GFAL_INFOSYS

=item B<--cache> I<path>

specify the path of a file to update with the list of URIs;
if this is set, nothing will be printed on STDOUT;
note: if the list is empty, the file will I<not> be updated

=item B<--debug>, B<-d>

report debugging information;
can be used multiple times for increased verbosity

=item B<--help>, B<-h>, B<-?>

show some help

=item B<--manual>, B<-m>

show the complete man page

=item B<--network> I<string>

consider only the brokers for this network (for example PROD or TEST-NWOB)

=item B<--quiet>, B<-q>

suppress the printing of warnings

=item B<--sort>, B<-s>

sort the brokers per elapsed time to perform the test

=back

=head1 ENVIRONMENT

=over

=item B<LCG_GFAL_INFOSYS>

I<host>[:I<port>] of the BDII to contact

=back

=head1 BUGS

Please report all bugs to CESNET gLite L&B issue tracker available at
I<https://github.com/CESNET/glite-lb/issues>

=head1 AUTHORS

Lionel Cons L<http://cern.ch/lionel.cons>

L&B Product Team, CESNET L<http://cesnet.cz>

=head1 SEE ALSO

L<Net::STOMP::Client>
