XCMSI/modules/site_utils.pm

#!/usr/bin/perl
package site_utils;

use strict;
use Cwd;
use English;
use IPC::Open3;
use Net::LDAP;

our (@ISA, @EXPORT, @EXPORT_OK);
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(&create_list &validate_list &checkStatus &execSys %CeSe_table);

my @CEattr;
my $tagOK;

###################################################
#
# This subroutine contacts the BDII ldap server retrieving all CEs belongig to a given VO 
# (by default CMS). It then selects the software tags and marks the CE for upgrade or install
#
###################################################
sub create_list {
    my ($bdii, $regex, @tag) = @_;           # function arguments (bdii, site and sw tag)
    our %CeSe_table;                         # Hash table with CE/SE pair (mostly used with lcg tools)
    my $key;                                 # CE entry without batch system queue. Used to keep only one CE selected
    my %IsIn;                                # Hash to keep informations of CE already signed for job submission
    print "Creating CE list...\n\n";
    # CE list creation
    my @list = &ldapq($bdii, "2170", "GlueCE", "GlueCEAccessControlBaseRule");
    foreach my $entry (@list) {
        if ( $entry =~ /$regex/ ) {          # Select only sites matching the argument
            ($key, my $junk) = split(/:/, $entry);
            # SE list related to the CE
            my @selist = &ldapq($key, "2135", "GlueCESEBindGroup", "GlueCESEBindGroupSEUniqueID");
            my @taglist;
            my $value;
            # Retrieves sw tag
            @CEattr = &ldapq($key, "2135", "GlueSubCluster", "GlueHostApplicationSoftwareRunTimeEnvironment");
            foreach my $val (@tag) {
              foreach $value (@CEattr) {
                if ($value =~ $val) {        # If CERuntimeEnv matches the given tag, then skip this CE
                    $tagOK = 1;
                    last;
                }
                elsif ($value =~ /ORCA/ ) {
                    $tagOK = 0;
                }
              }
              push(@selist, $tagOK);
            }
            # Create an hash with only one CE chosen among different batch queues (long, short, infinite)
            if ( keys %IsIn ) {
                unless ($IsIn{$key} == 1 ) {
                    $CeSe_table{$entry}=[ @selist ];
                    $IsIn{$key} = 1;
                }
            }
            else {
                $CeSe_table{$entry}=[ @selist ];
                $IsIn{$key} = 1;
            }
        }
    }
}

sub validate_list {
    my ($bdii, $regex, $tag) = @_;           # function arguments (bdii, site and sw tag)
    our %CeSe_table;                         # Hash table with CE/SE pair (mostly used with lcg tools)
    my $key;                                 # CE entry without batch system queue. Used to keep only one CE selected
    my %IsIn;                                # Hash to keep informations of CE already signed for job submission
    print "Creating CE list...\n\n";
    # CE list creation
    my @list = &ldapq($bdii, "2170", "GlueCE", "GlueCEAccessControlBaseRule");
    foreach my $entry (@list) {
        if ( $entry =~ /$regex/ ) {          # Select only sites matching the argument
            ($key, my $junk) = split(/:/, $entry);
            # SE list related to the CE
            my @selist = &ldapq($key, "2135", "GlueCESEBindGroup", "GlueCESEBindGroupSEUniqueID");
            my @taglist;
            # Retrieves sw tag
            @CEattr = &ldapq($key, "2135", "GlueSubCluster", "GlueHostApplicationSoftwareRunTimeEnvironment");
            foreach my $value (@CEattr) {
                if ($value =~ $tag && $IsIn{$key} != 1) { # If CERuntimeEnv matches the given tag, then skip this CE
                    $CeSe_table{$entry} = [ @selist ];
                    $IsIn{$key} = 1;
                }
            }
        }
    }
}
###################################################
#
# Ldap subroutine to check CMS tags on CE lists. Just to be sure not to install sw again
# Returns an array with different informations about CEs (close SE, tag, VOs...)
#
##################################################
sub ldapq {
    my ($lsvr, $port, $objcls, $query) = @_;
    my @allCEattr;
    my $ldap = Net::LDAP->new($lsvr, port => $port) or die "error connecting to $lsvr: $@";

    $ldap->bind;   # Bind anonymously, that is, no login and pass

    my $results = $ldap->search (  # Perform a search on given base and filter bases 
    base => "mds-vo-name=local, o=grid",
    filter => "(objectClass=$objcls)"
     );

    if ($results->code) {
        die "received LDAP error: @{[$results->error]}";
    }

    foreach my $entry ($results->all_entries) {
         @CEattr = $entry->get($query);
         # Selects only those CE belonging to a given VO (by default CMS)
         if ($query =~ /GlueCEAccessControlBaseRule/) {
             foreach my $val (@CEattr) {
                 if ($val =~ /cms/) {
                     my @list = $entry->get('GlueCEUniqueID');
                     push(@allCEattr, @list);
                 }
             }
         }
         else {
             push(@allCEattr, @CEattr);
         }
    }
    $ldap->unbind;   # Unbind and close connection
    return @allCEattr;
}

# Subroutine to execute OS command in a more friendly way. Returns error codes.
sub execSys {
    my $cmd = shift;
    open(LOG, ">>$::logDir/cmd.log");
    local(*HIS_IN, *HIS_OUT, *HIS_ERR);
    my $childpid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $cmd);
    my @outlines = <HIS_OUT>;    # Read till EOF.
    my @errlines = <HIS_ERR>;    # XXX: block potential if massive
#    print "STDOUT:\n", @outlines, "\n";
#    print "STDERR:\n", @errlines, "\n";
    close HIS_OUT;
    close HIS_ERR;
    waitpid($childpid, 0);
    if ($?) {
        print(LOG "That child exited with wait status of $?\n");
    }
    my $rc = 0xffff & $?;
#    printf "system(%s) returned %#04x: \n", "$cmd", $rc;
    if ($rc == 0) {
        print(LOG "$cmd ran with normal exit\n");
        } 
    elsif ($rc == 0xff00) {
        print(LOG "command $cmd failed: $!\n");
    } 
    elsif (($rc & 0xff) == 0) {
        $rc >>= 8;
        print(LOG "$cmd ran with non-zero exit status $rc\n");
    } 
    else {
        print(LOG "ran with ");
        if ($rc &   0x80) {
        $rc &= ~0x80;
        print(LOG "coredump from ");
        } 
        print(LOG "signal $rc\n");
    } 
    my $ok = ($rc == 0);
    return @outlines, $ok;
}
1;
Revision:	1.3
Committed:	Thu Nov 25 16:29:41 2004 UTC (20 years, 5 months ago) by corvo
Content type:	text/plain
Branch:	MAIN
Changes since 1.2:	+106 -73 lines
Log Message:	New version of utilities to monitor jobs and retrieve tags from BDII
#	User	Rev	Content
1	krabbert	1.1	#!/usr/bin/perl
2			package site_utils;
3
4			use strict;
5			use Cwd;
6			use English;
7			use IPC::Open3;
8			use Net::LDAP;
9
10			our (@ISA, @EXPORT, @EXPORT_OK);
11			use Exporter;
12			@ISA = qw(Exporter);
13	corvo	1.3	@EXPORT_OK = qw(&create_list &validate_list &checkStatus &execSys %CeSe_table);
14	krabbert	1.1
15	corvo	1.3	my @CEattr;
16			my $tagOK;
17
18			###################################################
19			#
20			# This subroutine contacts the BDII ldap server retrieving all CEs belongig to a given VO
21			# (by default CMS). It then selects the software tags and marks the CE for upgrade or install
22			#
23			###################################################
24	krabbert	1.1	sub create_list {
25	corvo	1.3	my ($bdii, $regex, @tag) = @_; # function arguments (bdii, site and sw tag)
26			our %CeSe_table; # Hash table with CE/SE pair (mostly used with lcg tools)
27			my $key; # CE entry without batch system queue. Used to keep only one CE selected
28			my %IsIn; # Hash to keep informations of CE already signed for job submission
29	krabbert	1.1	print "Creating CE list...\n\n";
30	corvo	1.3	# CE list creation
31			my @list = &ldapq($bdii, "2170", "GlueCE", "GlueCEAccessControlBaseRule");
32			foreach my $entry (@list) {
33			if ( $entry =~ /$regex/ ) { # Select only sites matching the argument
34			($key, my $junk) = split(/:/, $entry);
35			# SE list related to the CE
36			my @selist = &ldapq($key, "2135", "GlueCESEBindGroup", "GlueCESEBindGroupSEUniqueID");
37			my @taglist;
38			my $value;
39			# Retrieves sw tag
40			@CEattr = &ldapq($key, "2135", "GlueSubCluster", "GlueHostApplicationSoftwareRunTimeEnvironment");
41			foreach my $val (@tag) {
42			foreach $value (@CEattr) {
43			if ($value =~ $val) { # If CERuntimeEnv matches the given tag, then skip this CE
44			$tagOK = 1;
45			last;
46			}
47			elsif ($value =~ /ORCA/ ) {
48			$tagOK = 0;
49			}
50			}
51			push(@selist, $tagOK);
52			}
53			# Create an hash with only one CE chosen among different batch queues (long, short, infinite)
54			if ( keys %IsIn ) {
55			unless ($IsIn{$key} == 1 ) {
56			$CeSe_table{$entry}=[ @selist ];
57			$IsIn{$key} = 1;
58			}
59			}
60			else {
61			$CeSe_table{$entry}=[ @selist ];
62			$IsIn{$key} = 1;
63			}
64			}
65	krabbert	1.1	}
66	corvo	1.3	}
67
68			sub validate_list {
69			my ($bdii, $regex, $tag) = @_; # function arguments (bdii, site and sw tag)
70			our %CeSe_table; # Hash table with CE/SE pair (mostly used with lcg tools)
71			my $key; # CE entry without batch system queue. Used to keep only one CE selected
72			my %IsIn; # Hash to keep informations of CE already signed for job submission
73			print "Creating CE list...\n\n";
74			# CE list creation
75			my @list = &ldapq($bdii, "2170", "GlueCE", "GlueCEAccessControlBaseRule");
76			foreach my $entry (@list) {
77			if ( $entry =~ /$regex/ ) { # Select only sites matching the argument
78			($key, my $junk) = split(/:/, $entry);
79			# SE list related to the CE
80			my @selist = &ldapq($key, "2135", "GlueCESEBindGroup", "GlueCESEBindGroupSEUniqueID");
81			my @taglist;
82			# Retrieves sw tag
83			@CEattr = &ldapq($key, "2135", "GlueSubCluster", "GlueHostApplicationSoftwareRunTimeEnvironment");
84			foreach my $value (@CEattr) {
85			if ($value =~ $tag && $IsIn{$key} != 1) { # If CERuntimeEnv matches the given tag, then skip this CE
86			$CeSe_table{$entry} = [ @selist ];
87			$IsIn{$key} = 1;
88			}
89	krabbert	1.1	}
90			}
91			}
92			}
93	corvo	1.3	###################################################
94			#
95	krabbert	1.1	# Ldap subroutine to check CMS tags on CE lists. Just to be sure not to install sw again
96	corvo	1.3	# Returns an array with different informations about CEs (close SE, tag, VOs...)
97			#
98			##################################################
99	krabbert	1.1	sub ldapq {
100	corvo	1.3	my ($lsvr, $port, $objcls, $query) = @_;
101			my @allCEattr;
102	krabbert	1.1	my $ldap = Net::LDAP->new($lsvr, port => $port) or die "error connecting to $lsvr: $@";
103
104			$ldap->bind; # Bind anonymously, that is, no login and pass
105
106	corvo	1.3	my $results = $ldap->search ( # Perform a search on given base and filter bases
107	krabbert	1.1	base => "mds-vo-name=local, o=grid",
108	corvo	1.3	filter => "(objectClass=$objcls)"
109	krabbert	1.1	);
110
111			if ($results->code) {
112			die "received LDAP error: @{[$results->error]}";
113			}
114
115	corvo	1.3	foreach my $entry ($results->all_entries) {
116			@CEattr = $entry->get($query);
117			# Selects only those CE belonging to a given VO (by default CMS)
118			if ($query =~ /GlueCEAccessControlBaseRule/) {
119			foreach my $val (@CEattr) {
120			if ($val =~ /cms/) {
121			my @list = $entry->get('GlueCEUniqueID');
122			push(@allCEattr, @list);
123			}
124			}
125			}
126			else {
127			push(@allCEattr, @CEattr);
128			}
129	krabbert	1.1	}
130			$ldap->unbind; # Unbind and close connection
131	corvo	1.3	return @allCEattr;
132	krabbert	1.1	}
133
134			# Subroutine to execute OS command in a more friendly way. Returns error codes.
135			sub execSys {
136			my $cmd = shift;
137	corvo	1.3	open(LOG, ">>$::logDir/cmd.log");
138	krabbert	1.1	local(HIS_IN, HIS_OUT, *HIS_ERR);
139			my $childpid = open3(HIS_IN, HIS_OUT, *HIS_ERR, $cmd);
140			my @outlines = <HIS_OUT>; # Read till EOF.
141			my @errlines = <HIS_ERR>; # XXX: block potential if massive
142			# print "STDOUT:\n", @outlines, "\n";
143			# print "STDERR:\n", @errlines, "\n";
144			close HIS_OUT;
145			close HIS_ERR;
146			waitpid($childpid, 0);
147			if ($?) {
148	corvo	1.3	print(LOG "That child exited with wait status of $?\n");
149	krabbert	1.1	}
150			my $rc = 0xffff & $?;
151	corvo	1.3	# printf "system(%s) returned %#04x: \n", "$cmd", $rc;
152	krabbert	1.1	if ($rc == 0) {
153	corvo	1.3	print(LOG "$cmd ran with normal exit\n");
154	krabbert	1.1	}
155			elsif ($rc == 0xff00) {
156	corvo	1.3	print(LOG "command $cmd failed: $!\n");
157	krabbert	1.1	}
158			elsif (($rc & 0xff) == 0) {
159			$rc >>= 8;
160	corvo	1.3	print(LOG "$cmd ran with non-zero exit status $rc\n");
161	krabbert	1.1	}
162			else {
163	corvo	1.3	print(LOG "ran with ");
164	krabbert	1.1	if ($rc & 0x80) {
165			$rc &= ~0x80;
166	corvo	1.3	print(LOG "coredump from ");
167	krabbert	1.1	}
168	corvo	1.3	print(LOG "signal $rc\n");
169	krabbert	1.1	}
170			my $ok = ($rc == 0);
171			return @outlines, $ok;
172			}
173	corvo	1.3	1;