XCMSI/modules/site_utils.pm

#!/usr/bin/perl
# $Id: site_utils.pm,v 1.6 2004/12/17 10:27:39 krabbert Exp $
package site_utils;

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

our (@ISA, @EXPORT);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(&create_list &validate_list &checkStatus &execSys %CeSe_table &ldapq &getSiteAttr &setSiteAttr &selectCe &selectAttr);

###################################################
#
# 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 ($regex, @tag) = @_;                  # function arguments (bdii, site and sw tag)
    my %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
    # General purpose LDAP query. Returns a reference to an ldap hash.
    my $ldapRes = &ldapq($::bdii, "2170", "GlueCE");
    # Select the CE belonging to the given VO (default = cms).
    my @list = &selectCe($ldapRes, "GlueCEAccessControlBaseRule", $::org, $regex);
    foreach my $entry (@list) {
        my $tagOK;
        ($key, my $junk) = split(/:/, $entry);
#        setSiteAttr($key);
        # SE list related to the CE
        my $ldapRes = &ldapq($key, "2135", "GlueCESEBindGroup");
        my @selist = &selectAttr($ldapRes, "GlueCESEBindGroupSEUniqueID");
        # Retrieves sw tag
        $ldapRes = &ldapq($key, "2135", "GlueSubCluster");
        my @CEattr = &selectAttr($ldapRes, "GlueHostApplicationSoftwareRunTimeEnvironment");
        foreach my $val (@tag) {
          foreach my $value (@CEattr) {
            if ($value =~ $val) {        # If CERuntimeEnv matches the given tag, then skip this CE
                $tagOK = 1;
                last;
            }
            elsif ($value =~ /ORCA|OSCAR/ and $value !~ /.*ORCA.*dar|.*OSCAR.*dar/ ) {
                $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;
        }
    }
    return %CeSe_table;
}

###################################################
#
# Ldap subroutine to check CMS tags on CE lists. Just to be sure not to install sw again
# Returns a reference to an ldap hash.
#
##################################################
sub ldapq {
    my ($lsvr, $port, $objcls) = @_;
    my $ldap = Net::LDAP->new($lsvr, port => $port) or warn "error connecting to $lsvr: $@";
    if ($ldap) {

        $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)",
        attrs => ['*','modifyTimestamp']
         );

        if ($results->code) {
            die "received LDAP error: @{[$results->error]}";
        }
        $ldap->unbind;   # Unbind and close connection
        return $results;
    }
    else {print "No connection available to $lsvr\n";}
}

###################################################
#
# Subroutine to select the CEs based on the VO "signature", and 
# on url
#
###################################################
sub selectCe {
    my ($res, $query, $org, $regex) = @_;
    my @queryRes;
    my @attr;
    my @list;
    chomp($regex);
    my $notFound = 1;
    foreach my $entry ($res->all_entries) {
         @attr = $entry->get($query);
         @list = $entry->get('GlueCEUniqueID');
         # Selects only those CE belonging to a given VO (by default CMS)
         foreach my $val (@attr) {
             if ($list[0] =~ /$regex/ and $val =~ /$::org/) {
                 $notFound = 0;
                 my @tstp = $entry->get('modifyTimestamp');
                 push(@queryRes, @list);
             }
         }
    }
    if ($notFound == 1) {
       print "No matching sites found. Check site name or site availability.\n";
       exit;
    }
    return @queryRes;
}

sub selectAttr {
    my ($res, $query) = @_;
    my @queryRes;
    my @attr;
    foreach my $entry ($res->all_entries) {
         @attr = $entry->get($query);
         push(@queryRes, @attr);
    }
    return @queryRes;
}

sub getSiteAttr {
    my ($site, $tag) = @_;
    my @flist = `ls $::attrDir`;
    foreach my $f (@flist) {
        if ( $f =~ /$site/ ) {
        print "FILE: $f";
            my $siteAttr = retrieve($::attrDir.'/'.$f);
            my @key = keys %$siteAttr;
            my $arr = $siteAttr->{$key[0]};
            print "Runtime attributes for site: $key[0]:\n";
            foreach my $i (@$arr) {
                print "$i\n";
                if ($tag && $i =~ /$tag/) {
                    print "\n============> Tag matching for $tag: $i\n\n";
                }
            }
        }
    }
}

# Subroutine to write site RunTime attributes, like software tags, into a persistent file

sub setSiteAttr {
    my %SiteAttributes;                      # Hash table with CE/SE pair (mostly used with lcg tools)
    my $site = shift;
    # Retrieves sw tag
    my $ldapRes = &ldapq($site, "2135", "GlueSubCluster");
    my @CEattr = &selectAttr($ldapRes, "GlueHostApplicationSoftwareRunTimeEnvironment");
    $SiteAttributes{$site} = [ @CEattr ];
    store(\%SiteAttributes, $::attrDir . '/' . $site . '.dat');
}

# 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.7
Committed:	Mon Feb 7 14:45:56 2005 UTC (20 years, 2 months ago) by corvo
Content type:	text/plain
Branch:	MAIN
CVS Tags:	XCMSI_0_9_pre4
Changes since 1.6:	+126 -103 lines
Log Message:	Improved features for setting/retrieving software tags
#	User	Rev	Content
1	krabbert	1.1	#!/usr/bin/perl
2	corvo	1.7	# $Id: site_utils.pm,v 1.6 2004/12/17 10:27:39 krabbert Exp $
3	krabbert	1.1	package site_utils;
4
5			use strict;
6	corvo	1.7	use Storable;
7	krabbert	1.1	use Cwd;
8			use English;
9			use IPC::Open3;
10			use Net::LDAP;
11
12	corvo	1.7	our (@ISA, @EXPORT);
13	krabbert	1.1	use Exporter;
14			@ISA = qw(Exporter);
15	corvo	1.7	@EXPORT = qw(&create_list &validate_list &checkStatus &execSys %CeSe_table &ldapq &getSiteAttr &setSiteAttr &selectCe &selectAttr);
16	corvo	1.3
17			###################################################
18			#
19			# This subroutine contacts the BDII ldap server retrieving all CEs belongig to a given VO
20			# (by default CMS). It then selects the software tags and marks the CE for upgrade or install
21			#
22			###################################################
23	krabbert	1.1	sub create_list {
24	corvo	1.7	my ($regex, @tag) = @_; # function arguments (bdii, site and sw tag)
25			my %CeSe_table; # Hash table with CE/SE pair (mostly used with lcg tools)
26	corvo	1.3	my $key; # CE entry without batch system queue. Used to keep only one CE selected
27			my %IsIn; # Hash to keep informations of CE already signed for job submission
28	krabbert	1.1	print "Creating CE list...\n\n";
29	corvo	1.3	# CE list creation
30	corvo	1.7	# General purpose LDAP query. Returns a reference to an ldap hash.
31			my $ldapRes = &ldapq($::bdii, "2170", "GlueCE");
32			# Select the CE belonging to the given VO (default = cms).
33			my @list = &selectCe($ldapRes, "GlueCEAccessControlBaseRule", $::org, $regex);
34	corvo	1.3	foreach my $entry (@list) {
35	corvo	1.7	my $tagOK;
36			($key, my $junk) = split(/:/, $entry);
37			# setSiteAttr($key);
38			# SE list related to the CE
39			my $ldapRes = &ldapq($key, "2135", "GlueCESEBindGroup");
40			my @selist = &selectAttr($ldapRes, "GlueCESEBindGroupSEUniqueID");
41			# Retrieves sw tag
42			$ldapRes = &ldapq($key, "2135", "GlueSubCluster");
43			my @CEattr = &selectAttr($ldapRes, "GlueHostApplicationSoftwareRunTimeEnvironment");
44			foreach my $val (@tag) {
45			foreach my $value (@CEattr) {
46			if ($value =~ $val) { # If CERuntimeEnv matches the given tag, then skip this CE
47			$tagOK = 1;
48			last;
49	corvo	1.3	}
50	corvo	1.7	elsif ($value =~ /ORCA\|OSCAR/ and $value !~ /.ORCA.dar\|.OSCAR.dar/ ) {
51			$tagOK = 0;
52	corvo	1.3	}
53	corvo	1.7	}
54			push(@selist, $tagOK);
55			}
56			# Create an hash with only one CE chosen among different batch queues (long, short, infinite)
57			if ( keys %IsIn ) {
58			unless ($IsIn{$key} == 1 ) {
59	corvo	1.3	$CeSe_table{$entry}=[ @selist ];
60			$IsIn{$key} = 1;
61			}
62			}
63	corvo	1.7	else {
64			$CeSe_table{$entry}=[ @selist ];
65			$IsIn{$key} = 1;
66			}
67	krabbert	1.1	}
68	corvo	1.7	return %CeSe_table;
69	corvo	1.3	}
70
71			###################################################
72			#
73	krabbert	1.1	# Ldap subroutine to check CMS tags on CE lists. Just to be sure not to install sw again
74	corvo	1.7	# Returns a reference to an ldap hash.
75	corvo	1.3	#
76			##################################################
77	krabbert	1.1	sub ldapq {
78	corvo	1.7	my ($lsvr, $port, $objcls) = @_;
79			my $ldap = Net::LDAP->new($lsvr, port => $port) or warn "error connecting to $lsvr: $@";
80			if ($ldap) {
81
82			$ldap->bind; # Bind anonymously, that is, no login and pass
83
84			my $results = $ldap->search ( # Perform a search on given base and filter bases
85			base => "mds-vo-name=local, o=grid",
86			filter => "(objectClass=$objcls)",
87			attrs => ['*','modifyTimestamp']
88			);
89	krabbert	1.1
90	corvo	1.7	if ($results->code) {
91			die "received LDAP error: @{[$results->error]}";
92			}
93			$ldap->unbind; # Unbind and close connection
94			return $results;
95	krabbert	1.1	}
96	corvo	1.7	else {print "No connection available to $lsvr\n";}
97			}
98	krabbert	1.1
99	corvo	1.7	###################################################
100			#
101			# Subroutine to select the CEs based on the VO "signature", and
102			# on url
103			#
104			###################################################
105			sub selectCe {
106			my ($res, $query, $org, $regex) = @_;
107			my @queryRes;
108			my @attr;
109			my @list;
110			chomp($regex);
111			my $notFound = 1;
112			foreach my $entry ($res->all_entries) {
113			@attr = $entry->get($query);
114			@list = $entry->get('GlueCEUniqueID');
115	corvo	1.3	# Selects only those CE belonging to a given VO (by default CMS)
116	corvo	1.7	foreach my $val (@attr) {
117			if ($list[0] =~ /$regex/ and $val =~ /$::org/) {
118			$notFound = 0;
119			my @tstp = $entry->get('modifyTimestamp');
120			push(@queryRes, @list);
121	corvo	1.3	}
122			}
123	krabbert	1.1	}
124	corvo	1.7	if ($notFound == 1) {
125			print "No matching sites found. Check site name or site availability.\n";
126			exit;
127			}
128			return @queryRes;
129			}
130
131			sub selectAttr {
132			my ($res, $query) = @_;
133			my @queryRes;
134			my @attr;
135			foreach my $entry ($res->all_entries) {
136			@attr = $entry->get($query);
137			push(@queryRes, @attr);
138			}
139			return @queryRes;
140			}
141
142			sub getSiteAttr {
143			my ($site, $tag) = @_;
144			my @flist = `ls $::attrDir`;
145			foreach my $f (@flist) {
146			if ( $f =~ /$site/ ) {
147			print "FILE: $f";
148			my $siteAttr = retrieve($::attrDir.'/'.$f);
149			my @key = keys %$siteAttr;
150			my $arr = $siteAttr->{$key[0]};
151			print "Runtime attributes for site: $key[0]:\n";
152			foreach my $i (@$arr) {
153			print "$i\n";
154			if ($tag && $i =~ /$tag/) {
155			print "\n============> Tag matching for $tag: $i\n\n";
156			}
157			}
158			}
159			}
160			}
161
162			# Subroutine to write site RunTime attributes, like software tags, into a persistent file
163
164			sub setSiteAttr {
165			my %SiteAttributes; # Hash table with CE/SE pair (mostly used with lcg tools)
166			my $site = shift;
167			# Retrieves sw tag
168			my $ldapRes = &ldapq($site, "2135", "GlueSubCluster");
169			my @CEattr = &selectAttr($ldapRes, "GlueHostApplicationSoftwareRunTimeEnvironment");
170			$SiteAttributes{$site} = [ @CEattr ];
171			store(\%SiteAttributes, $::attrDir . '/' . $site . '.dat');
172	krabbert	1.1	}
173
174			# Subroutine to execute OS command in a more friendly way. Returns error codes.
175	corvo	1.7
176	krabbert	1.1	sub execSys {
177			my $cmd = shift;
178	corvo	1.3	open(LOG, ">>$::logDir/cmd.log");
179	krabbert	1.1	local(HIS_IN, HIS_OUT, *HIS_ERR);
180			my $childpid = open3(HIS_IN, HIS_OUT, *HIS_ERR, $cmd);
181			my @outlines = <HIS_OUT>; # Read till EOF.
182			my @errlines = <HIS_ERR>; # XXX: block potential if massive
183			# print "STDOUT:\n", @outlines, "\n";
184			# print "STDERR:\n", @errlines, "\n";
185			close HIS_OUT;
186			close HIS_ERR;
187			waitpid($childpid, 0);
188			if ($?) {
189	corvo	1.3	print(LOG "That child exited with wait status of $?\n");
190	krabbert	1.1	}
191			my $rc = 0xffff & $?;
192	corvo	1.3	# printf "system(%s) returned %#04x: \n", "$cmd", $rc;
193	krabbert	1.1	if ($rc == 0) {
194	corvo	1.3	print(LOG "$cmd ran with normal exit\n");
195	krabbert	1.1	}
196			elsif ($rc == 0xff00) {
197	corvo	1.3	print(LOG "command $cmd failed: $!\n");
198	krabbert	1.1	}
199			elsif (($rc & 0xff) == 0) {
200			$rc >>= 8;
201	corvo	1.3	print(LOG "$cmd ran with non-zero exit status $rc\n");
202	krabbert	1.1	}
203			else {
204	corvo	1.3	print(LOG "ran with ");
205	krabbert	1.1	if ($rc & 0x80) {
206			$rc &= ~0x80;
207	corvo	1.3	print(LOG "coredump from ");
208	krabbert	1.1	}
209	corvo	1.3	print(LOG "signal $rc\n");
210	krabbert	1.1	}
211			my $ok = ($rc == 0);
212			return @outlines, $ok;
213			}
214	corvo	1.3	1;