#! /usr/bin/perl
#
# gridmake -  gmake for the grid
#
# This script is a generic grid job execution engine centered on
# the concept of a maintained set of data files on grid storage.
# The semantics are similar to gmake, in that one specifies one or 
# more targets to be built on the command line, and it automatically
# generates the chain of commands needed to refresh them, as needed.
# The make rules are contained in a xml configuration file, by default
# called ./gridmake.xml, whose schema is described in gridmake.xsl.
# The name of the xml makefile can be overridden by specifying the
# -F option on the command line.
#
# Usage: gridmake [-d] [-srm] [-f <config-file>] <list of targets>
#
# author: richard.t.jones at uconn.edu
# version: May 18, 2011
#
# Notes:
# 1. Targets with the attribute store="yes" require logic that goes
#    beyond the semantics of gmake.  The following logic was used
#    to determine what should happen when copies of a target may
#    exist both in the local directory and on remote storage.
#    This logic is only used if there are no stale objects in the
#    target's dependency tree, otherwise it is automatically rebuilt.
#	* If a local copy of the file exists, ignore the remote copy
#	  and follow the standard gmake logic, with a push to store
#	  at the end if the target had to be remade, otherwise not.
#	* If only a backup copy exists, run through the standard
#	  gmake staleness logic based on the timestamp on the backup.
#	  Should the logic not require that the target be remade, no
#	  action is taken.  Otherwise the target is remade and the
#	  old backup copy is overwritten.
#	* If neither remote nor backup copies exist, remake the target
#         and push a copy to the backup store.
#    For targets without store="yes" specified, only local copies
#    are referenced and no checks for remote copies are made.

# The perl modules needed by gridmake are listed here.
# Do not "use" them directly here, because they may need
# to be downloaded and installed first.  They are installed
# if needed and then loaded in the function setup_perl_environment().

use strict;

# This setting controls whether the job running gridmake is
# empowered to rebuild software packages and install them on
# the local site, or whether it should just report problems
# with the local setup and fail when setup generates an error.
# Set either to "install" to do the build/install on the site,
# or to "report" to merely report the problem and exit.
our $install_cmd = "install";
#our $install_cmd = "report";

our $package_server_url = "http://zeus.phys.uconn.edu/prod/scripts/package";

our @use_modules =
(
   "URI.pm",
   "Cwd.pm",
   "Time/Local.pm",
   "LWP/UserAgent.pm",
   "HTTP/Request/Common.pm",
   "XML/Xerces.pm"
);

our $xerces_p_version_for_Xerces_perl_module  = "2.7.0";


our $debug = 0;
our $retries = 3;
our $config_file = "gridmake.xml";
our $useSRM = 0;
our %packages;
our $cpan_package = "cpan/1.0";
our $vdt_package = "osg-vdt/3.1";
our $cvmfs_root = "/cvmfs/oasis.opensciencegrid.org/gluex";

$SIG{"ALRM"} = sub{print "Woke up with SIGALRM, execution continues...\n";};

sub usage
{
   warn "Usage: gridmake [-d] [-srm] [-f <config-file>] <list of targets>\n";
}

our $verbose = 1;

if ($verbose) {
   my $hostname = `hostname -f`;
   chop $hostname;
   my $cwd = `pwd`;
   chop $cwd;
   print "=======================================================\n",
         "Entry to gridmake on $hostname\n",
         "in working directory $cwd\n",
         "with limits\n",`bash -c \"ulimit -a\"`,
         "=======================================================\n";
}

while (@ARGV > 0 && $ARGV[0] =~ /^-/) {
   my $option = shift @ARGV;  
   if ($option eq "-f") {
      $config_file = shift @ARGV;
   }
   elsif ($option eq "-d") {
      $debug = 1;
   }
   elsif ($option eq "-srm") {
      $useSRM = 1;
   }
   else {
      usage();
      exit 1;
   }
}
if (@ARGV == 0) {
   usage();
   exit 1;
}

setup_perl_environment();
setup_vdt_environment();

our $config_doc;
if (-r $config_file) {
   $config_doc = get_xml_document($config_file);
}
else {
   warn "gridmake error - unable to open config file $config_file\n";
   usage();
   exit 1;
}

our %srm_pusher;

for (my $iarg=0; $iarg<@ARGV; ++$iarg) {
   my $target = $ARGV[$iarg];
   make_target($target);
}

if ($useSRM) {
   for (my $iarg=0; $iarg<@ARGV; ++$iarg) {
      my $target = $ARGV[$iarg];
      if (defined $srm_pusher{"$target/stdin"}) {
         close $srm_pusher{"$target/stdin"};
         print "log from final push of $target to srm follows:\n";
         open my $pusher_stdout, $srm_pusher{"$target/stdout"} || die;
         my $retcode;
         while (<$pusher_stdout>) {
            if (/WARNING: SRM_PATH is defined, but does not point to the expected place/) {
               while (<$pusher_stdout>) {
                  last unless (/^WARNING: /);
               }
            }
            if (/return code ([0-9]*)/) {
               $retcode = $1;
            }
            print $_;
         }
         close $pusher_stdout;
         open my $pusher_stderr, $srm_pusher{"$target/stderr"} || die;
         while (<$pusher_stderr>) { print $_ }
         close $pusher_stderr;
         unlink $srm_pusher{"$target/stdout"};
         unlink $srm_pusher{"$target/stderr"};
         delete $srm_pusher{"$target/stdout"};
         delete $srm_pusher{"$target/stderr"};
         delete $srm_pusher{"$target/stdin"};
         exit $retcode if ($retcode);
      }
   }
}
exit 0;


sub make_target
{
   my $target = shift;
   if ($debug) {
      print ">>> gridmake - entering make_target for target $target\n";
   }

   # find the processor and process number for this target

   my $process = undef;
   my $processorTag = undef;
   my $matchingOutputTag = undef;
   my @outputTags = $config_doc->getElementsByTagName("output");
   for my $outputTag (@outputTags) {
      my @outputs = $outputTag->getChildNodes();
      my $regex = $outputs[0]->getNodeValue();
      $regex =~ s/\$\(PROCESS\)/([0-9]+)/;
      if ($target =~ /^$regex$/) {
         $process = $1;
         $matchingOutputTag = $outputTag;
         $processorTag = $outputTag->getParentNode();
         last;
      }
   }
   if (!defined $processorTag) {
      warn "make_target error - no rules found to make target $target\n";
      return -1;
   }
   elsif ($debug) {
      print ">>> gridmake - selected processor ",
            $processorTag->getAttribute("name")," for target $target\n";
   }

   # if needed, remake this target

   my @inputFiles;
   my $tstamp;
   my $sflag = $matchingOutputTag->getAttribute("store") eq "yes";
   if (($processorTag->getAttribute("force") eq "yes") ||
       (($tstamp = get_timestamp_for_file($target,$sflag)) == 0) ||
       stale_target($target)) {
      if ($processorTag->getAttribute("force") eq "yes") {
         print "remake of target $target forced by policy\n";
      }
      elsif ($tstamp == 0) {
         print "target $target is missing, remaking\n";
      }
      else {
         print "target $target is stale, remaking\n";
      }
   
      # loop over the packages needed by this processor, install as needed

      if ($debug) {
         print ">>> gridmake - setting up packages for processor ",
               $processorTag->getAttribute("name"),"\n";
      }
      my @requiresTags = $processorTag->getElementsByTagName("requires");
      for my $requiresTag (@requiresTags) {
         my $package = $requiresTag->getAttribute("package");
         if (!setup_package_environment($package)) {
            warn "make_target error - unable to setup environment",
                 " for package $package, cannot continue.\n";
            exit 1;
         }
      }

      # loop over the input files needed by this processor, update as needed

      if ($debug) {
         print ">>> gridmake - making inputs for processor ",
               $processorTag->getAttribute("name"),"\n";
      }
      my @inputTags = $processorTag->getElementsByTagName("input");
      for my $inputTag (@inputTags) {
         my @inputs = $inputTag->getChildNodes();
         my $input = $inputs[0]->getNodeValue();
         $input =~ s/\$\(PROCESS\)/$process/;
         make_target($input);
         if ($useSRM) {
            my $rep;
            for ($rep=0; (!-r $input)&&($rep < $retries)&&
                 pull_file_from_srm($input); ++$rep) { 
               unlink $input;
               sleep(120<<$rep);
            }
            if ($rep == $retries) {
               warn "make_target error - unable to pull input file $input",
                    " from srm, giving up after $rep retries\n";
               exit $rep;
            }
         }
         elsif (!-r $input) {
            warn "make_target error - unable to make required input file",
                 " $input, giving up\n";
            exit 1;
         }
         $inputFiles[@inputFiles] = $input;
      }

      # run the command script to make this target

      if ($debug) {
         print ">>> gridmake - target $target is being remade\n";
      }
      my @scriptTags = $processorTag->getElementsByTagName("script");
      my @script = $scriptTags[0]->getChildNodes();
      my $script = $script[0]->getNodeValue();
      $script =~ s/\$\(PROCESS\)/$process/gs;
      my @scriptlines = split /\n\s*/, $script;
      my $name = $processorTag->getAttribute("name");
      open my $SCRIPT, ">run_$name" or die;
      shift @scriptlines;
      push @scriptlines,"";
      print $SCRIPT join "\n", @scriptlines;
      close $SCRIPT;
      chmod 0755, "run_$name";
      my $hostname = `hostname -f`;
      my $now = localtime();
      print "=======================================================\n";
      print "executing script run_$name on node $hostname at $now\n";
      print "-------------------------------------------------------\n";
      print "\$ ls -l\n";
      system "ls -l";
      print "\$ ./run_$name\n";
      my $retcode = system "./run_$name";
      print "\$ ls -l\n";
      system "ls -l";
      print "-------------------------------------------------------\n";
      if ($retcode == -1) {
         print "script run_$name failed with exit code $retcode\n";
         warn "gridmake make_target error - script run_$name ",
              " failed to start, unable to continue, aborting.\n";
      }
      elsif ($retcode & 0x7f) {
         $retcode = $retcode & 0x7f;
         print "script run_$name was aborted by signal $retcode\n";
         warn "gridmake make_target error - script run_$name ",
              "was aborted by signal $retcode, gridmake aborting.\n";
      }
      elsif ($retcode = $retcode >> 8) {
         print "script run_$name returned with exit code $retcode\n";
         warn "gridmake make_target error - script run_$name ",
              " returned exit code $retcode, make failed, aborting.\n";
      }
      print "=======================================================\n";
      unlink "run_$name";
      exit $retcode if ($retcode != 0);
   }
   else {
      print "existing file $target was fresh, existing copy kept\n";
      return;
   }

   # push to srm any storage-bound output files created in this make step

   my @writeTags = $processorTag->getElementsByTagName("output");
   for my $writeTag (@writeTags) {
      my @outputFiles = $writeTag->getChildNodes();
      my $outputFile = $outputFiles[0]->getNodeValue();
      $outputFile =~ s/\$\(PROCESS\)/$process/;
      if (!-r $outputFile) {
         warn "make_target error - output file $outputFile not found,\n",
              "aborting because unable to make $outputFile\n";
         exit 9;
      }
      next if (!$useSRM || $writeTag->getAttribute("store") ne "yes");
      my $pusher_stdout = ".srmput-$outputFile.stdout";
      my $pusher_stderr = ".srmput-$outputFile.stderr";
      my $pusher_pid = open my $pusher_stdin, "-|";
      if ($pusher_pid == 0) {
         setpgrp;
         close STDOUT;
         open STDOUT, ">$pusher_stdout" or die;
         close STDERR;
         open STDERR, ">$pusher_stderr" or die;
         my $rep;
         for ($rep=0; ($rep < $retries) &&
              push_file_to_srm($outputFile); ++$rep) {
            delete_file_from_srm($outputFile);
            unlink ".srmrm-$outputFile.stdout";
            unlink ".srmrm-$outputFile.stderr";
            sleep(120<<$rep);
         }
         if ($rep == $retries) {
            warn "make_target warning - unable to push output file $outputFile",
                 " to srm, moving on after $rep unsuccessful retries.\n";
         }
         my $retcode = ($rep == $retries)? $retries : 0;
         print "return code $retcode \n";
         exit $retcode;
      }
      $srm_pusher{"$outputFile/stdout"} = $pusher_stdout;
      $srm_pusher{"$outputFile/stderr"} = $pusher_stderr;
      $srm_pusher{"$outputFile/stdin"} = $pusher_stdin;
      $srm_pusher{$outputFile} = $pusher_pid;
   }

   # clean up any unwanted input files that were used to make this target

   foreach my $inputFile (@inputFiles) {
      if (defined $srm_pusher{"$inputFile/stdin"}) {
         close $srm_pusher{"$inputFile/stdin"};
         print "delayed log from push of $inputFile to srm follows:\n";
         open my $pusher_stdout, $srm_pusher{"$inputFile/stdout"} || die;
         my $retcode; 
         while (<$pusher_stdout>) {
            if (/WARNING: SRM_PATH is defined, but does not point to the expected place/) {
               while (<$pusher_stdout>) {
                  last unless (/^WARNING: /);
               }
            }
            if (/return code ([0-9]*)/) {
               $retcode = $1;
            }
            print $_;
         }
         close $pusher_stdout;
         open my $pusher_stderr, $srm_pusher{"$inputFile/stderr"} || die;
         while (<$pusher_stderr>) { print $_ }
         close $pusher_stderr;
         if ($retcode != 0) {
            warn "gridmake error: push of intermediate target ",
                 $inputFile, " to srm failed, but pressing on anyway.\n";
         }
         unlink $srm_pusher{"$inputFile/stdout"};
         unlink $srm_pusher{"$inputFile/stderr"};
         delete $srm_pusher{"$inputFile/stdout"};
         delete $srm_pusher{"$inputFile/stderr"};
         delete $srm_pusher{"$inputFile/stdin"};
         delete $srm_pusher{$inputFile};
      }
      for my $outputTag (@outputTags) {
         my @outputs = $outputTag->getChildNodes();
         my $output = $outputs[0]->getNodeValue();
         $output =~ s/\$\(PROCESS\)/$process/;
         next unless ($output eq $inputFile);
         if ($outputTag->getAttribute("keep") ne "yes") {
            unlink($inputFile);
         }
      }
   }
}

sub stale_target
{
   my $target = shift;
   if ($debug) {
      print ">>> gridmake - entering stale_target for target $target\n";
   }

   # find the processor and process number for this target

   my $process = undef;
   my $processorTag = undef;
   my $matchingOutputTag = undef;
   my @outputTags = $config_doc->getElementsByTagName("output");
   for my $outputTag (@outputTags) {
      my @outputs = $outputTag->getChildNodes();
      my $regex = $outputs[0]->getNodeValue();
      $regex =~ s/\$\(PROCESS\)/([0-9]+)/;
      if ($target =~ /^$regex$/) {
         $process = $1;
         $matchingOutputTag = $outputTag;
         $processorTag = $outputTag->getParentNode();
         last;
      }
   }

   # loop through target's inputs, checking for staleness

   my $sflag = $matchingOutputTag->getAttribute("store") eq "yes";
   my $reftime = get_timestamp_for_file($target,$sflag);
   my @inputTags = $processorTag->getElementsByTagName("input");
   for my $inputTag (@inputTags) {
      my @inputs = $inputTag->getChildNodes();
      my $input = $inputs[0]->getNodeValue();
      for my $outputTag (@outputTags) {
         my @outputs = $outputTag->getChildNodes();
         my $output = $outputs[0]->getNodeValue();
         if ($output eq $input) {
            $input =~ s/\$\(PROCESS\)/$process/;
            my $parentprocTag = $outputTag->getParentNode();
            my $psflag = $outputTag->getAttribute("store") eq "yes";
            if (($parentprocTag->getAttribute("force") eq "yes") ||
                (get_timestamp_for_file($input,$psflag) > $reftime) ||
                stale_target($input)) {
               if ($debug) {
                  print ">> gridmake - input file $input is stale!\n";
               }
               return 1;
            }
            last;
         }
      }
   }
   return 0;
}

sub setup_package_environment
{
   my $package = shift;
   if (exists $packages{$package}) {
      return $packages{$package};
   }

   my $packageTag = $config_doc->getElementById($package);
   my @requiresTags = $packageTag->getElementsByTagName("requires");
   for my $requiresTag (@requiresTags) {
      my $p = $requiresTag->getAttribute("package");
      if (!setup_package_environment($p)) {
         return $packages{$package}=0;
      }
   }

   if ($debug) {
      print ">>> gridmake - setting up environment for package",
            " $package\n";
   }

   my @setupTags = $packageTag->getElementsByTagName("setup");
   require Cwd;
   my $top_level_dir = Cwd::cwd();
   for my $setupTag (@setupTags) {
      my $url = $setupTag->getAttribute("src");
      my $package_path = $url;
      $package_path =~ s/.*\/package\//packages\//;
      my @package_path = split /\//, $package_path;
      pop @package_path;
      for (my $i=0; $i<@package_path; ++$i) {
         if (!-d $package_path[$i]) {
            mkdir $package_path[$i], 0755;
         }
         chdir $package_path[$i];
      }
      if (system "cp $cvmfs_root/$package_path . 2>&1 >/dev/null") {
         my $retry = 0;
         require LWP::UserAgent;
         my $agent = new LWP::UserAgent;
         $agent->env_proxy();
         my $resp = $agent->get($url);
         while ($resp->is_error()) {
            if ($retry++ < $retries) {
               sleep(10<<$retry);
               $resp = $agent->get($url);
               next;
            } 
            warn "setup_package_environment error - unable to get setup script",
                 " $url from server, giving up after $retry retries.\n";
            warn "LWP::UserAgent returned error ",$resp->message(),"\n";
            chdir $top_level_dir;
            return $packages{$package}=0;
         }
         open my $SETUP, ">setup" or die $!;
         print $SETUP $resp->content;
         close $SETUP;
      }
      check_system_environment("setup");
      if (system "./setup >setup.env") {
         if (!install_new_package($url)) {
            warn "setup_package_environment error - unable to install package",
                 " $package, giving up.\n";
            chdir $top_level_dir;
            return $packages{$package}=0;
         }
      }
      update_shell_environment("setup.env");
      chdir $top_level_dir;
   }
   print " environment successfully loaded for package $package\n";
   return $packages{$package}=1;
}

sub update_shell_environment
{
   my $env = shift;
   open my $SET, "< $env" or die $!;
   while (<$SET>) {
      chop $_;
      if (/^\s*([A-Za-z0-9_]+)\s*\+=([ \t,:;]?)([^ \t,:;]+)([ \t,:;]?)$/) {
         my ($key,$pre,$val,$suf) = ($1,$2,$3,$4);
         my $sep = ($suf)? $suf : $pre;
         my @list;
         my $found;
         if (exists $ENV{$key}) {
            @list = split /$sep/, $ENV{$key};
            for (my $i=0; $i<@list; ++$i) {
               if ($list[$i] eq $val) {
                  $found = 1;
                  last;
               }
            }
         }
         if (!$found) {
            if ($suf && exists $ENV{$key}) {
               unshift(@list,$val);
               $ENV{$key} = join $suf, @list;
               if ($key eq "PERL5LIB") {
                  unshift(@INC,$val);
               }
            }
            elsif ($pre && exists $ENV{$key}) {
               push(@list,$val);
               $ENV{$key} = join $pre, @list;
               if ($key eq "PERL5LIB") {
                  push(@INC,$val);
               }
            }
            else {
               $ENV{$key} = $val;
               if ($key eq "PERL5LIB") {
                  push(@INC,$val);
               }
            }
         }
         if ($debug) {
            print "      $key = $ENV{$key}\n";
         }
      }
      elsif (/^\s*([A-Za-z0-9_]+)\s*=(.+)$/) {
         my ($key,$val) = ($1,$2);
         $ENV{$key} = $val;
         if ($debug) {
            print "      $key = $ENV{$key}\n";
         }
      }
      else {
         if ($debug) {
            print "      comment line: $_\n";
         }
      }
   }
   close $SET;
}

sub install_new_package
{
   my $url = shift;
   print "installing fresh package from $url\n";
   require LWP::UserAgent;
   my $agent = new LWP::UserAgent;
   $agent->no_proxy();
   for (my $try=0; $try < 999; ++$try) {
      my $retry = 0;
      my $resp = $agent->get("$url?request_permission_to_install=1;");
      while ($resp->is_error()) {
         if ($retry++ < $retries) {
            sleep(10<<$retry);
            $resp = $agent->get("$url?request_permission_to_install=1;");
            next;
         }
         warn ">>> install_new_package error - request_permission_to_install",
              " returned a http error ",$resp->message(),"\n";
         warn "failure installing package after $retry retries, giving up.\n";
         return 0;
      }
      if ($resp->content =~ /^retry in ([0-9]+) seconds/) {
         print "request_permission_to_install deferred,",
                  " sleeping for $1 seconds\n";
         sleep($1);
         if (system "./setup >setup.env") {
            next;
         }
         print "package suddenly appears to be",
               " installed on this site, continuing..\n";
         return 1;
      }
      elsif ($resp->content !~ /^ok/) {
         warn ">>> install_new_package error - request_permission_to_install",
              " returned \"",$resp->content,"\", failure installing package\n";
         return 0;
      }
      else {
         last;
      }
   }
   print "permission to install package granted",
         " so going ahead with installation\n";
   my $status;
   open my $LOG, "> installer_log" or die;
   print $LOG "OSG_JOB_CONTACT for this site is $ENV{OSG_JOB_CONTACT}\n";
   close $LOG;
   my $retcode;
   if ("$install_cmd" eq "report") {
      $retcode = system "/bin/bash -x ./setup >>installer_log 2>&1";
   }
   else {
      $retcode = system "./setup $install_cmd >>installer_log 2>&1";
   }
   if ($retcode) {
      if ($debug) {
         if ($retcode == -1) {
            warn "install_new_package error - installation setup script",
                 " failed to start, cannot continue.\n";
         }
         elsif ($retcode & 0x7f) {
            $retcode = $retcode & 0x7f;
            warn "install_new_package error - installation setup script",
                 " was aborted by signal $retcode signal, quitting.\n";
         }
         else {
            $retcode = $retcode >> 8;
            warn "install_new_package error - installation of package failed",
                  " with return code $retcode, giving up.\n";
         }
      }
      $status = "failed";
   }
   elsif (system "./setup >setup.env") {
      warn "install_new_package error - installation of package succeeded",
           " but afterwards setup failed, giving up\n";
      system "echo \"=== Log of failed setup follows below ===\" >> installer_log";
      system "sh -x ./setup >>installer_log 2>&1";
      $status = "faulty";
   }
   else {
      print "package installation succeeded\n";
      $status = "succeeded";
   }
   system "touch installer_log";
   require Cwd;
   my $here = Cwd::cwd();
   $agent->post($url,
                Content_Type => 'form-data',
                Content => [ report_installation_result => $status,
                             installer_log => ["$here/installer_log"],
                           ]
               );
   return ($status eq "succeeded");
}

sub get_timestamp_for_file
{
   my $file = shift;
   my $sflag = shift;
   if (-r $file) {
      return (stat $file)[9];
   }
   elsif ($sflag && $useSRM) {
      my $srmuri = get_srm_prefix()."/$file";
      open my $SRM, "srmls -l $srmuri 2>&1 |" or die;
      my @response = <$SRM>;
      close $SRM;
      foreach $_ (@response) {
         if (/created at:(.*)/) {
            my ($year,$mon,$mday,$hour,$min,$sec) = split /[\/: ]/ ,$1;
            if ($debug) {
               print ">>> gridmake - found existing target $file",
                     " with timestamp $1\n";
            }
            require Time::Local;
            return Time::Local::timelocal($sec,$min,$hour,$mday,$mon-1,$year);
         }
      }
      if ($debug) {
         print ">>> gridmake - target $file not found on srm\n";
      }
   }
   return 0;
}

sub push_file_to_srm
{
   my $file = shift;
   print "pushing file $file to srm\n";
   my $srmuri = get_srm_prefix()."/$file";
   require Cwd;
   my $filepath = "file:///".Cwd::cwd()."/$file";
   return system "srmcp -2 -overwrite_mode=ALWAYS $filepath $srmuri";
}

sub pull_file_from_srm
{
   my $file = shift;
   print "pulling file $file from srm\n";
   my $srmuri = get_srm_prefix()."/$file";
   require Cwd;
   my $filepath = "file:///".Cwd::cwd()."/$file";
   return system "srmcp $srmuri $filepath";
}

sub delete_file_from_srm
{
   my $file = shift;
   print "deleting file $file from srm\n";
   my $srmuri = get_srm_prefix()."/$file";
   return system "srmrm $srmuri >.srmrm-$file.stdout 2>.srmrm-$file.stderr";
}

sub get_srm_prefix
{
   our $srmURL;
   if (!defined $srmURL) {
      my @srmTag = $config_doc->getElementsByTagName("srm");
      if (!defined $srmTag[0]) {
         warn "gridmake error - unable to open config xml document\n";
         exit 2;
      }
      my @srmURL = $srmTag[0]->getChildNodes();
      $srmURL = $srmURL[0]->getNodeValue();
   }
   return $srmURL
}

sub get_xml_document
{
    my $docfile = shift;
    my @parser;
    push @parser, XML::Xerces::XercesDOMParser->new();
    $parser[$#parser]->setValidationScheme (1);
    $parser[$#parser]->setDoNamespaces (1);
    $parser[$#parser]->setCreateEntityReferenceNodes(0);
    $parser[$#parser]->setDoSchema (1);
    my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
    $parser[$#parser]->setErrorHandler($ERROR_HANDLER);
    eval {$parser[$#parser]->parse ($docfile)};
    (XML::Xerces::error($@) && exit 5) if ($@);
    return $parser[$#parser]->getDocument();
}

sub setup_perl_environment
{
   if (! $ENV{"PATH"}) {
      $ENV{"PATH"} = "/usr/local/bin:/bin:/usr/bin";
   }
   my $top_level_dir = `pwd`;
   chop $top_level_dir;
   my $pdir = "packages/$cpan_package";
   if (-d $pdir) {
      chdir $pdir;
   }
   else {
      my @pdir = split /\//, $pdir;
      foreach my $dir (@pdir) {
         mkdir($dir,0755) if (!-d $dir);
         chdir $dir;
      }
   }
   if ($ENV{'OSG_SQUID_LOCATION'} =~ /[^.]\.[^.].*[^.]\.[^.]/) {
      my $proxy_url = $ENV{'OSG_SQUID_LOCATION'};
      if ($proxy_url !~ /^https*:/) {
         $proxy_url = "http://$proxy_url";
      }
      $ENV{'HTTP_PROXY'} = $ENV{'http_proxy'} = $proxy_url;
      print "Installing local http proxy ",$ENV{'http_proxy'}," for wget.\n";
   }
   else {
      print "No local http proxy found, transfers will not be cached!\n";
   }
   unlink "setup";
   if (system "cp $cvmfs_root/packages/$cpan_package/setup . 2>&1 >/dev/null") {
      if (system "wget $package_server_url/$cpan_package/setup 2>/dev/null") {
         warn "gridmake error - unable to download cpan user-mode wrapper setup\n";
         exit -1;
      }
   }
   check_system_environment("setup");
   if ((system "./setup >setup.env") == 0) {
      update_shell_environment("setup.env");
   }
   chdir $top_level_dir;

   foreach my $mod (@use_modules) {
      if ($mod eq "XML/Xerces.pm") {
         if (!setup_xerces_p_for_perl()) {
            warn "gridmake error - unable to install xerces-p libraries for perl\n";
            exit -1;
         }
      }
      my $mod_name = $mod;
      $mod_name =~ s/\//::/g;
      $mod_name =~ s/\.pm$//;
      my $retcode = system("perl -e \"require $mod_name;\" 2>/dev/null");
      if ($retcode == 0) {
         $packages{"module $mod"} = 1;
         require $mod;
      }
      if (!exists $packages{"module $mod"}) {
         if (!install_perl_package($mod)) {
            warn "gridmake error - unable to find required module $mod\n";
            exit -1;
         }
         else {
            require $mod;
         }
      }
   }
}

sub install_perl_package
{
   my $mod = shift;
   print "installing missing perl module $mod from cpan\n";
   my $top_level_dir = `pwd`;
   chop $top_level_dir;
   chdir "packages/$cpan_package";
   while (1 > 0) {
      my $ok = "ok";
      unlink $ok;
      my $url = "$package_server_url/$cpan_package/setup";
      if (system "wget -O $ok '$url?request_permission_to_install=1;' 2>/dev/null") {
         warn "gridmake error - unable to download cpan user-mode wrapper package\n";
         chdir $top_level_dir;
         return $packages{"cpan"}=0;
      }
      my $response = `cat ok`;
      unlink "ok";
      if ($response =~ /^ok/) {
         last;
      }
      elsif ($response =~ /retry in ([0-9]+) seconds/) {
         sleep($1);
         if (system "./setup >setup.env") {
            warn "gridmake error - unable to setup cpan user-mode wrapper environment\n";
            exit -1;
         }
         update_shell_environment("setup.env");
         foreach my $inc (@INC) {
            if (-r "$inc/$mod") {
               require $mod;
               chdir $top_level_dir;
               return $packages{"module $mod"}=1;
            }
         }
      }
      else {
         warn "gridmake error - requested permission to install cpan",
              " user-mode wrapper package, but package server replied",
              " \"$response\".";
         chdir $top_level_dir;
         return $packages{"cpan"}=0;
      }
   }

   # install the user-mode wrapper for cpan

   if (!exists $packages{"cpan"}) {
      open my $LOG, "> installer_log" or die;
      print $LOG "OSG_JOB_CONTACT for this site is $ENV{OSG_JOB_CONTACT}\n";
      close $LOG;
      my $status;
      my $retcode;
      if ("$install_cmd" eq "report") {
         $retcode = system "/bin/bash -x ./setup >>installer_log 2>&1";
      }
      else {
         $retcode = system "./setup $install_cmd >>installer_log 2>&1";
      }
      if ($retcode != 0) {
         warn "gridmake error - unable to install cpan user-mode wrapper package\n";
         $status = "failed";
      }
      elsif (system "./setup >setup.env") {
         warn "gridmake error - unable to setup cpan user-mode wrapper package\n";
         system "echo \"=== Log of failed setup follows below ===\" >> installer_log";
         system "sh -x ./setup >>installer_log 2>&1";
         $status = "faulty";
      }
      else {
         $status = "succeeded";
      }
      if ($status ne "succeeded") {
         open my $ILOG, "< installer_log" or die;
         open my $OLOG, "> installer_log-url_encoded" or die;
         my @ilog = <$ILOG>;
         my $olog = "@ilog";
         $olog =~ s/([^A-Za-z0-9_.-])/sprintf("%%%02X",ord($1))/seg;
         $olog = "report_installation_result=$status&installer_log=$olog;";
         print $OLOG $olog;
         close $ILOG;
         close $OLOG;
         my $ok = "ok";
         unlink $ok;
         system "wget -O $ok --post-file=installer_log-url_encoded $package_server_url/$cpan_package/setup 2>/dev/null";
         chdir $top_level_dir;
         return $packages{"cpan"}=0;
      }
      update_shell_environment("setup.env");
      $packages{"cpan"} = 1;
   }
   chdir $top_level_dir;

   # now install the perl module

   my $mod_name = $mod;
   $mod_name =~ s/\//::/g;
   $mod_name =~ s/\.pm$//;
   if (!exists $packages{"module $mod"}) {
      my $installer_log = "packages/$cpan_package/${mod_name}_installer_log";
      open my $LOG, "> $installer_log" or die;
      print $LOG "OSG_JOB_CONTACT for this site is $ENV{OSG_JOB_CONTACT}\n";
      close $LOG;
      my $status;
      if (system "cpan -i $mod_name </dev/null >>$installer_log 2>&1") {
         warn "gridmake error - unable to build cpan package $mod_name\n";
         $status = "failed";
      }
      elsif (system "cd packages/$cpan_package && ".
                    "./setup install >>../../../$installer_log 2>&1") {
         warn "gridmake error - unable to save cpan package $mod_name\n";
         $status = "faulty";
      }
      elsif (!-r "$ENV{'CPAN_ROOT'}/lib/$mod" &&
             !-f glob("$ENV{'CPAN_ROOT'}/lib/*-thread-multi/$mod")) {
         warn "gridmake error - cpan install of package $mod_name failed\n";
         $status = "faulty";
      }
      elsif (system "perl -e \"use $mod_name;\"") {
         warn "gridmake error - cpan install of package $mod_name failed\n";
         open my $LOG, ">> $installer_log" or die;
         print $LOG "cpan module $mod_name seemed to install ok,",
                    " but \"use $mod_name;\" fails with the following error:\n";
         close $LOG;
         system "perl -e \"use $mod_name;\" 2>> $installer_log";
         $status = "faulty";
      }
      else {
         $status = "succeeded";
      }
      system "touch installer_log";
      open my $ILOG, "cat installer_log $installer_log |" or die;
      open my $OLOG, "> $installer_log-url_encoded" or die;
      my @ilog = <$ILOG>;
      my $olog = "@ilog";
      $olog =~ s/([^A-Za-z0-9_.-])/sprintf("%%%02X",ord($1))/seg;
      $olog = "report_installation_result=$status&installer_log=$olog;";
      print $OLOG $olog;
      close $ILOG;
      close $OLOG;
      my $ok = "ok";
      unlink $ok;
      system "wget -O $ok --post-file=$installer_log-url_encoded $package_server_url/$cpan_package/setup 2>/dev/null";
      $packages{"module $mod"} = ($status eq "succeeded");
   }
   return $packages{"module $mod"};
}

sub setup_xerces_p_for_perl
{
   my $package_name = "xerces_p_for_perl";
   if (exists $packages{$package_name}) {
      return $packages{$package_name};
   }

   # Handle the special case of XML::Xerces, needs xerces-p to be installed
   # first.  Make sure that XML::Xerces comes after other packages used below,
   # such as LWP::UserAgent and Cwd.

   open my $SH, "file -L `which perl` 2>&1 |" or die;
   while (<$SH>) {
      if (/32-bit/) {
         $ENV{"XERCES_FORCE_LIBRARY_BITS"} = 32;
      }
      elsif (/64-bit/) {
         $ENV{"XERCES_FORCE_LIBRARY_BITS"} = 64;
      }
   }
   close $SH;
   my $package = "xerces-p";
   my $version = $xerces_p_version_for_Xerces_perl_module;
   require Cwd;
   my $top_level_dir = Cwd::cwd();
   foreach my $dir ("packages", $package, $version) {
      mkdir $dir, 0755 if (!-d $dir);
      chdir $dir;
   }
   system "rm -f setup*";
   my $url = "$package_server_url/$package/$version/setup";
   if (system "cp $cvmfs_root/packages/$package/$version/setup . 2>&1 >/dev/null") {
      my $retry = 0;
      require LWP::UserAgent;
      my $agent = new LWP::UserAgent;
      $agent->env_proxy();
      my $resp = $agent->get($url);
      while ($resp->is_error()) {
         if ($retry++ < $retries) {
            sleep(10<<$retry);
            $resp = $agent->get($url);
            next;
         }
         warn "install_perl_package error - unable to get setup script",
              " $url from server, giving up after $retry retries.\n";
         warn "LWP::UserAgent returned error ",$resp->message(),"\n";
         chdir $top_level_dir;
         return $packages{$package_name}=0;
      }
      open my $SETUP, ">setup" or die $!;
      print $SETUP $resp->content;
      close $SETUP;
   }
   check_system_environment("setup");
   if (system "./setup >setup.env") {
      if (!install_new_package($url)) {
         warn "install_perl_package error - unable to install package",
              " $package, giving up.\n";
         chdir $top_level_dir;
         return $packages{$package_name}=0;
      }
   }
   update_shell_environment("setup.env");
   delete $ENV{"XERCES_FORCE_LIBRARY_BITS"};

   # must load it manually here, because it is not in the normal lib areas
   # and trying to update LD_LIBRARY_PATH is futile at run time

   require "DynaLoader.pm";
   DynaLoader::dl_load_file("$ENV{XERCESCROOT}/lib/libxerces-c.so.27");

   chdir $top_level_dir;
   return $packages{$package_name}=1;
}

sub setup_vdt_environment
{
   my $top_level_dir = `pwd`;
   chop $top_level_dir;
   my $pdir = "packages/$vdt_package";
   if (-d $pdir) {
      chdir $pdir;
   }
   else {
      my @pdir = split /\//, $pdir;
      foreach my $dir (@pdir) {
         mkdir($dir,0755) if (!-d $dir);
         chdir $dir;
      }
   }
   system "rm -f setup*";
   my $url = "$package_server_url/$vdt_package/setup";
   unlink "setup";
   if (system "cp $cvmfs_root/packages/$vdt_package/setup . 2>&1 >/dev/null") {
      if (system "wget $url 2>/dev/null") {
         warn "gridmake error - unable to download vdt setup\n";
         exit -1;
      }
   }
   check_system_environment("setup");
   if (system "./setup >setup.env") {
      if (!install_new_package($url)) {
         warn "setup_package_environment error - unable to install package",
              " $vdt_package, giving up.\n";
         exit -1;
      }
   }
   update_shell_environment("setup.env");
   chdir $top_level_dir;
   if (system "which srmls >/dev/null") {
      warn "gridmake error - vdt set up, but no srmls command found!\n";
      exit -1;
   }
}

sub check_system_environment
{
   my $setup = shift;
   my $thisdir = `pwd`;
   chop $thisdir;
   my @thisdir = split /\//, "$thisdir/$setup";
   my $sname = pop @thisdir;
   my $vname = pop @thisdir;
   my $pname = pop @thisdir;
   my $tname = pop @thisdir;
   chdir join "/", @thisdir;
   open my $DEP, "$tname/$pname/$vname/$sname" or die;
   while (<$DEP>) {
      if (/^# *depends on +([^ ]+)/) {
         my $systemdep = $1;
         chop $systemdep;
         #print  "Package $pname/$vname depends on system",
         #       " package $systemdep, installing that first.\n";
         if (!setup_system_package($systemdep)) {
            warn "gridmake error - unable to configure system package",
                 " $systemdep, system environment check failed!\n";
            exit -1;
         }
      }
   }
   close $DEP;
   chdir $thisdir;
   chmod 0755, $setup;
}

sub setup_system_package
{
   my $packpath = shift;
   my $redhat_release = 6;
   open my $REL, "/etc/redhat-release";
   if (defined $REL) {
      my $line = <$REL>;
      if ($line =~ / 5.[0-9]*/) {
         $redhat_release = 5;
      }
      close $REL;
   }
   if ($packpath !~ /\//) {
      my $versions = "versions-$redhat_release";
      unlink $versions;
      my $url = "$package_server_url/$packpath/$versions";
      if (system "cp $cvmfs_root/packages/$packpath/$versions . 2>&1 >/dev/null") {
         if (system "wget $url 2>/dev/null") {
            warn "gridmake error - unable to download $url\n";
            exit -1;
         }
      }
      open my $DEF, $versions or die;
      my $version;
      while (<$DEF>) {
         $version = $_;
         chop $version;
      }
      close $DEF;
      unlink $versions;
      if (defined $version) {
         $packpath = "$packpath/$version";
      }
      else {
         warn "gridmake error - no versions found for package $packpath\n";
         exit -1;
      }
   }
   if (exists $packages{$packpath}) {
      return $packages{$packpath};
   }
   my $top_level_dir = `pwd`;
   chop $top_level_dir;
   my $package_path = "packages/$packpath";
   my @package_path = split /\//, $package_path;
   for (my $i=0; $i<@package_path; ++$i) {
      if (!-d $package_path[$i]) {
         mkdir($package_path[$i],0755);
      }
      chdir $package_path[$i];
   }
   my $url = "$package_server_url/$packpath/setup";
   unlink "setup";
   if (system "cp $cvmfs_root/packages/$packpath/setup . 2>&1 >/dev/null") {
      if (system "wget $url 2>/dev/null") {
         warn "gridmake error - unable to download $url\n";
         exit -1;
      }
   }
   check_system_environment("setup");
   if (system "./setup >setup.env") {
      if (!install_new_package($url)) {
         warn "gridmake error - unable to install system package",
              " $packpath, giving up.\n";
         exit -1;
      }
   }
   update_shell_environment("setup.env");
   chdir $top_level_dir;
   return $packages{$packpath}=1;
}