2 # -*- mode: perl; perl-indent-level: 2; indent-tabs-mode: nil; -*-
6 crunch-job: Execute job steps, save snapshots as requested, collate output.
10 Obtain job details from Arvados, run tasks on compute nodes (typically
11 invoked by scheduler on controller):
13 crunch-job --job x-y-z --git-dir /path/to/repo/.git
15 Obtain job details from command line, run tasks on local machine
16 (typically invoked by application or developer on VM):
18 crunch-job --job '{"script_version":"/path/to/working/tree","script":"scriptname",...}'
20 crunch-job --job '{"repository":"https://github.com/curoverse/arvados.git","script_version":"master","script":"scriptname",...}'
28 If the job is already locked, steal the lock and run it anyway.
32 Path to a .git directory (or a git URL) where the commit given in the
33 job's C<script_version> attribute is to be found. If this is I<not>
34 given, the job's C<repository> attribute will be used.
38 Arvados API authorization token to use during the course of the job.
42 Do not clear per-job/task temporary directories during initial job
43 setup. This can speed up development and debugging when running jobs
48 UUID of the job to run, or a JSON-encoded job resource without a
49 UUID. If the latter is given, a new job object will be created.
53 =head1 RUNNING JOBS LOCALLY
55 crunch-job's log messages appear on stderr along with the job tasks'
56 stderr streams. The log is saved in Keep at each checkpoint and when
59 If the job succeeds, the job's output locator is printed on stdout.
61 While the job is running, the following signals are accepted:
65 =item control-C, SIGINT, SIGQUIT
67 Save a checkpoint, terminate any job tasks that are running, and stop.
71 Save a checkpoint and continue.
75 Refresh node allocation (i.e., check whether any nodes have been added
76 or unallocated) and attributes of the Job record that should affect
77 behavior (e.g., cancel job if cancelled_at becomes non-nil).
85 use POSIX ':sys_wait_h';
86 use POSIX qw(strftime);
87 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
91 use Digest::MD5 qw(md5_hex);
97 use File::Path qw( make_path remove_tree );
99 use constant TASK_TEMPFAIL => 111;
100 use constant EX_TEMPFAIL => 75;
102 $ENV{"TMPDIR"} ||= "/tmp";
103 unless (defined $ENV{"CRUNCH_TMP"}) {
104 $ENV{"CRUNCH_TMP"} = $ENV{"TMPDIR"} . "/crunch-job";
105 if ($ENV{"USER"} ne "crunch" && $< != 0) {
106 # use a tmp dir unique for my uid
107 $ENV{"CRUNCH_TMP"} .= "-$<";
111 # Create the tmp directory if it does not exist
112 if ( ! -d $ENV{"CRUNCH_TMP"} ) {
113 make_path $ENV{"CRUNCH_TMP"} or die "Failed to create temporary working directory: " . $ENV{"CRUNCH_TMP"};
116 $ENV{"JOB_WORK"} = $ENV{"CRUNCH_TMP"} . "/work";
117 $ENV{"CRUNCH_INSTALL"} = "$ENV{CRUNCH_TMP}/opt";
118 $ENV{"CRUNCH_WORK"} = $ENV{"JOB_WORK"}; # deprecated
119 mkdir ($ENV{"JOB_WORK"});
128 my $docker_bin = "/usr/bin/docker.io";
129 GetOptions('force-unlock' => \$force_unlock,
130 'git-dir=s' => \$git_dir,
131 'job=s' => \$jobspec,
132 'job-api-token=s' => \$job_api_token,
133 'no-clear-tmp' => \$no_clear_tmp,
134 'resume-stash=s' => \$resume_stash,
135 'docker-bin=s' => \$docker_bin,
138 if (defined $job_api_token) {
139 $ENV{ARVADOS_API_TOKEN} = $job_api_token;
142 my $have_slurm = exists $ENV{SLURM_JOB_ID} && exists $ENV{SLURM_NODELIST};
147 $main::ENV{CRUNCH_DEBUG} = 1;
151 $main::ENV{CRUNCH_DEBUG} = 0;
154 my $arv = Arvados->new('apiVersion' => 'v1');
163 if ($jobspec =~ /^[-a-z\d]+$/)
165 # $jobspec is an Arvados UUID, not a JSON job specification
166 $Job = api_call("jobs/get", uuid => $jobspec);
171 $Job = JSON::decode_json($jobspec);
176 # Make sure our workers (our slurm nodes, localhost, or whatever) are
177 # at least able to run basic commands: they aren't down or severely
180 if ($Job->{docker_image_locator}) {
181 $cmd = [$docker_bin, 'ps', '-q'];
183 Log(undef, "Sanity check is `@$cmd`");
184 srun(["srun", "--nodes=\Q$ENV{SLURM_NNODES}\E", "--ntasks-per-node=1"],
188 Log(undef, "Sanity check failed: ".exit_status_s($?));
191 Log(undef, "Sanity check OK");
194 my $User = api_call("users/current");
197 if (!$force_unlock) {
198 # Claim this job, and make sure nobody else does
199 eval { api_call("jobs/lock", uuid => $Job->{uuid}); };
201 Log(undef, "Error while locking job, exiting ".EX_TEMPFAIL);
210 map { croak ("No $_ specified") unless $Job->{$_} }
211 qw(script script_version script_parameters);
214 $Job->{'is_locked_by_uuid'} = $User->{'uuid'};
215 $Job->{'started_at'} = gmtime;
216 $Job->{'state'} = 'Running';
218 $Job = api_call("jobs/create", job => $Job);
220 $job_id = $Job->{'uuid'};
222 my $keep_logfile = $job_id . '.log.txt';
223 log_writer_start($keep_logfile);
225 $Job->{'runtime_constraints'} ||= {};
226 $Job->{'runtime_constraints'}->{'max_tasks_per_node'} ||= 0;
227 my $max_ncpus = $Job->{'runtime_constraints'}->{'max_tasks_per_node'};
229 my $gem_versions = `gem list --quiet arvados-cli 2>/dev/null`;
231 $gem_versions =~ s/^arvados-cli \(/ with arvados-cli Gem version(s) /;
232 chomp($gem_versions);
233 chop($gem_versions); # Closing parentheses
238 "running from " . ((-e $0) ? realpath($0) : "stdin") . $gem_versions);
240 Log (undef, "check slurm allocation");
243 # Should use $ENV{SLURM_TASKS_PER_NODE} instead of sinfo? (eg. "4(x3),2,4(x2)")
247 my $localcpus = 0 + `grep -cw ^processor /proc/cpuinfo` || 1;
248 push @sinfo, "$localcpus localhost";
250 if (exists $ENV{SLURM_NODELIST})
252 push @sinfo, `sinfo -h --format='%c %N' --nodes=\Q$ENV{SLURM_NODELIST}\E`;
256 my ($ncpus, $slurm_nodelist) = split;
257 $ncpus = $max_ncpus if $max_ncpus && $ncpus > $max_ncpus;
260 while ($slurm_nodelist =~ s/^([^\[,]+?(\[.*?\])?)(,|$)//)
263 if ($nodelist =~ /\[((\d+)(-(\d+))?(,(\d+)(-(\d+))?)*)\]/)
266 foreach (split (",", $ranges))
279 push @nodelist, map {
281 $n =~ s/\[[-,\d]+\]/$_/;
288 push @nodelist, $nodelist;
291 foreach my $nodename (@nodelist)
293 Log (undef, "node $nodename - $ncpus slots");
294 my $node = { name => $nodename,
298 foreach my $cpu (1..$ncpus)
300 push @slot, { node => $node,
304 push @node, @nodelist;
309 # Ensure that we get one jobstep running on each allocated node before
310 # we start overloading nodes with concurrent steps
312 @slot = sort { $a->{cpu} <=> $b->{cpu} } @slot;
315 $Job->update_attributes(
316 'tasks_summary' => { 'failed' => 0,
321 Log (undef, "start");
322 $SIG{'INT'} = sub { $main::please_freeze = 1; };
323 $SIG{'QUIT'} = sub { $main::please_freeze = 1; };
324 $SIG{'TERM'} = \&croak;
325 $SIG{'TSTP'} = sub { $main::please_freeze = 1; };
326 $SIG{'ALRM'} = sub { $main::please_info = 1; };
327 $SIG{'CONT'} = sub { $main::please_continue = 1; };
328 $SIG{'HUP'} = sub { $main::please_refresh = 1; };
330 $main::please_freeze = 0;
331 $main::please_info = 0;
332 $main::please_continue = 0;
333 $main::please_refresh = 0;
334 my $jobsteps_must_output_keys = 0; # becomes 1 when any task outputs a key
336 grep { $ENV{$1} = $2 if /^(NOCACHE.*?)=(.*)/ } split ("\n", $$Job{knobs});
337 $ENV{"CRUNCH_JOB_UUID"} = $job_id;
338 $ENV{"JOB_UUID"} = $job_id;
341 my @jobstep_todo = ();
342 my @jobstep_done = ();
343 my @jobstep_tomerge = ();
344 my $jobstep_tomerge_level = 0;
345 my $squeue_checked = 0;
346 my $latest_refresh = scalar time;
350 if (defined $Job->{thawedfromkey})
352 thaw ($Job->{thawedfromkey});
356 my $first_task = api_call("job_tasks/create", job_task => {
357 'job_uuid' => $Job->{'uuid'},
362 push @jobstep, { 'level' => 0,
364 'arvados_task' => $first_task,
366 push @jobstep_todo, 0;
372 must_lock_now("$ENV{CRUNCH_TMP}/.lock", "a job is already running here.");
375 my $build_script = handle_readall(\*DATA);
376 my $nodelist = join(",", @node);
377 my $git_tar_count = 0;
379 if (!defined $no_clear_tmp) {
380 # Clean out crunch_tmp/work, crunch_tmp/opt, crunch_tmp/src*
381 Log (undef, "Clean work dirs");
383 my $cleanpid = fork();
386 # Find FUSE mounts that look like Keep mounts (the mount path has the
387 # word "keep") and unmount them. Then clean up work directories.
388 # TODO: When #5036 is done and widely deployed, we can get rid of the
389 # regular expression and just unmount everything with type fuse.keep.
390 srun (["srun", "--nodelist=$nodelist", "-D", $ENV{'TMPDIR'}],
391 ['bash', '-ec', 'mount -t fuse,fuse.keep | awk \'($3 ~ /\ykeep\y/){print $3}\' | xargs -r -n 1 fusermount -u -z; sleep 1; rm -rf $JOB_WORK $CRUNCH_INSTALL $CRUNCH_TMP/task $CRUNCH_TMP/src* $CRUNCH_TMP/*.cid']);
396 last if $cleanpid == waitpid (-1, WNOHANG);
397 freeze_if_want_freeze ($cleanpid);
398 select (undef, undef, undef, 0.1);
400 Log (undef, "Cleanup command exited ".exit_status_s($?));
403 # If this job requires a Docker image, install that.
404 my ($docker_locator, $docker_stream, $docker_hash, $docker_limitmem);
405 if ($docker_locator = $Job->{docker_image_locator}) {
406 ($docker_stream, $docker_hash) = find_docker_image($docker_locator);
409 croak("No Docker image hash found from locator $docker_locator");
411 $docker_stream =~ s/^\.//;
412 my $docker_install_script = qq{
413 if ! $docker_bin images -q --no-trunc --all | grep -qxF \Q$docker_hash\E; then
414 arv-get \Q$docker_locator$docker_stream/$docker_hash.tar\E | $docker_bin load
417 my $docker_pid = fork();
418 if ($docker_pid == 0)
420 srun (["srun", "--nodelist=" . join(',', @node)],
421 ["/bin/sh", "-ec", $docker_install_script]);
426 last if $docker_pid == waitpid (-1, WNOHANG);
427 freeze_if_want_freeze ($docker_pid);
428 select (undef, undef, undef, 0.1);
432 croak("Installing Docker image from $docker_locator exited "
436 # Determine whether this version of Docker supports memory+swap limits.
437 srun(["srun", "--nodelist=" . $node[0]],
438 ["/bin/sh", "-ec", "$docker_bin run --help | grep -qe --memory-swap="],
440 $docker_limitmem = ($? == 0);
442 if ($Job->{arvados_sdk_version}) {
443 # The job also specifies an Arvados SDK version. Add the SDKs to the
444 # tar file for the build script to install.
445 Log(undef, sprintf("Packing Arvados SDK version %s for installation",
446 $Job->{arvados_sdk_version}));
447 add_git_archive("git", "--git-dir=$git_dir", "archive",
448 "--prefix=.arvados.sdk/",
449 $Job->{arvados_sdk_version}, "sdk");
453 if (!defined $git_dir && $Job->{'script_version'} =~ m{^/}) {
454 # If script_version looks like an absolute path, *and* the --git-dir
455 # argument was not given -- which implies we were not invoked by
456 # crunch-dispatch -- we will use the given path as a working
457 # directory instead of resolving script_version to a git commit (or
458 # doing anything else with git).
459 $ENV{"CRUNCH_SRC_COMMIT"} = $Job->{'script_version'};
460 $ENV{"CRUNCH_SRC"} = $Job->{'script_version'};
463 # Resolve the given script_version to a git commit sha1. Also, if
464 # the repository is remote, clone it into our local filesystem: this
465 # ensures "git archive" will work, and is necessary to reliably
466 # resolve a symbolic script_version like "master^".
467 $ENV{"CRUNCH_SRC"} = "$ENV{CRUNCH_TMP}/src";
469 Log (undef, "Looking for version ".$Job->{script_version}." from repository ".$Job->{repository});
471 $ENV{"CRUNCH_SRC_COMMIT"} = $Job->{script_version};
473 # If we're running under crunch-dispatch, it will have already
474 # pulled the appropriate source tree into its own repository, and
475 # given us that repo's path as $git_dir.
477 # If we're running a "local" job, we might have to fetch content
478 # from a remote repository.
480 # (Currently crunch-dispatch gives a local path with --git-dir, but
481 # we might as well accept URLs there too in case it changes its
483 my $repo = $git_dir || $Job->{'repository'};
485 # Repository can be remote or local. If remote, we'll need to fetch it
486 # to a local dir before doing `git log` et al.
489 if ($repo =~ m{://|^[^/]*:}) {
490 # $repo is a git url we can clone, like git:// or https:// or
491 # file:/// or [user@]host:repo.git. Note "user/name@host:foo" is
492 # not recognized here because distinguishing that from a local
493 # path is too fragile. If you really need something strange here,
494 # use the ssh:// form.
495 $repo_location = 'remote';
496 } elsif ($repo =~ m{^\.*/}) {
497 # $repo is a local path to a git index. We'll also resolve ../foo
498 # to ../foo/.git if the latter is a directory. To help
499 # disambiguate local paths from named hosted repositories, this
500 # form must be given as ./ or ../ if it's a relative path.
501 if (-d "$repo/.git") {
502 $repo = "$repo/.git";
504 $repo_location = 'local';
506 # $repo is none of the above. It must be the name of a hosted
508 my $arv_repo_list = api_call("repositories/list",
509 'filters' => [['name','=',$repo]]);
510 my @repos_found = @{$arv_repo_list->{'items'}};
511 my $n_found = $arv_repo_list->{'serverResponse'}->{'items_available'};
513 Log(undef, "Repository '$repo' -> "
514 . join(", ", map { $_->{'uuid'} } @repos_found));
517 croak("Error: Found $n_found repositories with name '$repo'.");
519 $repo = $repos_found[0]->{'fetch_url'};
520 $repo_location = 'remote';
522 Log(undef, "Using $repo_location repository '$repo'");
523 $ENV{"CRUNCH_SRC_URL"} = $repo;
525 # Resolve given script_version (we'll call that $treeish here) to a
526 # commit sha1 ($commit).
527 my $treeish = $Job->{'script_version'};
529 if ($repo_location eq 'remote') {
530 # We minimize excess object-fetching by re-using the same bare
531 # repository in CRUNCH_TMP/.git for multiple crunch-jobs -- we
532 # just keep adding remotes to it as needed.
533 my $local_repo = $ENV{'CRUNCH_TMP'}."/.git";
534 my $gitcmd = "git --git-dir=\Q$local_repo\E";
536 # Set up our local repo for caching remote objects, making
538 if (!-d $local_repo) {
539 make_path($local_repo) or croak("Error: could not create $local_repo");
541 # This works (exits 0 and doesn't delete fetched objects) even
542 # if $local_repo is already initialized:
543 `$gitcmd init --bare`;
545 croak("Error: $gitcmd init --bare exited ".exit_status_s($?));
548 # If $treeish looks like a hash (or abbrev hash) we look it up in
549 # our local cache first, since that's cheaper. (We don't want to
550 # do that with tags/branches though -- those change over time, so
551 # they should always be resolved by the remote repo.)
552 if ($treeish =~ /^[0-9a-f]{7,40}$/s) {
553 # Hide stderr because it's normal for this to fail:
554 my $sha1 = `$gitcmd rev-list -n1 ''\Q$treeish\E 2>/dev/null`;
556 # Careful not to resolve a branch named abcdeff to commit 1234567:
557 $sha1 =~ /^$treeish/ &&
558 $sha1 =~ /^([0-9a-f]{40})$/s) {
560 Log(undef, "Commit $commit already present in $local_repo");
564 if (!defined $commit) {
565 # If $treeish isn't just a hash or abbrev hash, or isn't here
566 # yet, we need to fetch the remote to resolve it correctly.
568 # First, remove all local heads. This prevents a name that does
569 # not exist on the remote from resolving to (or colliding with)
570 # a previously fetched branch or tag (possibly from a different
572 remove_tree("$local_repo/refs/heads", {keep_root => 1});
574 Log(undef, "Fetching objects from $repo to $local_repo");
575 `$gitcmd fetch --no-progress --tags ''\Q$repo\E \Q+refs/heads/*:refs/heads/*\E`;
577 croak("Error: `$gitcmd fetch` exited ".exit_status_s($?));
581 # Now that the data is all here, we will use our local repo for
582 # the rest of our git activities.
586 my $gitcmd = "git --git-dir=\Q$repo\E";
587 my $sha1 = `$gitcmd rev-list -n1 ''\Q$treeish\E`;
588 unless ($? == 0 && $sha1 =~ /^([0-9a-f]{40})$/) {
589 croak("`$gitcmd rev-list` exited "
591 .", '$treeish' not found. Giving up.");
594 Log(undef, "Version $treeish is commit $commit");
596 if ($commit ne $Job->{'script_version'}) {
597 # Record the real commit id in the database, frozentokey, logs,
598 # etc. -- instead of an abbreviation or a branch name which can
599 # become ambiguous or point to a different commit in the future.
600 if (!$Job->update_attributes('script_version' => $commit)) {
601 croak("Error: failed to update job's script_version attribute");
605 $ENV{"CRUNCH_SRC_COMMIT"} = $commit;
606 add_git_archive("$gitcmd archive ''\Q$commit\E");
609 my $git_archive = combined_git_archive();
610 if (!defined $git_archive) {
611 Log(undef, "Skip install phase (no git archive)");
613 Log(undef, "Warning: This probably means workers have no source tree!");
618 my $install_script_tries_left = 3;
619 for (my $attempts = 0; $attempts < 3; $attempts++) {
620 Log(undef, "Run install script on all workers");
622 my @srunargs = ("srun",
623 "--nodelist=$nodelist",
624 "-D", $ENV{'TMPDIR'}, "--job-name=$job_id");
625 my @execargs = ("sh", "-c",
626 "mkdir -p $ENV{CRUNCH_INSTALL} && cd $ENV{CRUNCH_TMP} && perl -");
628 $ENV{"CRUNCH_GIT_ARCHIVE_HASH"} = md5_hex($git_archive);
629 my ($install_stderr_r, $install_stderr_w);
630 pipe $install_stderr_r, $install_stderr_w or croak("pipe() failed: $!");
631 set_nonblocking($install_stderr_r);
632 my $installpid = fork();
633 if ($installpid == 0)
635 close($install_stderr_r);
636 fcntl($install_stderr_w, F_SETFL, 0) or croak($!); # no close-on-exec
637 open(STDOUT, ">&", $install_stderr_w);
638 open(STDERR, ">&", $install_stderr_w);
639 srun (\@srunargs, \@execargs, {}, $build_script . $git_archive);
642 close($install_stderr_w);
643 # Tell freeze_if_want_freeze how to kill the child, otherwise the
644 # "waitpid(installpid)" loop won't get interrupted by a freeze:
645 $proc{$installpid} = {};
647 # Track whether anything appears on stderr other than slurm errors
648 # ("srun: ...") and the "starting: ..." message printed by the
649 # srun subroutine itself:
650 my $stderr_anything_from_script = 0;
651 my $match_our_own_errors = '^(srun: error: |starting: \[)';
652 while ($installpid != waitpid(-1, WNOHANG)) {
653 freeze_if_want_freeze ($installpid);
654 # Wait up to 0.1 seconds for something to appear on stderr, then
655 # do a non-blocking read.
656 my $bits = fhbits($install_stderr_r);
657 select ($bits, undef, $bits, 0.1);
658 if (0 < sysread ($install_stderr_r, $stderr_buf, 8192, length($stderr_buf)))
660 while ($stderr_buf =~ /^(.*?)\n/) {
662 substr $stderr_buf, 0, 1+length($line), "";
663 Log(undef, "stderr $line");
664 if ($line !~ /$match_our_own_errors/) {
665 $stderr_anything_from_script = 1;
670 delete $proc{$installpid};
671 $install_exited = $?;
672 close($install_stderr_r);
673 if (length($stderr_buf) > 0) {
674 if ($stderr_buf !~ /$match_our_own_errors/) {
675 $stderr_anything_from_script = 1;
677 Log(undef, "stderr $stderr_buf")
680 Log (undef, "Install script exited ".exit_status_s($install_exited));
681 last if $install_exited == 0 || $main::please_freeze;
682 # If the install script fails but doesn't print an error message,
683 # the next thing anyone is likely to do is just run it again in
684 # case it was a transient problem like "slurm communication fails
685 # because the network isn't reliable enough". So we'll just do
686 # that ourselves (up to 3 attempts in total). OTOH, if there is an
687 # error message, the problem is more likely to have a real fix and
688 # we should fail the job so the fixing process can start, instead
689 # of doing 2 more attempts.
690 last if $stderr_anything_from_script;
693 foreach my $tar_filename (map { tar_filename_n($_); } (1..$git_tar_count)) {
694 unlink($tar_filename);
697 if ($install_exited != 0) {
702 foreach (qw (script script_version script_parameters runtime_constraints))
706 (ref($Job->{$_}) ? JSON::encode_json($Job->{$_}) : $Job->{$_}));
708 foreach (split (/\n/, $Job->{knobs}))
710 Log (undef, "knob " . $_);
715 $main::success = undef;
721 my $thisround_succeeded = 0;
722 my $thisround_failed = 0;
723 my $thisround_failed_multiple = 0;
725 @jobstep_todo = sort { $jobstep[$a]->{level} <=> $jobstep[$b]->{level}
726 or $a <=> $b } @jobstep_todo;
727 my $level = $jobstep[$jobstep_todo[0]]->{level};
729 my $initial_tasks_this_level = 0;
730 foreach my $id (@jobstep_todo) {
731 $initial_tasks_this_level++ if ($jobstep[$id]->{level} == $level);
734 # If the number of tasks scheduled at this level #T is smaller than the number
735 # of slots available #S, only use the first #T slots, or the first slot on
736 # each node, whichever number is greater.
738 # When we dispatch tasks later, we'll allocate whole-node resources like RAM
739 # based on these numbers. Using fewer slots makes more resources available
740 # to each individual task, which should normally be a better strategy when
741 # there are fewer of them running with less parallelism.
743 # Note that this calculation is not redone if the initial tasks at
744 # this level queue more tasks at the same level. This may harm
745 # overall task throughput for that level.
747 if ($initial_tasks_this_level < @node) {
748 @freeslot = (0..$#node);
749 } elsif ($initial_tasks_this_level < @slot) {
750 @freeslot = (0..$initial_tasks_this_level - 1);
752 @freeslot = (0..$#slot);
754 my $round_num_freeslots = scalar(@freeslot);
756 my %round_max_slots = ();
757 for (my $ii = $#freeslot; $ii >= 0; $ii--) {
758 my $this_slot = $slot[$freeslot[$ii]];
759 my $node_name = $this_slot->{node}->{name};
760 $round_max_slots{$node_name} ||= $this_slot->{cpu};
761 last if (scalar(keys(%round_max_slots)) >= @node);
764 Log(undef, "start level $level with $round_num_freeslots slots");
767 my $progress_is_dirty = 1;
768 my $progress_stats_updated = 0;
770 update_progress_stats();
774 for (my $todo_ptr = 0; $todo_ptr <= $#jobstep_todo; $todo_ptr ++)
776 my $id = $jobstep_todo[$todo_ptr];
777 my $Jobstep = $jobstep[$id];
778 if ($Jobstep->{level} != $level)
783 pipe $reader{$id}, "writer" or croak("pipe() failed: $!");
784 set_nonblocking($reader{$id});
786 my $childslot = $freeslot[0];
787 my $childnode = $slot[$childslot]->{node};
788 my $childslotname = join (".",
789 $slot[$childslot]->{node}->{name},
790 $slot[$childslot]->{cpu});
792 my $childpid = fork();
795 $SIG{'INT'} = 'DEFAULT';
796 $SIG{'QUIT'} = 'DEFAULT';
797 $SIG{'TERM'} = 'DEFAULT';
799 foreach (values (%reader))
803 fcntl ("writer", F_SETFL, 0) or croak ($!); # no close-on-exec
804 open(STDOUT,">&writer");
805 open(STDERR,">&writer");
810 delete $ENV{"GNUPGHOME"};
811 $ENV{"TASK_UUID"} = $Jobstep->{'arvados_task'}->{'uuid'};
812 $ENV{"TASK_QSEQUENCE"} = $id;
813 $ENV{"TASK_SEQUENCE"} = $level;
814 $ENV{"JOB_SCRIPT"} = $Job->{script};
815 while (my ($param, $value) = each %{$Job->{script_parameters}}) {
816 $param =~ tr/a-z/A-Z/;
817 $ENV{"JOB_PARAMETER_$param"} = $value;
819 $ENV{"TASK_SLOT_NODE"} = $slot[$childslot]->{node}->{name};
820 $ENV{"TASK_SLOT_NUMBER"} = $slot[$childslot]->{cpu};
821 $ENV{"TASK_WORK"} = $ENV{"CRUNCH_TMP"}."/task/$childslotname";
822 $ENV{"HOME"} = $ENV{"TASK_WORK"};
823 $ENV{"TASK_KEEPMOUNT"} = $ENV{"TASK_WORK"}.".keep";
824 $ENV{"TASK_TMPDIR"} = $ENV{"TASK_WORK"}; # deprecated
825 $ENV{"CRUNCH_NODE_SLOTS"} = $round_max_slots{$ENV{TASK_SLOT_NODE}};
826 $ENV{"PATH"} = $ENV{"CRUNCH_INSTALL"} . "/bin:" . $ENV{"PATH"};
832 "--nodelist=".$childnode->{name},
833 qw(-n1 -c1 -N1 -D), $ENV{'TMPDIR'},
834 "--job-name=$job_id.$id.$$",
837 "if [ -e $ENV{TASK_WORK} ]; then rm -rf $ENV{TASK_WORK}; fi; "
838 ."mkdir -p $ENV{CRUNCH_TMP} $ENV{JOB_WORK} $ENV{TASK_WORK} $ENV{TASK_KEEPMOUNT} "
839 ."&& cd $ENV{CRUNCH_TMP} "
840 # These environment variables get used explicitly later in
841 # $command. No tool is expected to read these values directly.
842 .q{&& MEM=$(awk '($1 == "MemTotal:"){print $2}' </proc/meminfo) }
843 .q{&& SWAP=$(awk '($1 == "SwapTotal:"){print $2}' </proc/meminfo) }
844 ."&& MEMLIMIT=\$(( (\$MEM * 95) / ($ENV{CRUNCH_NODE_SLOTS} * 100) )) "
845 ."&& let SWAPLIMIT=\$MEMLIMIT+\$SWAP ";
846 $command .= "&& exec arv-mount --by-id --allow-other $ENV{TASK_KEEPMOUNT} --exec ";
849 my $cidfile = "$ENV{CRUNCH_TMP}/$Jobstep->{arvados_task}->{uuid}-$Jobstep->{failures}.cid";
850 $command .= "crunchstat -cgroup-root=/sys/fs/cgroup -cgroup-parent=docker -cgroup-cid=$cidfile -poll=10000 ";
851 $command .= "$docker_bin run --rm=true --attach=stdout --attach=stderr --attach=stdin -i --user=crunch --cidfile=$cidfile --sig-proxy ";
852 # We only set memory limits if Docker lets us limit both memory and swap.
853 # Memory limits alone have been supported longer, but subprocesses tend
854 # to get SIGKILL if they exceed that without any swap limit set.
855 # See #5642 for additional background.
856 if ($docker_limitmem) {
857 $command .= "--memory=\${MEMLIMIT}k --memory-swap=\${SWAPLIMIT}k ";
860 # Dynamically configure the container to use the host system as its
861 # DNS server. Get the host's global addresses from the ip command,
862 # and turn them into docker --dns options using gawk.
864 q{$(ip -o address show scope global |
865 gawk 'match($4, /^([0-9\.:]+)\//, x){print "--dns", x[1]}') };
867 # The source tree and $destdir directory (which we have
868 # installed on the worker host) are available in the container,
869 # under the same path.
870 $command .= "--volume=\Q$ENV{CRUNCH_SRC}:$ENV{CRUNCH_SRC}:ro\E ";
871 $command .= "--volume=\Q$ENV{CRUNCH_INSTALL}:$ENV{CRUNCH_INSTALL}:ro\E ";
873 # Currently, we make arv-mount's mount point appear at /keep
874 # inside the container (instead of using the same path as the
875 # host like we do with CRUNCH_SRC and CRUNCH_INSTALL). However,
876 # crunch scripts and utilities must not rely on this. They must
877 # use $TASK_KEEPMOUNT.
878 $command .= "--volume=\Q$ENV{TASK_KEEPMOUNT}:/keep:ro\E ";
879 $ENV{TASK_KEEPMOUNT} = "/keep";
881 # TASK_WORK is almost exactly like a docker data volume: it
882 # starts out empty, is writable, and persists until no
883 # containers use it any more. We don't use --volumes-from to
884 # share it with other containers: it is only accessible to this
885 # task, and it goes away when this task stops.
887 # However, a docker data volume is writable only by root unless
888 # the mount point already happens to exist in the container with
889 # different permissions. Therefore, we [1] assume /tmp already
890 # exists in the image and is writable by the crunch user; [2]
891 # avoid putting TASK_WORK inside CRUNCH_TMP (which won't be
892 # writable if they are created by docker while setting up the
893 # other --volumes); and [3] create $TASK_WORK inside the
894 # container using $build_script.
895 $command .= "--volume=/tmp ";
896 $ENV{"TASK_WORK"} = "/tmp/crunch-job-task-work/$childslotname";
897 $ENV{"HOME"} = $ENV{"TASK_WORK"};
898 $ENV{"TASK_TMPDIR"} = $ENV{"TASK_WORK"}; # deprecated
900 # TODO: Share a single JOB_WORK volume across all task
901 # containers on a given worker node, and delete it when the job
902 # ends (and, in case that doesn't work, when the next job
905 # For now, use the same approach as TASK_WORK above.
906 $ENV{"JOB_WORK"} = "/tmp/crunch-job-work";
908 while (my ($env_key, $env_val) = each %ENV)
910 if ($env_key =~ /^(ARVADOS|CRUNCH|JOB|TASK)_/) {
911 $command .= "--env=\Q$env_key=$env_val\E ";
914 $command .= "--env=\QHOME=$ENV{HOME}\E ";
915 $command .= "\Q$docker_hash\E ";
916 $command .= "stdbuf --output=0 --error=0 ";
917 $command .= "perl - $ENV{CRUNCH_SRC}/crunch_scripts/" . $Job->{"script"};
920 $command .= "crunchstat -cgroup-root=/sys/fs/cgroup -poll=10000 ";
921 $command .= "stdbuf --output=0 --error=0 ";
922 $command .= "perl - $ENV{CRUNCH_SRC}/crunch_scripts/" . $Job->{"script"};
925 my @execargs = ('bash', '-c', $command);
926 srun (\@srunargs, \@execargs, undef, $build_script);
927 # exec() failed, we assume nothing happened.
928 die "srun() failed on build script\n";
931 if (!defined $childpid)
938 $proc{$childpid} = { jobstep => $id,
941 jobstepname => "$job_id.$id.$childpid",
943 croak ("assert failed: \$slot[$childslot]->{'pid'} exists") if exists $slot[$childslot]->{pid};
944 $slot[$childslot]->{pid} = $childpid;
946 Log ($id, "job_task ".$Jobstep->{'arvados_task'}->{'uuid'});
947 Log ($id, "child $childpid started on $childslotname");
948 $Jobstep->{starttime} = time;
949 $Jobstep->{node} = $childnode->{name};
950 $Jobstep->{slotindex} = $childslot;
951 delete $Jobstep->{stderr};
952 delete $Jobstep->{finishtime};
954 $Jobstep->{'arvados_task'}->{started_at} = strftime "%Y-%m-%dT%H:%M:%SZ", gmtime($Jobstep->{starttime});
955 $Jobstep->{'arvados_task'}->save;
957 splice @jobstep_todo, $todo_ptr, 1;
960 $progress_is_dirty = 1;
964 ($round_num_freeslots > @freeslot && $todo_ptr+1 > $#jobstep_todo))
966 last THISROUND if $main::please_freeze || defined($main::success);
967 if ($main::please_info)
969 $main::please_info = 0;
971 create_output_collection();
973 update_progress_stats();
980 check_refresh_wanted();
982 update_progress_stats();
983 select (undef, undef, undef, 0.1);
985 elsif (time - $progress_stats_updated >= 30)
987 update_progress_stats();
989 if (($thisround_failed_multiple >= 8 && $thisround_succeeded == 0) ||
990 ($thisround_failed_multiple >= 16 && $thisround_failed_multiple > $thisround_succeeded))
992 my $message = "Repeated failure rate too high ($thisround_failed_multiple/"
993 .($thisround_failed+$thisround_succeeded)
994 .") -- giving up on this round";
995 Log (undef, $message);
999 # move slots from freeslot to holdslot (or back to freeslot) if necessary
1000 for (my $i=$#freeslot; $i>=0; $i--) {
1001 if ($slot[$freeslot[$i]]->{node}->{hold_until} > scalar time) {
1002 push @holdslot, (splice @freeslot, $i, 1);
1005 for (my $i=$#holdslot; $i>=0; $i--) {
1006 if ($slot[$holdslot[$i]]->{node}->{hold_until} <= scalar time) {
1007 push @freeslot, (splice @holdslot, $i, 1);
1011 # give up if no nodes are succeeding
1012 if (!grep { $_->{node}->{losing_streak} == 0 &&
1013 $_->{node}->{hold_count} < 4 } @slot) {
1014 my $message = "Every node has failed -- giving up on this round";
1015 Log (undef, $message);
1022 push @freeslot, splice @holdslot;
1023 map { $slot[$freeslot[$_]]->{node}->{losing_streak} = 0 } (0..$#freeslot);
1026 Log (undef, "wait for last ".(scalar keys %proc)." children to finish");
1029 if ($main::please_continue) {
1030 $main::please_continue = 0;
1033 $main::please_info = 0, freeze(), create_output_collection(), save_meta(1) if $main::please_info;
1035 if (!reapchildren())
1037 check_refresh_wanted();
1039 update_progress_stats();
1040 select (undef, undef, undef, 0.1);
1041 killem (keys %proc) if $main::please_freeze;
1045 update_progress_stats();
1046 freeze_if_want_freeze();
1049 if (!defined $main::success)
1051 if (@jobstep_todo &&
1052 $thisround_succeeded == 0 &&
1053 ($thisround_failed == 0 || $thisround_failed > 4))
1055 my $message = "stop because $thisround_failed tasks failed and none succeeded";
1056 Log (undef, $message);
1065 goto ONELEVEL if !defined $main::success;
1068 release_allocation();
1070 my $collated_output = &create_output_collection();
1072 if (!$collated_output) {
1073 Log (undef, "Failed to write output collection");
1076 Log(undef, "job output $collated_output");
1077 $Job->update_attributes('output' => $collated_output);
1080 Log (undef, "finish");
1085 if ($collated_output && $main::success) {
1086 $final_state = 'Complete';
1088 $final_state = 'Failed';
1090 $Job->update_attributes('state' => $final_state);
1092 exit (($final_state eq 'Complete') ? 0 : 1);
1096 sub update_progress_stats
1098 $progress_stats_updated = time;
1099 return if !$progress_is_dirty;
1100 my ($todo, $done, $running) = (scalar @jobstep_todo,
1101 scalar @jobstep_done,
1102 scalar @slot - scalar @freeslot - scalar @holdslot);
1103 $Job->{'tasks_summary'} ||= {};
1104 $Job->{'tasks_summary'}->{'todo'} = $todo;
1105 $Job->{'tasks_summary'}->{'done'} = $done;
1106 $Job->{'tasks_summary'}->{'running'} = $running;
1107 $Job->update_attributes('tasks_summary' => $Job->{'tasks_summary'});
1108 Log (undef, "status: $done done, $running running, $todo todo");
1109 $progress_is_dirty = 0;
1116 my $pid = waitpid (-1, WNOHANG);
1117 return 0 if $pid <= 0;
1119 my $whatslot = ($slot[$proc{$pid}->{slot}]->{node}->{name}
1121 . $slot[$proc{$pid}->{slot}]->{cpu});
1122 my $jobstepid = $proc{$pid}->{jobstep};
1123 my $elapsed = time - $proc{$pid}->{time};
1124 my $Jobstep = $jobstep[$jobstepid];
1126 my $childstatus = $?;
1127 my $exitvalue = $childstatus >> 8;
1128 my $exitinfo = "exit ".exit_status_s($childstatus);
1129 $Jobstep->{'arvados_task'}->reload;
1130 my $task_success = $Jobstep->{'arvados_task'}->{success};
1132 Log ($jobstepid, "child $pid on $whatslot $exitinfo success=$task_success");
1134 if (!defined $task_success) {
1135 # task did not indicate one way or the other --> fail
1136 $Jobstep->{'arvados_task'}->{success} = 0;
1137 $Jobstep->{'arvados_task'}->save;
1144 $temporary_fail ||= $Jobstep->{node_fail};
1145 $temporary_fail ||= ($exitvalue == TASK_TEMPFAIL);
1147 ++$thisround_failed;
1148 ++$thisround_failed_multiple if $Jobstep->{'failures'} >= 1;
1150 # Check for signs of a failed or misconfigured node
1151 if (++$slot[$proc{$pid}->{slot}]->{node}->{losing_streak} >=
1152 2+$slot[$proc{$pid}->{slot}]->{node}->{ncpus}) {
1153 # Don't count this against jobstep failure thresholds if this
1154 # node is already suspected faulty and srun exited quickly
1155 if ($slot[$proc{$pid}->{slot}]->{node}->{hold_until} &&
1157 Log ($jobstepid, "blaming failure on suspect node " .
1158 $slot[$proc{$pid}->{slot}]->{node}->{name});
1159 $temporary_fail ||= 1;
1161 ban_node_by_slot($proc{$pid}->{slot});
1164 Log ($jobstepid, sprintf('failure (#%d, %s) after %d seconds',
1165 ++$Jobstep->{'failures'},
1166 $temporary_fail ? 'temporary' : 'permanent',
1169 if (!$temporary_fail || $Jobstep->{'failures'} >= 3) {
1170 # Give up on this task, and the whole job
1173 # Put this task back on the todo queue
1174 push @jobstep_todo, $jobstepid;
1175 $Job->{'tasks_summary'}->{'failed'}++;
1179 ++$thisround_succeeded;
1180 $slot[$proc{$pid}->{slot}]->{node}->{losing_streak} = 0;
1181 $slot[$proc{$pid}->{slot}]->{node}->{hold_until} = 0;
1182 push @jobstep_done, $jobstepid;
1183 Log ($jobstepid, "success in $elapsed seconds");
1185 $Jobstep->{exitcode} = $childstatus;
1186 $Jobstep->{finishtime} = time;
1187 $Jobstep->{'arvados_task'}->{finished_at} = strftime "%Y-%m-%dT%H:%M:%SZ", gmtime($Jobstep->{finishtime});
1188 $Jobstep->{'arvados_task'}->save;
1189 process_stderr ($jobstepid, $task_success);
1190 Log ($jobstepid, sprintf("task output (%d bytes): %s",
1191 length($Jobstep->{'arvados_task'}->{output}),
1192 $Jobstep->{'arvados_task'}->{output}));
1194 close $reader{$jobstepid};
1195 delete $reader{$jobstepid};
1196 delete $slot[$proc{$pid}->{slot}]->{pid};
1197 push @freeslot, $proc{$pid}->{slot};
1200 if ($task_success) {
1202 my $newtask_list = [];
1203 my $newtask_results;
1205 $newtask_results = api_call(
1208 'created_by_job_task_uuid' => $Jobstep->{'arvados_task'}->{uuid}
1210 'order' => 'qsequence',
1211 'offset' => scalar(@$newtask_list),
1213 push(@$newtask_list, @{$newtask_results->{items}});
1214 } while (@{$newtask_results->{items}});
1215 foreach my $arvados_task (@$newtask_list) {
1217 'level' => $arvados_task->{'sequence'},
1219 'arvados_task' => $arvados_task
1221 push @jobstep, $jobstep;
1222 push @jobstep_todo, $#jobstep;
1226 $progress_is_dirty = 1;
1230 sub check_refresh_wanted
1232 my @stat = stat $ENV{"CRUNCH_REFRESH_TRIGGER"};
1233 if (@stat && $stat[9] > $latest_refresh) {
1234 $latest_refresh = scalar time;
1235 my $Job2 = api_call("jobs/get", uuid => $jobspec);
1236 for my $attr ('cancelled_at',
1237 'cancelled_by_user_uuid',
1238 'cancelled_by_client_uuid',
1240 $Job->{$attr} = $Job2->{$attr};
1242 if ($Job->{'state'} ne "Running") {
1243 if ($Job->{'state'} eq "Cancelled") {
1244 Log (undef, "Job cancelled at " . $Job->{'cancelled_at'} . " by user " . $Job->{'cancelled_by_user_uuid'});
1246 Log (undef, "Job state unexpectedly changed to " . $Job->{'state'});
1249 $main::please_freeze = 1;
1256 my $last_squeue_check = $squeue_checked;
1258 # Do not call `squeue` or check the kill list more than once every
1260 return if $last_squeue_check > time - 15;
1261 $squeue_checked = time;
1263 # Look for children from which we haven't received stderr data since
1264 # the last squeue check. If no such children exist, all procs are
1265 # alive and there's no need to even look at squeue.
1267 # As long as the crunchstat poll interval (10s) is shorter than the
1268 # squeue check interval (15s) this should make the squeue check an
1270 my $silent_procs = 0;
1271 for my $jobstep (values %proc)
1273 if ($jobstep->{stderr_at} < $last_squeue_check)
1278 return if $silent_procs == 0;
1280 # use killem() on procs whose killtime is reached
1281 while (my ($pid, $jobstep) = each %proc)
1283 if (exists $jobstep->{killtime}
1284 && $jobstep->{killtime} <= time
1285 && $jobstep->{stderr_at} < $last_squeue_check)
1288 if ($jobstep->{stderr_at}) {
1289 $sincewhen = " in last " . (time - $jobstep->{stderr_at}) . "s";
1291 Log($jobstep->{jobstep}, "killing orphaned srun process $pid (task not in slurm queue, no stderr received$sincewhen)");
1298 # here is an opportunity to check for mysterious problems with local procs
1302 # Get a list of steps still running. Note: squeue(1) says --steps
1303 # selects a format (which we override anyway) and allows us to
1304 # specify which steps we're interested in (which we don't).
1305 # Importantly, it also changes the meaning of %j from "job name" to
1306 # "step name" and (although this isn't mentioned explicitly in the
1307 # docs) switches from "one line per job" mode to "one line per step"
1308 # mode. Without it, we'd just get a list of one job, instead of a
1310 my @squeue = `squeue --jobs=\Q$ENV{SLURM_JOB_ID}\E --steps --format='%j' --noheader`;
1313 Log(undef, "warning: squeue exit status $? ($!)");
1318 # which of my jobsteps are running, according to squeue?
1320 for my $jobstepname (@squeue)
1322 $ok{$jobstepname} = 1;
1325 # Check for child procs >60s old and not mentioned by squeue.
1326 while (my ($pid, $jobstep) = each %proc)
1328 if ($jobstep->{time} < time - 60
1329 && $jobstep->{jobstepname}
1330 && !exists $ok{$jobstep->{jobstepname}}
1331 && !exists $jobstep->{killtime})
1333 # According to slurm, this task has ended (successfully or not)
1334 # -- but our srun child hasn't exited. First we must wait (30
1335 # seconds) in case this is just a race between communication
1336 # channels. Then, if our srun child process still hasn't
1337 # terminated, we'll conclude some slurm communication
1338 # error/delay has caused the task to die without notifying srun,
1339 # and we'll kill srun ourselves.
1340 $jobstep->{killtime} = time + 30;
1341 Log($jobstep->{jobstep}, "notice: task is not in slurm queue but srun process $pid has not exited");
1347 sub release_allocation
1351 Log (undef, "release job allocation");
1352 system "scancel $ENV{SLURM_JOB_ID}";
1360 foreach my $job (keys %reader)
1363 while (0 < sysread ($reader{$job}, $buf, 8192))
1365 print STDERR $buf if $ENV{CRUNCH_DEBUG};
1366 $jobstep[$job]->{stderr_at} = time;
1367 $jobstep[$job]->{stderr} .= $buf;
1368 preprocess_stderr ($job);
1369 if (length ($jobstep[$job]->{stderr}) > 16384)
1371 substr ($jobstep[$job]->{stderr}, 0, 8192) = "";
1380 sub preprocess_stderr
1384 while ($jobstep[$job]->{stderr} =~ /^(.*?)\n/) {
1386 substr $jobstep[$job]->{stderr}, 0, 1+length($line), "";
1387 Log ($job, "stderr $line");
1388 if ($line =~ /srun: error: (SLURM job $ENV{SLURM_JOB_ID} has expired|Unable to confirm allocation for job $ENV{SLURM_JOB_ID})/) {
1390 $main::please_freeze = 1;
1392 elsif ($line =~ /(srun: error: (Node failure on|Unable to create job step|.*: Communication connection failure))|arvados.errors.Keep/) {
1393 $jobstep[$job]->{node_fail} = 1;
1394 ban_node_by_slot($jobstep[$job]->{slotindex});
1403 my $task_success = shift;
1404 preprocess_stderr ($job);
1407 Log ($job, "stderr $_");
1408 } split ("\n", $jobstep[$job]->{stderr});
1415 if (!open($keep, "-|", "arv-get", "--retries", retry_count(), $hash)) {
1416 Log(undef, "fetch_block run error from arv-get $hash: $!");
1419 my $output_block = "";
1422 my $bytes = sysread($keep, $buf, 1024 * 1024);
1423 if (!defined $bytes) {
1424 Log(undef, "fetch_block read error from arv-get: $!");
1425 $output_block = undef;
1427 } elsif ($bytes == 0) {
1428 # sysread returns 0 at the end of the pipe.
1431 # some bytes were read into buf.
1432 $output_block .= $buf;
1437 Log(undef, "fetch_block arv-get exited " . exit_status_s($?));
1438 $output_block = undef;
1440 return $output_block;
1443 # Create a collection by concatenating the output of all tasks (each
1444 # task's output is either a manifest fragment, a locator for a
1445 # manifest fragment stored in Keep, or nothing at all). Return the
1446 # portable_data_hash of the new collection.
1447 sub create_output_collection
1449 Log (undef, "collate");
1451 my ($child_out, $child_in);
1452 my $pid = open2($child_out, $child_in, 'python', '-c', q{
1455 print (arvados.api("v1").collections().
1456 create(body={"manifest_text": sys.stdin.read()}).
1457 execute(num_retries=int(sys.argv[1]))["portable_data_hash"])
1461 my $manifest_size = 0;
1465 my $output = $_->{'arvados_task'}->{output};
1466 next if (!defined($output));
1468 if ($output =~ /^[0-9a-f]{32}(\+\S+)*$/) {
1469 $next_write = fetch_block($output);
1471 $next_write = $output;
1473 if (defined($next_write)) {
1474 if (!defined(syswrite($child_in, $next_write))) {
1475 # There's been an error writing. Stop the loop.
1476 # We'll log details about the exit code later.
1479 $manifest_size += length($next_write);
1482 my $uuid = $_->{'arvados_task'}->{'uuid'};
1483 Log (undef, "Error retrieving '$output' output by task $task_idx ($uuid)");
1488 Log(undef, "collated output manifest text to send to API server is $manifest_size bytes with access tokens");
1491 my $s = IO::Select->new($child_out);
1492 if ($s->can_read(120)) {
1493 sysread($child_out, $joboutput, 1024 * 1024);
1496 Log(undef, "output collection creation exited " . exit_status_s($?));
1502 Log (undef, "timed out while creating output collection");
1503 foreach my $signal (2, 2, 2, 15, 15, 9) {
1504 kill($signal, $pid);
1505 last if waitpid($pid, WNOHANG) == -1;
1519 my $sig = 2; # SIGINT first
1520 if (exists $proc{$_}->{"sent_$sig"} &&
1521 time - $proc{$_}->{"sent_$sig"} > 4)
1523 $sig = 15; # SIGTERM if SIGINT doesn't work
1525 if (exists $proc{$_}->{"sent_$sig"} &&
1526 time - $proc{$_}->{"sent_$sig"} > 4)
1528 $sig = 9; # SIGKILL if SIGTERM doesn't work
1530 if (!exists $proc{$_}->{"sent_$sig"})
1532 Log ($proc{$_}->{jobstep}, "sending 2x signal $sig to pid $_");
1534 select (undef, undef, undef, 0.1);
1537 kill $sig, $_; # srun wants two SIGINT to really interrupt
1539 $proc{$_}->{"sent_$sig"} = time;
1540 $proc{$_}->{"killedafter"} = time - $proc{$_}->{"time"};
1550 vec($bits,fileno($_),1) = 1;
1556 # Send log output to Keep via arv-put.
1558 # $log_pipe_in and $log_pipe_out are the input and output filehandles to the arv-put pipe.
1559 # $log_pipe_pid is the pid of the arv-put subprocess.
1561 # The only functions that should access these variables directly are:
1563 # log_writer_start($logfilename)
1564 # Starts an arv-put pipe, reading data on stdin and writing it to
1565 # a $logfilename file in an output collection.
1567 # log_writer_send($txt)
1568 # Writes $txt to the output log collection.
1570 # log_writer_finish()
1571 # Closes the arv-put pipe and returns the output that it produces.
1573 # log_writer_is_active()
1574 # Returns a true value if there is currently a live arv-put
1575 # process, false otherwise.
1577 my ($log_pipe_in, $log_pipe_out, $log_pipe_pid);
1579 sub log_writer_start($)
1581 my $logfilename = shift;
1582 $log_pipe_pid = open2($log_pipe_out, $log_pipe_in,
1584 '--portable-data-hash',
1585 '--project-uuid', $Job->{owner_uuid},
1587 '--name', $logfilename,
1588 '--filename', $logfilename,
1592 sub log_writer_send($)
1595 print $log_pipe_in $txt;
1598 sub log_writer_finish()
1600 return unless $log_pipe_pid;
1602 close($log_pipe_in);
1605 my $s = IO::Select->new($log_pipe_out);
1606 if ($s->can_read(120)) {
1607 sysread($log_pipe_out, $arv_put_output, 1024);
1608 chomp($arv_put_output);
1610 Log (undef, "timed out reading from 'arv-put'");
1613 waitpid($log_pipe_pid, 0);
1614 $log_pipe_pid = $log_pipe_in = $log_pipe_out = undef;
1616 Log("log_writer_finish: arv-put exited ".exit_status_s($?))
1619 return $arv_put_output;
1622 sub log_writer_is_active() {
1623 return $log_pipe_pid;
1626 sub Log # ($jobstep_id, $logmessage)
1628 if ($_[1] =~ /\n/) {
1629 for my $line (split (/\n/, $_[1])) {
1634 my $fh = select STDERR; $|=1; select $fh;
1635 my $message = sprintf ("%s %d %s %s", $job_id, $$, @_);
1636 $message =~ s{([^ -\176])}{"\\" . sprintf ("%03o", ord($1))}ge;
1639 if (log_writer_is_active() || -t STDERR) {
1640 my @gmtime = gmtime;
1641 $datetime = sprintf ("%04d-%02d-%02d_%02d:%02d:%02d",
1642 $gmtime[5]+1900, $gmtime[4]+1, @gmtime[3,2,1,0]);
1644 print STDERR ((-t STDERR) ? ($datetime." ".$message) : $message);
1646 if (log_writer_is_active()) {
1647 log_writer_send($datetime . " " . $message);
1654 my ($package, $file, $line) = caller;
1655 my $message = "@_ at $file line $line\n";
1656 Log (undef, $message);
1657 freeze() if @jobstep_todo;
1658 create_output_collection() if @jobstep_todo;
1668 if ($Job->{'state'} eq 'Cancelled') {
1669 $Job->update_attributes('finished_at' => scalar gmtime);
1671 $Job->update_attributes('state' => 'Failed');
1678 my $justcheckpoint = shift; # false if this will be the last meta saved
1679 return if $justcheckpoint; # checkpointing is not relevant post-Warehouse.pm
1680 return unless log_writer_is_active();
1682 my $loglocator = log_writer_finish();
1683 Log (undef, "log manifest is $loglocator");
1684 $Job->{'log'} = $loglocator;
1685 $Job->update_attributes('log', $loglocator);
1689 sub freeze_if_want_freeze
1691 if ($main::please_freeze)
1693 release_allocation();
1696 # kill some srun procs before freeze+stop
1697 map { $proc{$_} = {} } @_;
1700 killem (keys %proc);
1701 select (undef, undef, undef, 0.1);
1703 while (($died = waitpid (-1, WNOHANG)) > 0)
1705 delete $proc{$died};
1710 create_output_collection();
1720 Log (undef, "Freeze not implemented");
1727 croak ("Thaw not implemented");
1743 $s =~ s{\\(.)}{$1 eq "n" ? "\n" : $1}ge;
1750 my $srunargs = shift;
1751 my $execargs = shift;
1752 my $opts = shift || {};
1754 my $args = $have_slurm ? [@$srunargs, @$execargs] : $execargs;
1756 $Data::Dumper::Terse = 1;
1757 $Data::Dumper::Indent = 0;
1758 my $show_cmd = Dumper($args);
1759 $show_cmd =~ s/(TOKEN\\*=)[^\s\']+/${1}[...]/g;
1760 $show_cmd =~ s/\n/ /g;
1761 if ($opts->{fork}) {
1762 Log(undef, "starting: $show_cmd");
1764 # This is a child process: parent is in charge of reading our
1765 # stderr and copying it to Log() if needed.
1766 warn "starting: $show_cmd\n";
1769 if (defined $stdin) {
1770 my $child = open STDIN, "-|";
1771 defined $child or die "no fork: $!";
1773 print $stdin or die $!;
1774 close STDOUT or die $!;
1779 return system (@$args) if $opts->{fork};
1782 warn "ENV size is ".length(join(" ",%ENV));
1783 die "exec failed: $!: @$args";
1787 sub ban_node_by_slot {
1788 # Don't start any new jobsteps on this node for 60 seconds
1790 $slot[$slotid]->{node}->{hold_until} = 60 + scalar time;
1791 $slot[$slotid]->{node}->{hold_count}++;
1792 Log (undef, "backing off node " . $slot[$slotid]->{node}->{name} . " for 60 seconds");
1797 my ($lockfile, $error_message) = @_;
1798 open L, ">", $lockfile or croak("$lockfile: $!");
1799 if (!flock L, LOCK_EX|LOCK_NB) {
1800 croak("Can't lock $lockfile: $error_message\n");
1804 sub find_docker_image {
1805 # Given a Keep locator, check to see if it contains a Docker image.
1806 # If so, return its stream name and Docker hash.
1807 # If not, return undef for both values.
1808 my $locator = shift;
1809 my ($streamname, $filename);
1810 my $image = api_call("collections/get", uuid => $locator);
1812 foreach my $line (split(/\n/, $image->{manifest_text})) {
1813 my @tokens = split(/\s+/, $line);
1815 $streamname = shift(@tokens);
1816 foreach my $filedata (grep(/^\d+:\d+:/, @tokens)) {
1817 if (defined($filename)) {
1818 return (undef, undef); # More than one file in the Collection.
1820 $filename = (split(/:/, $filedata, 3))[2];
1825 if (defined($filename) and ($filename =~ /^([0-9A-Fa-f]{64})\.tar$/)) {
1826 return ($streamname, $1);
1828 return (undef, undef);
1833 # Calculate the number of times an operation should be retried,
1834 # assuming exponential backoff, and that we're willing to retry as
1835 # long as tasks have been running. Enforce a minimum of 3 retries.
1836 my ($starttime, $endtime, $timediff, $retries);
1838 $starttime = $jobstep[0]->{starttime};
1839 $endtime = $jobstep[-1]->{finishtime};
1841 if (!defined($starttime)) {
1843 } elsif (!defined($endtime)) {
1844 $timediff = time - $starttime;
1846 $timediff = ($endtime - $starttime) - (time - $endtime);
1848 if ($timediff > 0) {
1849 $retries = int(log($timediff) / log(2));
1851 $retries = 1; # Use the minimum.
1853 return ($retries > 3) ? $retries : 3;
1857 # Pass in two function references.
1858 # This method will be called with the remaining arguments.
1859 # If it dies, retry it with exponential backoff until it succeeds,
1860 # or until the current retry_count is exhausted. After each failure
1861 # that can be retried, the second function will be called with
1862 # the current try count (0-based), next try time, and error message.
1863 my $operation = shift;
1864 my $retry_callback = shift;
1865 my $retries = retry_count();
1866 foreach my $try_count (0..$retries) {
1867 my $next_try = time + (2 ** $try_count);
1868 my $result = eval { $operation->(@_); };
1871 } elsif ($try_count < $retries) {
1872 $retry_callback->($try_count, $next_try, $@);
1873 my $sleep_time = $next_try - time;
1874 sleep($sleep_time) if ($sleep_time > 0);
1877 # Ensure the error message ends in a newline, so Perl doesn't add
1878 # retry_op's line number to it.
1884 # Pass in a /-separated API method name, and arguments for it.
1885 # This function will call that method, retrying as needed until
1886 # the current retry_count is exhausted, with a log on the first failure.
1887 my $method_name = shift;
1888 my $log_api_retry = sub {
1889 my ($try_count, $next_try_at, $errmsg) = @_;
1890 $errmsg =~ s/\s*\bat \Q$0\E line \d+\.?\s*//;
1891 $errmsg =~ s/\s/ /g;
1892 $errmsg =~ s/\s+$//;
1894 if ($next_try_at < time) {
1895 $retry_msg = "Retrying.";
1897 my $next_try_fmt = strftime "%Y-%m-%dT%H:%M:%SZ", gmtime($next_try_at);
1898 $retry_msg = "Retrying at $next_try_fmt.";
1900 Log(undef, "API method $method_name failed: $errmsg. $retry_msg");
1903 foreach my $key (split(/\//, $method_name)) {
1904 $method = $method->{$key};
1906 return retry_op(sub { $method->execute(@_); }, $log_api_retry, @_);
1910 # Given a $?, return a human-readable exit code string like "0" or
1911 # "1" or "0 with signal 1" or "1 with signal 11".
1912 my $exitcode = shift;
1913 my $s = $exitcode >> 8;
1914 if ($exitcode & 0x7f) {
1915 $s .= " with signal " . ($exitcode & 0x7f);
1917 if ($exitcode & 0x80) {
1918 $s .= " with core dump";
1923 sub handle_readall {
1924 # Pass in a glob reference to a file handle.
1925 # Read all its contents and return them as a string.
1926 my $fh_glob_ref = shift;
1928 return <$fh_glob_ref>;
1931 sub tar_filename_n {
1933 return sprintf("%s/git.%s.%d.tar", $ENV{CRUNCH_TMP}, $job_id, $n);
1936 sub add_git_archive {
1937 # Pass in a git archive command as a string or list, a la system().
1938 # This method will save its output to be included in the archive sent to the
1942 if (!open(GIT_ARCHIVE, ">", tar_filename_n($git_tar_count))) {
1943 croak("Failed to save git archive: $!");
1945 my $git_pid = open2(">&GIT_ARCHIVE", $git_input, @_);
1947 waitpid($git_pid, 0);
1950 croak("Failed to save git archive: git exited " . exit_status_s($?));
1954 sub combined_git_archive {
1955 # Combine all saved tar archives into a single archive, then return its
1956 # contents in a string. Return undef if no archives have been saved.
1957 if ($git_tar_count < 1) {
1960 my $base_tar_name = tar_filename_n(1);
1961 foreach my $tar_to_append (map { tar_filename_n($_); } (2..$git_tar_count)) {
1962 my $tar_exit = system("tar", "-Af", $base_tar_name, $tar_to_append);
1963 if ($tar_exit != 0) {
1964 croak("Error preparing build archive: tar -A exited " .
1965 exit_status_s($tar_exit));
1968 if (!open(GIT_TAR, "<", $base_tar_name)) {
1969 croak("Could not open build archive: $!");
1971 my $tar_contents = handle_readall(\*GIT_TAR);
1973 return $tar_contents;
1976 sub set_nonblocking {
1978 my $flags = fcntl ($fh, F_GETFL, 0) or croak ($!);
1979 fcntl ($fh, F_SETFL, $flags | O_NONBLOCK) or croak ($!);
1985 # This is crunch-job's internal dispatch script. crunch-job running on the API
1986 # server invokes this script on individual compute nodes, or localhost if we're
1987 # running a job locally. It gets called in two modes:
1989 # * No arguments: Installation mode. Read a tar archive from the DATA
1990 # file handle; it includes the Crunch script's source code, and
1991 # maybe SDKs as well. Those should be installed in the proper
1992 # locations. This runs outside of any Docker container, so don't try to
1993 # introspect Crunch's runtime environment.
1995 # * With arguments: Crunch script run mode. This script should set up the
1996 # environment, then run the command specified in the arguments. This runs
1997 # inside any Docker container.
2000 use File::Path qw( make_path remove_tree );
2001 use POSIX qw(getcwd);
2003 use constant TASK_TEMPFAIL => 111;
2005 # Map SDK subdirectories to the path environments they belong to.
2006 my %SDK_ENVVARS = ("perl/lib" => "PERLLIB", "ruby/lib" => "RUBYLIB");
2008 my $destdir = $ENV{"CRUNCH_SRC"};
2009 my $archive_hash = $ENV{"CRUNCH_GIT_ARCHIVE_HASH"};
2010 my $repo = $ENV{"CRUNCH_SRC_URL"};
2011 my $install_dir = $ENV{"CRUNCH_INSTALL"} || (getcwd() . "/opt");
2012 my $job_work = $ENV{"JOB_WORK"};
2013 my $task_work = $ENV{"TASK_WORK"};
2015 open(STDOUT_ORIG, ">&", STDOUT);
2016 open(STDERR_ORIG, ">&", STDERR);
2018 for my $dir ($destdir, $job_work, $task_work) {
2021 -e $dir or die "Failed to create temporary directory ($dir): $!";
2026 remove_tree($task_work, {keep_root => 1});
2029 ### Crunch script run mode
2031 # We want to do routine logging during task 0 only. This gives the user
2032 # the information they need, but avoids repeating the information for every
2035 if ($ENV{TASK_SEQUENCE} eq "0") {
2038 printf STDERR_ORIG "[Crunch] $msg\n", @_;
2044 my $python_src = "$install_dir/python";
2045 my $venv_dir = "$job_work/.arvados.venv";
2046 my $venv_built = -e "$venv_dir/bin/activate";
2047 if ((!$venv_built) and (-d $python_src) and can_run("virtualenv")) {
2048 shell_or_die(undef, "virtualenv", "--quiet", "--system-site-packages",
2049 "--python=python2.7", $venv_dir);
2050 shell_or_die(TASK_TEMPFAIL, "$venv_dir/bin/pip", "--quiet", "install", "-I", $python_src);
2052 $Log->("Built Python SDK virtualenv");
2055 my $pip_bin = "pip";
2057 $Log->("Running in Python SDK virtualenv");
2058 $pip_bin = "$venv_dir/bin/pip";
2059 my $orig_argv = join(" ", map { quotemeta($_); } @ARGV);
2060 @ARGV = ("/bin/sh", "-ec",
2061 ". \Q$venv_dir/bin/activate\E; exec $orig_argv");
2062 } elsif (-d $python_src) {
2063 $Log->("Warning: virtualenv not found inside Docker container default " .
2064 "\$PATH. Can't install Python SDK.");
2067 my $pkgs = `(\Q$pip_bin\E freeze 2>/dev/null | grep arvados) || dpkg-query --show '*arvados*'`;
2069 $Log->("Using Arvados SDK:");
2070 foreach my $line (split /\n/, $pkgs) {
2074 $Log->("Arvados SDK packages not found");
2077 while (my ($sdk_dir, $sdk_envkey) = each(%SDK_ENVVARS)) {
2078 my $sdk_path = "$install_dir/$sdk_dir";
2080 if ($ENV{$sdk_envkey}) {
2081 $ENV{$sdk_envkey} = "$sdk_path:" . $ENV{$sdk_envkey};
2083 $ENV{$sdk_envkey} = $sdk_path;
2085 $Log->("Arvados SDK added to %s", $sdk_envkey);
2090 die "Cannot exec `@ARGV`: $!";
2093 ### Installation mode
2094 open L, ">", "$destdir.lock" or die "$destdir.lock: $!";
2096 if (readlink ("$destdir.archive_hash") eq $archive_hash && -d $destdir) {
2097 # This exact git archive (source + arvados sdk) is already installed
2098 # here, so there's no need to reinstall it.
2100 # We must consume our DATA section, though: otherwise the process
2101 # feeding it to us will get SIGPIPE.
2103 while (read(DATA, $buf, 65536)) { }
2108 unlink "$destdir.archive_hash";
2112 # Ignore SIGPIPE: we check retval of close() instead. See perlipc(1).
2113 local $SIG{PIPE} = "IGNORE";
2114 warn "Extracting archive: $archive_hash\n";
2115 # --ignore-zeros is necessary sometimes: depending on how much NUL
2116 # padding tar -A put on our combined archive (which in turn depends
2117 # on the length of the component archives) tar without
2118 # --ignore-zeros will exit before consuming stdin and cause close()
2119 # to fail on the resulting SIGPIPE.
2120 if (!open(TARX, "|-", "tar", "--ignore-zeros", "-xC", $destdir)) {
2121 die "Error launching 'tar -xC $destdir': $!";
2123 # If we send too much data to tar in one write (> 4-5 MiB), it stops, and we
2124 # get SIGPIPE. We must feed it data incrementally.
2126 while (read(DATA, $tar_input, 65536)) {
2127 print TARX $tar_input;
2130 die "'tar -xC $destdir' exited $?: $!";
2136 my $sdk_root = "$destdir/.arvados.sdk/sdk";
2138 foreach my $sdk_lang (("python",
2139 map { (split /\//, $_, 2)[0]; } keys(%SDK_ENVVARS))) {
2140 if (-d "$sdk_root/$sdk_lang") {
2141 if (!rename("$sdk_root/$sdk_lang", "$install_dir/$sdk_lang")) {
2142 die "Failed to install $sdk_lang SDK: $!";
2148 my $python_dir = "$install_dir/python";
2149 if ((-d $python_dir) and can_run("python2.7")) {
2150 open(my $egg_info_pipe, "-|",
2151 "python2.7 \Q$python_dir/setup.py\E --quiet egg_info 2>&1 >/dev/null");
2152 my @egg_info_errors = <$egg_info_pipe>;
2153 close($egg_info_pipe);
2155 if (@egg_info_errors and ($egg_info_errors[-1] =~ /\bgit\b/)) {
2156 # egg_info apparently failed because it couldn't ask git for a build tag.
2157 # Specify no build tag.
2158 open(my $pysdk_cfg, ">>", "$python_dir/setup.cfg");
2159 print $pysdk_cfg "\n[egg_info]\ntag_build =\n";
2162 my $egg_info_exit = $? >> 8;
2163 foreach my $errline (@egg_info_errors) {
2164 print STDERR_ORIG $errline;
2166 warn "python setup.py egg_info failed: exit $egg_info_exit";
2167 exit ($egg_info_exit || 1);
2172 # Hide messages from the install script (unless it fails: shell_or_die
2173 # will show $destdir.log in that case).
2174 open(STDOUT, ">>", "$destdir.log");
2175 open(STDERR, ">&", STDOUT);
2177 if (-e "$destdir/crunch_scripts/install") {
2178 shell_or_die (undef, "$destdir/crunch_scripts/install", $install_dir);
2179 } elsif (!-e "./install.sh" && -e "./tests/autotests.sh") {
2181 shell_or_die (undef, "./tests/autotests.sh", $install_dir);
2182 } elsif (-e "./install.sh") {
2183 shell_or_die (undef, "./install.sh", $install_dir);
2186 if ($archive_hash) {
2187 unlink "$destdir.archive_hash.new";
2188 symlink ($archive_hash, "$destdir.archive_hash.new") or die "$destdir.archive_hash.new: $!";
2189 rename ("$destdir.archive_hash.new", "$destdir.archive_hash") or die "$destdir.archive_hash: $!";
2195 my $command_name = shift;
2196 open(my $which, "-|", "which", $command_name);
2197 while (<$which>) { }
2204 my $exitcode = shift;
2206 if ($ENV{"DEBUG"}) {
2207 print STDERR "@_\n";
2209 if (system (@_) != 0) {
2212 my $exitstatus = sprintf("exit %d signal %d", $code >> 8, $code & 0x7f);
2213 open STDERR, ">&STDERR_ORIG";
2214 system ("cat $destdir.log >&2");
2215 warn "@_ failed ($err): $exitstatus";
2216 if (defined($exitcode)) {
2220 exit (($code >> 8) || 1);