Index: trunk/ippScripts/scripts/sc_prepare_chip.pl =================================================================== --- trunk/ippScripts/scripts/sc_prepare_chip.pl (revision 36583) +++ trunk/ippScripts/scripts/sc_prepare_chip.pl (revision 36583) @@ -0,0 +1,509 @@ +#! /usr/bin/env perl + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); +use DateTime; +use Data::Dumper; + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +# Hard coded values +my $remote_root = '/scratch3/watersc1/'; # Far side destination base location +my $threads = 2; # How many threads are we going to use? +my $job_cost = 150 / 60 / 60; # Estimate of how long a job runs, in hours. +my $proc_per_node = 24; # processors per node +my $min_nodes = 1; # smallest allocation to ask for +my $max_nodes = 1000; # largest allocation to ask for +my $min_time = 1; # shortest allocation to ask for +my $max_time = 8; # longest allocation to ask for + +# We need to ensure we only ever try to transfer a file once. +my %file_filter = (); + +# Look for programs we need +my $missing_tools; +my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); +my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); +my $detselect= can_run('detselect') or (warn "Can't find detselect" and $missing_tools = 1); +my $remotetool = can_run('remotetool') or (warn "Can't find remotetool" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + +# Options +my ($exp_id,$exp_name,$remote_id,$chip_id,$detrends,$camera,$dbname,$verbose,$path_base,$no_update); +GetOptions( + 'remote_id=s' => \$remote_id, + 'camera|c=s' => \$camera, + 'dbname|d=s' => \$dbname, + 'path_base=s' => \$path_base, + 'no_update' => \$no_update, + 'verbose' => \$verbose, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --camera --dbname --path_base", -exitval => 3) unless + defined($remote_id) and + defined($camera) and + defined($path_base) and + defined($dbname); +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $exp_id); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# +# Step 1: Get a list of the components that make up this remoteRun + +# SHould this call listrun to ensure we're in state new? +my $rt_cmd = "$remotetool -listcomponent -remote_id $remote_id"; +$rt_cmd .= " -dbname $dbname " if defined($dbname); + +my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $rt_cmd, verbose => $verbose); +unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("Unable to run chiptool to determine stage parameters.", + $remote_id,$error_code); +} +my $compData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine component information.", + $remote_id,$PS_EXIT_PROG_ERROR); +my $compData2= parse_md_list($compData); + +# +# Step 1a: Load up the catalog of detrends +# Detrend concept holders +my %detrends = (); +my %det_types = ('MASK' => '-mask', + 'FLAT' => '-flat', + 'DARK' => '-dark', + 'VIDEODARK' => '-dark', + 'LINEARITY' => '-linearity', + 'FRINGE' => '-fringe', + 'NOISEMAP' => '-noisemap'); + +foreach my $det_type (keys (%det_types)) { + my $dt_cmd = "$detselect -show -camera $camera -det_type $det_type "; + $dt_cmd .= " -dbname $dbname " if defined($dbname); + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $dt_cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("UNable to run detselect to determine detrend catalog", + $remote_id,$error_code); + } + my $detData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine detrend information.", + $remote_id,$PS_EXIT_PROG_ERROR); + my $detData2= parse_md_list($detData); + + # Data structure for this: + # $detrend{NAME} = \@list_of_detselect_shows + # $detrend{NAME}[0] = \%hash_of_detselect_constraint_results (first element) + # $detrend{NAME}[0]{class_id} = uri + + # At this point, I have the list of detselect shows, assign it + $detrends{$det_type} = $detData2; + + for (my $dd = 0; $dd <= $#{ @{ $detrends{$det_type} } }; $dd++) { + my $det_id = ${ $detrends{$det_type} }[$dd]->{det_id}; + my $det_iter=${ $detrends{$det_type} }[$dd]->{iteration}; + + my $detselect_command2 = "detselect -select "; + $detselect_command2 .= " -det_id $det_id "; + $detselect_command2 .= " -iteration $det_iter "; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $detselect_command2, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("No valid detrend available for this image: $det_type $det_id $det_iter", + $chip_id,$error_code); + } + + my $detImfile = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Could not parse detrend information for this image: $det_type $det_id $det_iter", + $chip_id,$error_code); + my $detImfile2= parse_md_list($detImfile); + foreach $detImfile (@$detImfile2) { + my $class_id = $detImfile->{class_id}; + my $duri = $detImfile->{uri}; + + ${ $detrends{$det_type} }[$dd]->{$class_id} = $duri; + } + } +} + +#print Dumper(%detrends); + + +# +# Step 1b: Open output files +my $uri_command = $path_base . ".cmd"; +my $uri_transfer= $path_base . ".transfer"; +my $uri_check = $path_base . ".check"; +my $uri_config = $path_base . ".config"; + +my $disk_command = $ipprc->file_resolve($uri_command,1); +my $disk_transfer= $ipprc->file_resolve($uri_transfer,1); +my $disk_check = $ipprc->file_resolve($uri_check,1); +my $disk_config = $ipprc->file_resolve($uri_config,1); + +my (undef, $remote_config) = uri_convert($uri_config); # Needs to be done after we've created it. + +open(TRANSFER, ">$disk_transfer") || &my_die("Couldn't open file? $disk_transfer",$chip_id,$PS_EXIT_SYS_ERROR); +open(CHECK, ">$disk_check") || &my_die("Couldn't open file? $disk_check",$chip_id,$PS_EXIT_SYS_ERROR); +open(CONFIG, ">$disk_config") || &my_die("Couldn't open file? $disk_config",$chip_id,$PS_EXIT_SYS_ERROR); + +# +# Step 2: Iterate over all componenets in this remote run. +my $job_index = 0; +foreach my $compEntry (@$compData2) { + + my $chip_id = $compEntry->{stage_id}; + +# Get exposure level information from the chipRun we're working from. + my $command = "$chiptool -listrun -chip_id $chip_id "; + $command .= " -dbname $dbname " if defined($dbname); + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("Unable to run chiptool to determine stage parameters.", + $chip_id,$error_code); + } + +# Parse chipRun level data to determine detrend information + my %detrends_to_use = (); + { + my $chipData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to determine chip component information.", + $chip_id,$PS_EXIT_PROG_ERROR); + my $chipData2= parse_md_list($chipData); + my $chipEntry = ${ $chipData2 }[0]; + + my $exp_id = $chipEntry->{exp_id}; + my $filter = $chipEntry->{filter}; + my $altfilt= $filter; + $altfilt =~ s/.00000//; + my $dateobs= $chipEntry->{dateobs}; + my ($date, $time) = split /T/, $dateobs; + my ($year,$month,$day) = split /-/, $date; + my ($hour,$minute,$second) = split /:/, $time; #/; + my $dateobs_obj = DateTime->new(year => $year, month => $month, day => $day, hour => $hour, minute => $minute, second => $second); + + foreach my $det_type (%detrends) { + if (($filter !~ /y/)&&($det_type eq 'FRINGE')) { next; } # We can skip fringe for all but y + + foreach my $det_obj (@{ $detrends{$det_type} }) { # Iterate over the available options + if (defined($det_obj->{filter})) { + if (($det_obj->{filter} ne $filter)&&($det_obj->{filter} ne $altfilt)) { + next; # Skip detrends with a filter that we can't use. + } + } + if (defined($det_obj->{time_begin})) { + if (DateTime->compare($dateobs_obj,$det_obj->{time_begin}) == -1) { + next; # Skip detrends that come into effect after this exposure (d1 < d2) + } + } + if (defined($det_obj->{time_end})) { + if (DateTime->compare($dateobs_obj,$det_obj->{time_end}) == 1) { + next; # Skip detrends that stop working before this exposure (d1 > d2) + } + } + $detrends_to_use{$det_type} = $det_obj; + last; + } + } + + +# if ($filter eq 'y.00000') { +# $det_types{'FRINGE'} = '-fringe'; +# } +# $filter =~ s/.00000//; # The database doesn't have the trailing zeros, and the query isn't a like. +# foreach my $det (keys %det_types) { +# my $detselect_command = "detselect -search "; +# $detselect_command .= " -det_type $det "; +# $detselect_command .= " -inst $camera " if defined($camera); +# $detselect_command .= " -filter $filter " if ($det eq 'FLAT'); +# $detselect_command .= " -time $dateobs "; + +# ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = +# run(command => $detselect_command, verbose => $verbose); +# unless ($success) { +# $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + +# &my_die("Unable to run dettool to obtain detrend information: $det $camera $filter", +# $chip_id,$error_code); +# } + +# my $detExp = $mdcParser->parse(join "", @$stdout_buf) or +# &my_die("Unable to parse detrend information: $det $camera $filter", +# $chip_id,$error_code); +# my $detExp2= parse_md_list($detExp); + +# foreach $detExp (@$detExp2) { +# my $det_id = $detExp->{det_id}; +# my $iteration = $detExp->{iteration}; +# $detrends{$det}{ID} = $det_id; +# $detrends{$det}{ITER}= $iteration; +# } +# } + } +# +# Step 3: Iterate over the sub-components +# Iterate over the chipProcessedImfile level data. + my $reg_command = "$chiptool -pendingimfile "; + $reg_command .= " -chip_id $chip_id " if defined($chip_id); + $reg_command .= " -dbname $dbname " if defined($dbname); + + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $reg_command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + + &my_die("Unable to run chiptool -pendingimfile", + $chip_id,$error_code); + } + + my $chipData = $mdcParser->parse(join "", @$stdout_buf) or + &my_die("Unable to parse chiptool -pendingimfile information.", + $chip_id,$error_code); + my $chipData2= parse_md_list($chipData); + + + foreach my $chipEntry (@$chipData2) { + # Get information we need to pass to ppImage + my $uri = $chipEntry->{uri}; + my $class_id = $chipEntry->{class_id}; + my $video_cells = $chipEntry->{video_cells}; + my $reduction = $chipEntry->{reduction}; + my $exp_tag = $chipEntry->{exp_tag}; + my $workdir = $chipEntry->{workdir}; + my $chip_imfile_id = $chipEntry->{chip_imfile_id}; + + # Process the image and burntool table + my (undef,$remote_uri) = uri_to_outputs($uri); + my $btt = $uri; + $btt =~ s/fits$/burn.tbl/; + my (undef,$remote_btt) = uri_to_outputs($btt); + + # Initialize the ppI command + my $ppImage_command = "ppImage -file $remote_uri"; + $ppImage_command .= " -burntool $remote_btt "; + + # Add detrend information to the command line +# foreach my $det (keys %detrends) { +# my $det_id = $detrends{$det}{ID}; +# my $det_iter = $detrends{$det}{ITER}; +# my $det_code = $det_types{$det}; + +# if ((($video_cells)&&($det eq 'DARK'))|| +# ((!$video_cells)&&($det eq 'VIDEODARK'))) { +# next; +# } + +# my $detselect_command2 = "detselect -select "; +# $detselect_command2 .= " -det_id $det_id "; +# $detselect_command2 .= " -iteration $det_iter "; +# $detselect_command2 .= " -class_id $class_id "; +# ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = +# run(command => $detselect_command2, verbose => $verbose); +# unless ($success) { +# $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + +# &my_die("No valid detrend available for this image: $det $det_id $det_iter $class_id", +# $chip_id,$error_code); +# } + +# my $detImfile = $mdcParser->parse(join "", @$stdout_buf) or +# &my_die("Could not parse detrend information for this image: $det $det_id $det_iter $class_id", +# $chip_id,$error_code); +# my $detImfile2= parse_md_list($detImfile); +# foreach $detImfile (@$detImfile2) { +# my $duri = $detImfile->{uri}; +# my (undef, $remote_det_uri) = uri_to_outputs($duri); +# $ppImage_command .= " $det_code $remote_det_uri "; +# } +# } + + # Add detrend information to the command line + foreach my $det (keys %detrends_to_use) { + if ((($video_cells)&&($det eq 'DARK'))|| + ((!$video_cells)&&($det eq 'VIDEODARK'))) { + next; + } + my $det_code = $det_types{$det}; + my $duri = $detrends_to_use{$det}->{$class_id}; + my (undef, $remote_det_uri) = uri_to_outputs($duri); + $ppImage_command .= " $det_code $remote_det_uri "; + } + + + # Add output root + my $ipp_outroot = "${workdir}/${exp_tag}/${exp_tag}.ch.${chip_id}"; + my $remote_outroot = uri_local_to_remote($ipp_outroot); + $ppImage_command .= " $remote_outroot "; + print STDERR "$remote_outroot $ipp_outroot\n"; + # Complete reduction information. + $reduction = 'DEFAULT' unless defined $reduction; + my $recipe_ppImage = $ipprc->reduction($reduction, 'CHIP_PPIMAGE'); # Recipe to use for ppImage + my $recipe_psphot = $ipprc->reduction($reduction, 'CHIP_PSPHOT'); # Recipe to use for psphot + + $ppImage_command .= " -recipe PPIMAGE $recipe_ppImage "; + $ppImage_command .= " -recipe PSPHOT $recipe_psphot "; + $ppImage_command .= " -recipe PPSTATS CHIPSTATS -stats ${remote_outroot}.${class_id}.stats "; + $ppImage_command .= " -threads $threads "; + $ppImage_command .= " -chip_imfile_id $chip_imfile_id "; + $ppImage_command .= " -tracedest ${remote_outroot}.${class_id}.trace "; + $ppImage_command .= " -log ${remote_outroot}.${class_id}.log "; + + print CONFIG "$ppImage_command\n"; + $job_index++; + } +} +close(CONFIG); +close(TRANSFER); +close(CHECK); + +# +# Construct the moab command last, so we can use the job_index counter to estimate resources. Somehow. +my $proc_need = $job_index * $threads; # how many total processors do we need? +my $node_need = $proc_need / $proc_per_node; # this equals how many nodes? +my $time_need = $job_index * $job_cost; # How many seconds will this take? + +my $fill_factor = 0.8; # This is the factor of how much of the time allocation we'd like to fill +my ($time_req,$node_req); +if ($node_need * $job_cost < $fill_factor * $min_nodes * $min_time) { + $time_req = $min_time; + $node_req = $min_nodes; +} +elsif ($node_need * $job_cost > $fill_factor * $max_nodes * $max_time) { + $time_req = $max_time; + $node_req = $max_nodes; + print STDERR "You've requested the construction of a bundle that appears to need $node_need nodes and $job_cost time per job. This exceeds the max limits ($max_nodes, $max_time). Using those max values instead. Good luck.\n"; +} +else { + $time_req = int(($node_need * $job_cost) / ($fill_factor * $max_nodes)) + 1; + $node_req = int(($node_need * $job_cost) / ($fill_factor * $time_req)) + 1; +} + +open(COMMAND, ">$disk_command") || &my_die("Couldn't open file? $disk_command",$chip_id,$PS_EXIT_SYS_ERROR); +print COMMAND "#!/bin/tcsh\n"; +print COMMAND "##### Moab controll lines\n"; +#print COMMAND "#MSUB -l nodes=60:ppn=2,walltime=1:00:00\n"; ## CHECK RESOURCES +print COMMAND "#MSUB -l nodes=${node_req}:ppn=${proc_per_node},walltime=${time_req}:00:00\n"; ## CHECK RESOURCES +print COMMAND "#MSUB -j oe\n"; +print COMMAND "#MSUB -V\n"; +print COMMAND "#MSUB -o ${remote_root}chip.${remote_id}.out\n"; +print COMMAND "date\n"; +#print COMMAND 'id=$SLURM_JOB_ID' . "\n"; +#print COMMAND 'SLURM_NNODES=$SLURM_JOB_NUM_NODES' . "\n"; +print COMMAND 'srun -n $SLURM_JOB_NUM_NODES -m cyclic -l /bin/hostname | sort -n | awk \'{printf "%s\n", $2}\' > hosts.${SLURM_JOB_ID}' . "\n"; +print COMMAND "${remote_root}/stask_chip.py $remote_config " . 'hosts.${SLURM_JOB_ID} 1' . "\n"; +#print COMMAND "srun -n2 -l --multi-prog $remote_config\n"; +print COMMAND "validate_processing.pl ${remote_root}chip.${remote_id}.out\n"; +print COMMAND "date\n"; +close(COMMAND); + + +## We're done here. The execution and handling are done elsewhere. +# Quick review: +# new -> pending -> run -> full +# auth +unless($no_update) { + my $command = "remotetool -updaterun -remote_id $remote_id "; + $command .= " -set_state pending "; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); +} + + + + + + +sub uri_convert { + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + my_die(); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs { + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert( $neb_uri ); + + unless (exists($file_filter{$neb_uri})) { + $file_filter{$neb_uri} = 1; + print TRANSFER "$ipp_disk\n"; + print CHECK "$remote_disk\n"; + } + return($ipp_disk,$remote_disk); +} + +sub uri_local_to_remote { + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub uri_remote_to_local { + # This needs to replace the remote root directory with the nebulous tag. + my $remote_uri = shift; + $remote_uri =~ s%${remote_root}%%; + my $local_uri = "neb:///" . $remote_uri; + + return($local_uri); +} +sub my_die { + my $msg = shift; + my $id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $id and not $no_update) { + my $command = "remotetool -updaterun -stage_id $id"; + $command .= " -fault $exit_code " if defined $exit_code; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} + Index: trunk/ippScripts/scripts/sc_remote_exec.pl =================================================================== --- trunk/ippScripts/scripts/sc_remote_exec.pl (revision 36583) +++ trunk/ippScripts/scripts/sc_remote_exec.pl (revision 36583) @@ -0,0 +1,385 @@ +#!/usr/bin/env perl + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use File::Basename; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + +# Hard coded values +my $DMZ_HOST = 'wtrw'; +my $SEC_HOST = 'mu-fe'; +my $IPP_PATH = '/turquoise/usr/projects/cosmo/mswarren/ipp/'; +my $remote_root = '/scratch3/watersc1/'; + +# tools +my $missing_tools; +my $ssh = can_run('ssh') or (warn "Can't find ssh" and $missing_tools = 1); +my $scp = can_run('scp') or (warn "Can't find scp" and $missing_tools = 1); +my $remotetool = can_run('echo') or (warn "Can't find remotetool" and $missing_tools = 1); + +if ($missing_tools) { + warn("Can't find required tools."); + exit($PS_EXIT_CONFIG_ERROR); +} + + +# Options +my ($remote_id,$path_base,$policy,$poll,$job_id,$dbname,$verbose,$no_update,$camera); + +GetOptions( + 'remote_id=s' => \$remote_id, + 'job_id=s' => \$job_id, + 'path_base=s' => \$path_base, + 'policy=s' => \$policy, + 'poll' => \$poll, + 'camera=s' => \$camera, + 'dbname=s' => \$dbname, + 'verbose' => \$verbose, + 'no_update' => \$no_update, + ) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --remote_id --path_base", -exitval => 3) unless + defined($path_base) and + defined($remote_id); + +my $ipprc = PS::IPP::Config->new( $camera ) or my_die( "Unable to set up", $remote_id); + +my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + +# Phase 1: See if we can actually do anything. +# If the link is down, there's no benefit in trying to do anything else. +&check_ssh_connection(); + +print "passed authentication challenge.\n"; + +# These are operations we only need to do on the first call, not on subsequent poll operations. +unless ($poll) { +# Phase 2: Ensure files are in place: +# Copy command files + my @files = (); + + my $uri_command = $path_base . ".cmd"; + my $uri_transfer= $path_base . ".transfer"; + my $uri_check = $path_base . ".check"; + my $uri_config = $path_base . ".config"; + + my $disk_command = $ipprc->file_resolve($uri_command); + my $disk_transfer= $ipprc->file_resolve($uri_transfer); + my $disk_check = $ipprc->file_resolve($uri_check); + my $disk_config = $ipprc->file_resolve($uri_config); + + scp_put($disk_command,uri_local_to_remote($uri_command)); + scp_put($disk_transfer,uri_local_to_remote($uri_transfer)); + scp_put($disk_check,uri_local_to_remote($uri_check)); + scp_put($disk_config,uri_local_to_remote($uri_config)); + +# Run check command + my (undef,$remote_check) = uri_convert($uri_check); + my $ssh_check_stdout = ssh_exec_command("${remote_root}/sc_validate_files.pl --check_list $remote_check"); + +# Parse stdout for files to transfer. + if ($#{ $ssh_check_stdout } != -1) { # There were files not found. + # Someone was missing. Use the check and transfer lists to identify the local version, and send it. + # What was missing? + my %missing_files = (); + foreach my $l (split /\n/, (join '', @$ssh_check_stdout)) { + print "Missing!: $l\n"; + $missing_files{$l} = 1; + } + + # Do we have that file? + my @check_files = (); + open(CHECK,$disk_check); + while() { + chomp; + push @check_files, $_; + } + close(CHECK); + + my @trans_files = (); + open(TRANS,$disk_transfer); + while() { + chomp; + push @trans_files, $_; + } + close(TRANS); + + if ($#trans_files != $#check_files) { &my_die("The transfer file list and check file list are different sizes", + $remote_id,$PS_EXIT_DATA_ERROR); } + + for (my $i = 0; $i <= $#check_files; $i++) { + if (exists($missing_files{$check_files[$i]})) { + if ($trans_files[$i] ne "REMOTE_ONLY") { + scp_put($trans_files[$i],"$check_files[$i]"); + } + else { + &my_die("There is a file that should be there, but the file isn't there, and I don't have a copy of that file here. The file is: $check_files[$i]", + $remote_id,$PS_EXIT_DATA_ERROR); # This seems a bit harsh. + } + } + } + } + + +# Run real command + my (undef,$remote_command) = uri_convert($uri_command); + my $ssh_exec_stdout = ssh_exec_command("msub -V $remote_command"); + if ($#{ $ssh_exec_stdout } != -1) { # Parse the output + $job_id = ${ $ssh_exec_stdout }[0]; + chomp($job_id); + $job_id =~ s/\s+//g; + } + + unless(defined($job_id)) { # If we don't have a job_id from this command, it didn't run correctly. + &my_die("No job_id returned. Sorry.",$remote_id,$PS_EXIT_PROG_ERROR); + } + + # Notify the database that this entry is currently running. + my $command = "$remotetool -updaterun -remote_id $remote_id "; + $command .= " -set_state run "; + $command .= " -set_job_id $job_id "; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + +} + +# Check that we have a valid job_id, either from the command line, or from the msub command. +unless(defined($job_id)) { # If we don't have a job_id from this command, it didn't run correctly. + &my_die("No job_id returned. Sorry.",$remote_id,$PS_EXIT_PROG_ERROR); +} + + +# Poll the job status? +my $poll_count = 0; +my $poll_max = 5; +my $poll_sleep = 60; +my $poll_response = 0; +while (($poll_count < $poll_max)&&($poll_response != 1)&&($poll_response != -1)) { + if ($verbose) { + print "Polling code. Sleeping. $poll_count of $poll_max $poll_response\n"; + } + unless ($poll_count == 0) { + sleep($poll_sleep); + } + $poll_response = poll_job($job_id); + + if ($poll_response == 1) { # This job has completed + last; + } + elsif ($poll_response == -1) { # This job has an error + &my_die("The job exited incorrectly.",$remote_id, $PS_EXIT_PROG_ERROR); + } + $poll_count++; +} +if ($verbose) { + print "Stopped Polling code. $poll_count of $poll_max $poll_response\n"; +} +# Retrieve validation summary +my $fault = 0; + +exit(1); +# Read this as a metadata object +my $ssh_exec_stdout = ssh_exec_command("sc_validate_processing.pl ${path_base}.out"); +my $retrieveData = $mdcParser->parse(join "", @$ssh_exec_stdout); +my $retrieveData2= parse_md_list($retrieveData); + +foreach my $retrieveEntry (@$retrieveData2) { + my $process_fault = $retrieveEntry->{fault}; + my $dbcommand = $retrieveEntry->{dbcommand}; + my $filelist = $retrieveEntry->{filelist}; + + scp_get("${filelist}",${filelist}); + open(FL,${filelist}); + while() { + chomp; + my $f = $_; + scp_get("${f}",$f); + } + close(FL); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $dbcommand, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("The database command returned did not execute correctly. $dbcommand $process_fault", + $remote_id,$error_code); + } + + if ($process_fault != 0) { + $fault = 1; + } +} + +if (($policy ne 'ignore')&&($fault != 0)) { + &my_die("This job exited without all components finishing successfully. Halting.", + $remote_id,$fault,"halt"); +} +else { + print "This job exited without all components finishing successfully. $fault\n" if $fault; + &my_die("This job finished. Setting remote job to full.", + $remote_id,0,"full"); +} + +# Promote to finished. +&my_die(); # Not really, but I don't have the tool interface finished, so these are all just placeholders. +# Quick review: +# new -> pending -> run -> full +# auth + +# END PROGRAM + + +sub check_ssh_connection { + my $cmd = "$ssh -O check $DMZ_HOST"; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Authorization check failed.",$remote_id,0,'auth'); + +# my $update_command = "$remotetool -updaterun -remote_id $remote_id "; +# $update_command .= " -set_state auth "; +# $update_command .= " -dbname $dbname " if defined $dbname; +# system($update_command); +# exit(0); # This isn't an error. It's a state we monitor and move to automatically. + } +} + +sub scp_put { + my $file = shift; + my $destination = shift; + my $cmd = "$scp $file ${DMZ_HOST}:${SEC_HOST}:${destination}"; + + my $directory = dirname($destination); + ssh_exec_command("mkdir -p $directory"); + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die(); + } +} + +sub scp_get { + my $destination = shift; + my $file = shift; + + my $cmd = "$scp ${DMZ_HOST}:${SEC_HOST}:${destination} $file "; + + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die(); + } +} + +sub ssh_exec_command { + my $cmd = shift; + $cmd = "$ssh $DMZ_HOST ssh ${SEC_HOST} $cmd"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $cmd, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die(); + } + return ($stdout_buf); +} + +sub poll_job { + my $job_id = shift; + my $response_array = ssh_exec_command("checkjob -v $job_id"); + my $response = join "\n", @$response_array; + + if ($response =~ /State: Running/) { + return(0); + } + elsif ($response =~ /State: Completed/) { + return(1); + } + elsif ($response =~ /State: Idle/) { + return(-2); + } + else { + return(-1); + } +} + + +sub uri_convert { + my $neb_uri = shift; + my $ipp_disk= $ipprc->file_resolve( $neb_uri ); + my $remote_disk = $ipp_disk; + + unless(defined($ipp_disk)) { + my_die(); + } + + $remote_disk =~ s%^.*/%%; # Remove nebulous path + $remote_disk =~ s%^\d+\.%%; # Remove ins_id + $remote_disk =~ s%:%/%g; # Replace colons with directories + $remote_disk = "${remote_root}/${remote_disk}"; + return($ipp_disk,$remote_disk); +} + +sub uri_to_outputs { + my $neb_uri = shift; + my ($ipp_disk, $remote_disk) = uri_convert( $neb_uri ); + +# print TRANSFER "$ipp_disk\n"; +# print CHECK "$remote_disk\n"; + return($ipp_disk,$remote_disk); +} + +sub uri_local_to_remote { + # This needs to replace the nebulous tag with the remote root. + my $local_uri = shift; + $local_uri =~ s%^.*?/%%; # neb:/ + $local_uri =~ s%^.*?/%%; # / + $local_uri =~ s%^.*?/%%; # @HOST@.0/ + my $remote_uri = "${remote_root}/" . $local_uri; + + return($remote_uri); +} + +sub uri_remote_to_local { + # This needs to replace the remote root directory with the nebulous tag. + my $remote_uri = shift; + $remote_uri =~ s%${remote_root}%%; + my $local_uri = "neb:///" . $remote_uri; + + return($local_uri); +} +sub my_die { + my $msg = shift; + my $id = shift; + my $exit_code = shift; + my $exit_state = shift; + + $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code; + + carp($msg); + + if (defined $id and not $no_update) { + my $command = "$remotetool -updaterun -stage_id $id"; + $command .= " -fault $exit_code " if defined $exit_code; + $command .= " -set_state $exit_state " if defined $exit_state; + $command .= " -dbname $dbname " if defined $dbname; + + system($command); + } + + exit($exit_code); +} Index: trunk/ippScripts/scripts/sc_validate_files.pl =================================================================== --- trunk/ippScripts/scripts/sc_validate_files.pl (revision 36583) +++ trunk/ippScripts/scripts/sc_validate_files.pl (revision 36583) @@ -0,0 +1,68 @@ +#! /usr/bin/env perl + +use Carp; +use warnings; +use strict; + +use File::Basename; +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +# Hard coded values +my $remote_root = '/scratch3/watersc1/'; +my $host_iter = 0; +my @ipp_hosts = ('166.122.172.41','166.122.172.42','166.122.172.43','166.122.172.44', + '166.122.172.45','166.122.172.46','166.122.172.47','166.122.172.48', + '166.122.172.49','166.122.172.50','166.122.172.51','166.122.172.52','166.122.172.53'); +my @remote_hosts = ('mu-fe1.lanl.gov','mu-fe2.lanl.gov','mu-fe3.lanl.gov','mu-fe4.lanl.gov'); +my $check_list; +my $transfer_list; +GetOptions( + 'check_list=s' => \$check_list, + 'transfer_list=s' => \$transfer_list + ) or pod2usage( 2 ); + +my @check_files = (); +my @transfer_files = (); + +open(LIST,$check_list); +while() { + chomp; + push @check_files, $_; +} +close(LIST); +open(LIST2,$transfer_list); +while() { + chomp; + push @transfer_files, $_; +} +close(LIST2); + +unless ($#check_files == $#transfer_files) { + die "The two lists are of unequal length."; +} + +for (my $i = 0; $i <= $#check_files; $i++) { + my $file = $check_files[$i]; + unless (-e $file) { + print "$file\n"; + my $fetch_file = $transfer_files[$i]; + my $directory = dirname($file); + unless (-d $directory) { + system("mkdir -p $directory"); + } + + scp_pull($fetch_file,$file); + } +} + +sub scp_pull { + my $remote_file = shift; + my $local_file = shift; + + my $host = $ipp_hosts[$host_iter]; + $host_iter++; + if ($host_iter > $#ipp_hosts) { $host_iter = 0; } + system("scp ${host}:${remote_file} ${local_file}"); +} Index: trunk/ippScripts/scripts/sc_validate_processing.pl =================================================================== --- trunk/ippScripts/scripts/sc_validate_processing.pl (revision 36583) +++ trunk/ippScripts/scripts/sc_validate_processing.pl (revision 36583) @@ -0,0 +1,79 @@ +#! /usr/bin/env perl + +use Carp; +use warnings; +use strict; + +use IPC::Cmd 0.36 qw( can_run run ); +use PS::IPP::Metadata::Config; +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config 1.01 qw( :standard ); + +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); + + +# Hard coded values +my $remote_root = '/scratch3/watersc1/'; + +my $command_output +GetOptions( + 'command_output=s' => \$command_output; + ) or pod2usage( 2 ); + +open(LIST,$command_output); +while() { + chomp; + + if ($_ =~ /ppImage/) { + my $base = (split /\s+/)[15]; # This is super fragile. + my $stats= $base . "." . $class_id . ".stats"; # no good idea how to get that. + my $command = ""; + if (-e $stats) { + my $stat_cmd = "ppStatsFromMetadata $stats - CHIP_IMFILE"; + ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); + &my_die("Unable to perform ppStatsFromMetadata: $error_code", $exp_id, $chip_id, $class_id, $error_code); + } + foreach my $line (@$stdout_buf) { + $cmdflags .= " $line"; + } + chomp $cmdflags; + + # Need to get all these parameters. + $command = "$chiptool -addprocessedimfile"; + $command .= " -exp_id $exp_id"; + $command .= " -chip_id $chip_id"; + $command .= " -class_id $class_id"; + $command .= " -uri $outputImage"; + $command .= " -path_base $outroot"; + $command .= " -magicked $magicked" if $magicked; + $command .= " -hostname $host" if defined $host; + $command .= " -dbname $dbname" if defined $dbname; + $command .= " $cmdflags"; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + + } + else { # This job failed permanently + $command = "$chiptool -addprocessedimfile"; + $command .= " -exp_id $exp_id"; + $command .= " -uri $outputImage" if defined $outputImage; + $command .= " -path_base $outroot"; + $command .= " -hostname $host" if defined $host; + $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400)); + $command .= " -chip_id $chip_id"; + $command .= " -class_id $class_id"; + $command .= " -fault $exit_code"; + $command .= " -dbname $dbname" if defined $dbname; + } + + +# if ($_ =~ /stask: error: .*: task .*: Exited with exit code/) { +# print " "; # This needs to be smarter. +# exit(1); +# } +} +close(LIST); +