grid-packaging-tools 3.6.7-1 / usr / sbin / gpt-postinstall

#! /usr/bin/perl


my ($prefix, $globus_prefix, $exec_prefix, $bindir, $sbindir, $libdir);
my ($datarootdir, $datadir, $perlmoduledir, $gptdatadir);
my ($gptexecsharedir, $amdir, $pkg_confdir, $aclocaldir);

if (exists $ENV{GPT_LOCATION})
{
    $prefix = $ENV{GPT_LOCATION};
}
else
{
    $prefix = "/usr";
}

if (exists $ENV{GLOBUS_LOCATION})
{
    $globus_prefix = $ENV{GLOBUS_LOCATION};
}
else
{
    $globus_prefix = "/usr";
}

$exec_prefix = "${prefix}";
$bindir = "${exec_prefix}/bin";
$sbindir = "${exec_prefix}/sbin";
$libdir = "${exec_prefix}/lib";
$datarootdir = "${prefix}/share";
$datadir = "${prefix}/share";
$perlmoduledir = "/usr/share/perl5";
$gptdatadir = "${datadir}/globus/gpt";
$gptexecsharedir = "${datadir}/globus/gpt";
$amdir = "${datadir}/globus/amdir";
$pkg_confdir = "${datadir}/globus/gpt";
$aclocaldir = "${datadir}/globus/aclocal";

unshift(@INC, "${perlmoduledir}");

use strict;
use Carp;
use Getopt::Long;
use Cwd;
use Config;

#
# Do a perl check for version >= 5.005.
#

if ( ! ( defined eval "require 5.005" ) )
{
    die "GPT requires at least Perl version 5.005";
}

#
# dig the globus and gpt paths out of the user's environment variables
#

my $verbose;

if ( ! -d "$datadir/globus/packages" )
{
    die("Can't find a globus/packages directory to work on in your GLOBUS_LOCATION!\n");
}

if ( ! ( defined eval "require Grid::GPT::GPTObject" ) )
{
    die("$prefix does not appear to hold a valid GPT installation\n");
}

require Pod::Usage;

my($force, $error, $version, $help, $man, $location, $debug);

GetOptions( 'force'      => \$force,
           'debug'          => \$debug,
           'verbose'          => \$verbose,
            'version'    => \$version,
            'help|?'     => \$help,
            'location=s' => \$prefix, 
            'man'        => \$man)
  or Pod::Usage::pod2usage(0);

Pod::Usage::pod2usage(1) if $help;
Pod::Usage::pod2usage(-verbose => 2) if $man;

require Grid::GPT::GPTIdentity;
Grid::GPT::GPTIdentity::print_gpt_version() if defined $version;

require Grid::GPT::Installation;
require Grid::GPT::SetupInstallation;
require Grid::GPT::PackageFactory;
require Grid::GPT::Algorithms;
require Grid::GPT::PkgMngmt::Inform;

my @pkg_queries = @ARGV;

my $all = @pkg_queries < 1;

my $log = new Grid::GPT::PkgMngmt::Inform(
                                          verbose => $verbose, 
                                          debug => $debug
                                         );

my $locations = new Grid::GPT::Locations( installdir => $prefix);

my $list;

my $installation = 
  new Grid::GPT::Installation(locations => $locations,
                             log => $log);

if (! $all) {

  require Grid::GPT::Algorithms;
  my $checks = 
  new Grid::GPT::Algorithms(
                            log => $log,
                            locations => $locations,
                           );
  $list = $checks->sort_input_patterns(inputs => \@pkg_queries);
  $list = find_pkgs($list);

} else {

  $list = $installation->setup_pkgs();

}

my $msg .=  "The following setup packages were found:\n" if @$list;

    for my $p (@$list) {
      $msg .=  "\t" .$p->label() ." ver: " . 
        $p->version_label() . "\n";
    }

$log->debug($msg);
my @postpkgs;
my %postcommands;

my $setupinstallation = 
  new Grid::GPT::SetupInstallation(locations => $locations,
                             log => $log);

@$list = grep {$_->pkgtype() =~ m!pgm! } @$list;

if ( !defined($force) )
  {
    my $needs = $setupinstallation->check_for_setup_needs(pkgs => $list);

    if (defined $verbose or defined $debug or ! $all) {
      for my $p (@$list) {
        next if grep {$_->is_same($p)} @$needs;
        $log->inform($p->label() . " is already set up",1);
      }
    }
    $list = $needs;
  }

$msg .=  "The following packages need to be set up:\n" if @$list;

for my $p (@$list) {
  $msg .=  "\t" .$p->label() ." ver: " . 
    $p->version_label() . "\n";
}
$log->debug($msg);



my @setupcommands;
my $setupcmd;
my $depnode;

my $pkgset = new Grid::GPT::PkgSet;

#
# our first pass checks for collisions against the post install program.  it
# only adds packages to our package set that require post install programs which
# we haven't seen yet be run.
#

for my $l (@$list)
  {
    #            $l->printnode();

    $setupcmd = trimSetupCommand($l->{'depnode'}->{'Post_Install_Program'});
    
    if ( ! grep(/^$setupcmd$/, @setupcommands) )
      {
        $depnode = $l->{'depnode'};
        push(@setupcommands, $setupcmd);
        $pkgset->add_package(pkg => $depnode);
      }
  }

#
# print out the unsorted commands (for debugging)
#

#        printf("\nunsorted commands\n");
#        for my $s (@setupcommands)
#        {
#            printf("command = '%s'\n", $s);
#        }

        #
        # prep the package set and sort
        #

        $pkgset->set_depenv('Setup');
#open (OUT, ">./deptable.html");

#select(OUT);

#print "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
#<html>
#  <head>
#    <title>Globus Packages</title>
#  </head>

#  <body>

#    <h1>Installation Dependency Tree</h1>\n";

#$pkgset->printtablehtml();

#print "  </body>
#</html>
#";
        $pkgset->sort_pkgs();

        #
        # zero out our list of setup commands
        #

        @setupcommands = ();

        #
        # grab the packages that have been sorted and add them onto setup commands
        #

        for my $p (@{$pkgset->sorted()})
        {
            $setupcmd = trimSetupCommand($p->{'depnode'}->{'Post_Install_Program'});
            $setupcmd = formatSetupCommand($setupcmd);
            if (length($setupcmd) > 0)
            {
                push(@setupcommands, $setupcmd);
            }
        }

#        printf("\nsorted commands\n");
#        for my $s (@setupcommands)
#        {
#            printf("command = '%s'\n", $s);
#        }

        if ( (scalar(@setupcommands) == 0) 
             && !defined($error) && $all)
        {
            printf("All of the packages in your GLOBUS_LOCATION are already set up.\n");
            exit;
        }
        else
        {
            runSetupCommands(@setupcommands);
        }


#verifying that scripts have completed.

$setupinstallation = 
  new Grid::GPT::SetupInstallation(locations => $locations,
                                   log => $log);

$list = $setupinstallation->check_for_setup_needs(pkgs => $pkgset->{'pkgs'});

my @bad;

for my $p (@$list) {

  next if ! grep {$_->is_same($p)} @{$pkgset->{'pkgs'}};
  push @bad, $p->label();
}
exit 0 if ! @bad;

print "WARNING: The following packages were not set up correctly:\n";

for my $l (@bad) {
  print "\t$l\n";
}
print "Check the package documentation or run postinstall -verbose to see what happened\n";

exit;

### getFileLocation( $entity )
#
# given an entity in the form of a unix-style path, remove the trailing entry
# and return its parent directory.
#

sub getFileLocation
{
    my($entity) = @_;
    my($dir);

    $dir = $entity;

    $dir =~ s:/+:/:g;    # remove consecutive slashes
    $dir =~ s:/$::g;     # remove trailing slash (just in case)
    $dir =~ s:/[^/]*$::; # remove trailing filename

    return $dir;
}

### runSetupCommands
#
# given a list of setup commands, run them (in order)
#

sub runSetupCommands
{
    my (@setupcommands) = @_;
    my $olddir;

    for my $s (@setupcommands)
    {
        printf("running %s..", $s);
        print "\n" if defined $verbose or defined $debug;
        action($s, getFileLocation($s));
        printf("..Done\n") if ! defined $verbose and ! defined $debug;

    }
}

### formatSetupCommand( $setupcmd )
#
# prepend the setup path to the setup command
#

sub formatSetupCommand
{
    my($setupcmd) = @_;
    my($newcmd, $tmpcmd1, $tmpcmd2);

    #
    # first check in $GL/setup/globus/ to maintain backwards compatibility
    #

    $tmpcmd1 = "$prefix/setup/globus/$setupcmd";

    if ( -x $tmpcmd1 )
    {
        $newcmd = $tmpcmd1;

        return $newcmd;
    }

    #
    # otherwise check in $GL/setup/ to support new-style paths
    #

    $tmpcmd2 = "$prefix/setup/$setupcmd";

    if ( -x $tmpcmd2 )
    {
        $newcmd = $tmpcmd2;

        return $newcmd;
    }

    #
    # warn that we can't find a match for $setupcmd
    #

    printf("WARNING: cannot locate an executable file at either\n");
    printf("\t'$tmpcmd1'\n");
    printf("or\n");
    printf("\t'$tmpcmd2'\n");
    printf("...giving up.\n");

    $error = 1;

    return "";
}

### trimSetupCommand( $setupcmd )
#
# given a string, trim extraneous characters off of it
#

sub trimSetupCommand
{
    my ($setupcmd) = @_;

    $setupcmd =~ s:\n+::g;
    $setupcmd =~ s:^[\s]+|[\s]+$::g;
    $setupcmd =~ s:\s+: :g;

    return $setupcmd;
}

### action( $command, $dir )
#
# perform some command and inform the user
#



sub action
{
    my ($command, $dir) = @_;
    my $pwd;
    if (defined $dir) {
        $pwd = cwd();
        $log->inform("[ Changing to $dir ]",1);
        chdir($dir);
    }

    my $result = 
      system(
             "GLOBUS_LOCATION=$locations->{'installdir'}; \\
export GLOBUS_LOCATION; \\
GPT_LOCATION=$locations->{'installdir'}; \\
export GPT_LOCATION; \\
$command 2>&1");

    if ($result or $?)
      {
        # results are bad print them out.
        die("ERROR: Command failed\n");
    }

    if (defined $dir)
    {
        $log->inform("[ Changing to $pwd ]");
        chdir($pwd);
    }
}

sub find_pkgs {
  my ($queries) = @_;

  my @bad;
  my @pkgs;

  for my $q (@$queries) {

    my $cands = $installation->query(%$q);
      my $input = "$q->{'pkgname'}-$q->{'flavor'}-$q->{'pkgtype'}";

      $input =~ s!ANY!*!g;

    # Complain about pattern if it does not come from a bundle.
    if (! defined $cands) {
      push @bad, $input;
      next;
    }


    my $msg = "Query: $input found the following setup packages:\n"; 

    for my $c (@$cands) {
      next if ! defined $c->setupname();
      $msg .= "\t" . $c->label() . "\n";
      push @pkgs, $c;
    }

    $log->debug($msg);
  }

  if (@bad) {
    print "ERROR: The following does not match any packages:\n";
    for my $b (@bad) {
      print "\t$b->{'pkgname'}-$b->{'flavor'}-$b->{'pkgtype'}\n";
    }
    exit 1;
  }

  return \@pkgs;

}

=head1 NAME

B<gpt-postinstall> - Searches for post install scripts and executes them

=head1 SYNOPSIS

  gpt-postinstall [-help -force -version -man -location ]

=head1 DESCRIPTION

B<gpt-postinstall> Searches an installation for post-install scripts
that have not been run yet and executes them.  These scripts are
installed by Setup packages and are designed to localize an
installation. The I<-force> flag can be used to re-run all of the
setup scripts.

=head1 OPTIONS

=over 8

=item B<-force>

forces all action to be taken, regardless of state.

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=item B<-version>

Prints the version of GPT and exits.

=item B<-location>

Location indicates the path to the Globus installation that will be used.

=back

=head1 SEE ALSO

gpt-install(1) gpt-uninstall(1) gpt-verify(1)

=head1 AUTHOR

Michael Bletzinger E<lt>mbletzin.ncsa.uiuc.eduE<gt> and Eric Blau
E<lt>eblau.ncsa.uiuc.eduE<gt>

=cut