diff options
| author | Ricardo Wurmus <rekado@elephly.net> | 2021-02-09 23:29:17 +0100 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2021-02-09 23:29:17 +0100 |
| commit | 769921724787f87700c769762a0c91335d03e4c4 (patch) | |
| tree | f002ce0a33ec885542916b88d63b1370e7a2c85d | |
Let's begin!
| -rw-r--r-- | .gitignore | 67 | ||||
| -rw-r--r-- | AUTHORS | 3 | ||||
| -rw-r--r-- | COPYING | 3 | ||||
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | HACKING | 39 | ||||
| -rw-r--r-- | Makefile.am | 94 | ||||
| -rw-r--r-- | NEWS | 14 | ||||
| l--------- | README | 1 | ||||
| -rw-r--r-- | README.org | 4 | ||||
| -rw-r--r-- | TODO.org | 42 | ||||
| -rwxr-xr-x | build-aux/gitlog-to-changelog | 432 | ||||
| -rw-r--r-- | build-aux/test-driver.scm | 180 | ||||
| -rw-r--r-- | configure.ac | 36 | ||||
| -rw-r--r-- | doc/drmaa.texi | 87 | ||||
| -rw-r--r-- | drmaa/v1/ffi.ffi | 20 | ||||
| -rw-r--r-- | drmaa/v1/low.scm | 655 | ||||
| -rw-r--r-- | guix.scm | 37 | ||||
| -rw-r--r-- | include/drmaa.h | 567 | ||||
| -rw-r--r-- | pre-inst-env.in | 14 |
19 files changed, 2299 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d347fdd --- /dev/null +++ b/.gitignore @@ -0,0 +1,67 @@ +*.eps +*.go +*.log +*.pdf +*.png +*.tar.xz +*.tar.gz +*.tmp +*~ +.#* +\#*\# +,* +/ABOUT-NLS +/INSTALL +/aclocal.m4 +/autom4te.cache +/build-aux/ar-lib +/build-aux/compile +/build-aux/config.guess +/build-aux/config.rpath +/build-aux/config.sub +/build-aux/depcomp +/build-aux/install-sh +/build-aux/mdate-sh +/build-aux/missing +/build-aux/test-driver +/build-aux/texinfo.tex +/config.status +/configure +/doc/*.1 +/doc/.dirstamp +/doc/contributing.*.texi +/doc/*.aux +/doc/*.cp +/doc/*.cps +/doc/*.fn +/doc/*.fns +/doc/*.html +/doc/*.info +/doc/*.info-[0-9] +/doc/*.ky +/doc/*.pg +/doc/*.toc +/doc/*.t2p +/doc/*.tp +/doc/*.vr +/doc/*.vrs +/doc/stamp-vti +/doc/version.texi +/doc/version-*.texi +/m4/* +/pre-inst-env +/test-env +/test-tmp +/tests/*.trs +GPATH +GRTAGS +GTAGS +Makefile +Makefile.in +config.cache +stamp-h[0-9] +tmp +/.version +/doc/stamp-[0-9] + +/drmaa/v1/ffi.scm
\ No newline at end of file @@ -0,0 +1,3 @@ +Contributers to Guile DRMAA 0.1: + + Ricardo Wurmus <rekado@elephly.net> @@ -0,0 +1,3 @@ +This project's license is GPL 3+. + +You can read the full license at https://www.gnu.org/licenses/gpl.html. diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..fdb7b5f --- /dev/null +++ b/ChangeLog @@ -0,0 +1,4 @@ +Normally a ChangeLog is generated at "make dist" time and available in +source tarballs. + +If not, see the Git commit log at <https://git.elephly.net/software/guile-drmaa.git/>. @@ -0,0 +1,39 @@ +-*- mode: org; coding: utf-8; -*- + +#+TITLE: Hacking drmaa + +* Contributing + +By far the easiest way to hack on Guile DRMAA is to develop using Guix: + +#+BEGIN_SRC bash +# Obtain the source code +cd /path/to/source-code +guix environment -l guix.scm +# In the new shell, run: +autoreconf -vif && ./configure && make check +#+END_SRC + +You can now hack this project's files to your heart's content, whilst +testing them from your =guix environment= shell. + +To try out any scripts in the project you can now use + +#+BEGIN_SRC bash +./pre-inst-env scripts/${script-name} +#+END_SRC + +** Manual Installation + +If you do not yet use Guix, you will have to install this project's +dependencies manually: + - autoconf + - automake + - pkg-config + - texinfo + +Once those dependencies are installed you can run: + +#+BEGIN_SRC bash +autoreconf -vif && ./configure && make check +#+END_SRC diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..caa3c8c --- /dev/null +++ b/Makefile.am @@ -0,0 +1,94 @@ +# Handle substitution of fully-expanded Autoconf variables. +do_subst = $(SED) \ + -e 's,[@]GUILE[@],$(GUILE),g' \ + -e 's,[@]guilemoduledir[@],$(guilemoduledir),g' \ + -e 's,[@]guileobjectdir[@],$(guileobjectdir),g' \ + -e 's,[@]localedir[@],$(localedir),g' + +nodist_noinst_SCRIPTS = pre-inst-env + +GOBJECTS = $(SOURCES:%.scm=%.go) + +moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) +godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache +ccachedir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_go_DATA = $(GOBJECTS) + +# Make sure source files are installed first, so that the mtime of +# installed compiled files is greater than that of installed source +# files. See +# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html> +# for details. +guile_install_go_files = install-nobase_goDATA +$(guile_install_go_files): install-nobase_modDATA + +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) drmaa/v1/ffi.ffi +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +SUFFIXES = .scm .go .ffi +.scm.go: + $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<" + +drmaa/v1/ffi.scm: drmaa/v1/ffi.ffi + $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile-ffi -I $(top_srcdir)/include -X -o "$@" "$<" && \ + $(SED) -e 's,(define drmaa-v1-ffi-llibs (list)),(define drmaa-v1-ffi-llibs (delay (list (dynamic-link (getenv "GUILE_DRMAA_LIBRARY"))))),' \ + -e 's,drmaa-v1-ffi-llibs),(force drmaa-v1-ffi-llibs)),' -i $@ + +SOURCES = drmaa.scm \ + drmaa/v1/ffi.scm \ + drmaa/v1/low.scm + +TESTS = + +TEST_EXTENSIONS = .scm +SCM_LOG_DRIVER = \ + $(top_builddir)/pre-inst-env \ + $(GUILE) --no-auto-compile -e main \ + $(top_srcdir)/build-aux/test-driver.scm + +# Tell 'build-aux/test-driver.scm' to display only source file names, +# not indivdual test names. +AM_SCM_LOG_DRIVER_FLAGS = --brief=yes + +AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)" + +AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" + +info_TEXINFOS = doc/drmaa.texi +dvi: # Don't build dvi docs + +EXTRA_DIST += README.org \ + README \ + HACKING \ + COPYING \ + NEWS \ + AUTHORS \ + ChangeLog \ + guix.scm \ + build-aux/test-driver.scm \ + configure.ac \ + Makefile.am \ + pre-inst-env.in \ + build-aux/test-driver.scm \ + $(TESTS) + +ACLOCAL_AMFLAGS = -I m4 + +dist-hook: $(distdir)/ChangeLog +gen-ChangeLog $(distdir)/ChangeLog: + $(AM_V_GEN)if test -d .git; then \ + $(top_srcdir)/build-aux/gitlog-to-changelog \ + > $(distdir)/cl-t; \ + rm -f $(distdir)/ChangeLog; \ + mv $(distdir)/cl-t $(distdir)/ChangeLog; \ + fi + +clean-go: + -$(RM) $(GOBJECTS) +.PHONY: clean-go gen-ChangeLog + +CLEANFILES = \ + drmaa/v1/ffi.scm \ + $(GOBJECTS) \ + $(TESTS:tests/%.scm=%.log) @@ -0,0 +1,14 @@ +-*- mode: org; coding: utf-8; -*- + +#+TITLE: Guile DRMAA NEWS – history of user-visible changes +#+STARTUP: content hidestars + +Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> + + Copying and distribution of this file, with or without modification, + are permitted in any medium without royalty provided the copyright + notice and this notice are preserved. + +Please send Guile DRMAA bug reports to <rekado@elephly.net>. + +* Publication at 0.1 @@ -0,0 +1 @@ +README.org
\ No newline at end of file diff --git a/README.org b/README.org new file mode 100644 index 0000000..7d2e607 --- /dev/null +++ b/README.org @@ -0,0 +1,4 @@ +-*- mode: org; coding: utf-8; -*- + +#+TITLE: README for Guile Drmaa + diff --git a/TODO.org b/TODO.org new file mode 100644 index 0000000..00cada7 --- /dev/null +++ b/TODO.org @@ -0,0 +1,42 @@ +#+TYP_TODO: MAYBE TODO DONE +* TODO error message becomes a scheduling command + +Consider this code: + +#+begin_src scheme +(use-modules (drmaa v1 low)) +(define (test) + (let ((t (allocate-job-template!))) + (set-attribute! t (DRMAA 'REMOTE_COMMAND) "/bin/ls") + (set-attribute! t (DRMAA 'JS_STATE) + (DRMAA 'SUBMISSION_STATE_ACTIVE)) + (set-attribute! t (DRMAA 'WD) + "/home/rwurmus/") + + ;; This is wrong and leads to an error + (set-attribute! t (DRMAA 'NATIVE_SPECIFICATION) + "-b n -V -q all.q -w n -A rwurmus") + (run-bulk-jobs t 1))) + +(init-session!) +(test) +(exit-session!) +#+end_src + +Since there is no =rwurmus= accounting group, the template fails with an error message. Part of this error message is interpreted as a command: + +#+begin_example +scheme@(guile-user)> (test) +WARNING - Accounting to 'rwurmus' was denied, thus your job was assigned into your default department 'akalin +WARNING - Accounting to 'rwurmus' was denied, thus your job was assigned into your default department 'akalin +ice-9/boot-9.scm:1669:16: In procedure raise-exception: +ERROR: + 1. &message: "master got unknown command from JSV: \"'.\" (17)" + +Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue. +scheme@(guile-user) [1]> ,bt +In ice-9/boot-9.scm: + 1669:16 0 (raise-exception _ #:continuable? _) +#+end_example + +That’s the trailing “'.” of the error message that somehow slips by and is interpreted as a command. Is some buffer too small? diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog new file mode 100755 index 0000000..e02d34c --- /dev/null +++ b/build-aux/gitlog-to-changelog @@ -0,0 +1,432 @@ +eval '(exit $?0)' && eval 'exec perl -wS "$0" ${1+"$@"}' + & eval 'exec perl -wS "$0" $argv:q' + if 0; +# Convert git log output to ChangeLog format. + +my $VERSION = '2012-07-29 06:11'; # UTC +# The definition above must lie within the first 8 lines in order +# for the Emacs time-stamp write hook (at end) to update it. +# If you change this file with Emacs, please let the write hook +# do its job. Otherwise, update this string manually. + +# Copyright (C) 2008-2013 Free Software Foundation, Inc. + +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. + +# Written by Jim Meyering + +use strict; +use warnings; +use Getopt::Long; +use POSIX qw(strftime); + +(my $ME = $0) =~ s|.*/||; + +# use File::Coda; # http://meyering.net/code/Coda/ +END { + defined fileno STDOUT or return; + close STDOUT and return; + warn "$ME: failed to close standard output: $!\n"; + $? ||= 1; +} + +sub usage ($) +{ + my ($exit_code) = @_; + my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR); + if ($exit_code != 0) + { + print $STREAM "Try '$ME --help' for more information.\n"; + } + else + { + print $STREAM <<EOF; +Usage: $ME [OPTIONS] [ARGS] + +Convert git log output to ChangeLog format. If present, any ARGS +are passed to "git log". To avoid ARGS being parsed as options to +$ME, they may be preceded by '--'. + +OPTIONS: + + --amend=FILE FILE maps from an SHA1 to perl code (i.e., s/old/new/) that + makes a change to SHA1's commit log text or metadata. + --append-dot append a dot to the first line of each commit message if + there is no other punctuation or blank at the end. + --no-cluster never cluster commit messages under the same date/author + header; the default is to cluster adjacent commit messages + if their headers are the same and neither commit message + contains multiple paragraphs. + --srcdir=DIR the root of the source tree, from which the .git/ + directory can be derived. + --since=DATE convert only the logs since DATE; + the default is to convert all log entries. + --format=FMT set format string for commit subject and body; + see 'man git-log' for the list of format metacharacters; + the default is '%s%n%b%n' + --strip-tab remove one additional leading TAB from commit message lines. + --strip-cherry-pick remove data inserted by "git cherry-pick"; + this includes the "cherry picked from commit ..." line, + and the possible final "Conflicts:" paragraph. + --help display this help and exit + --version output version information and exit + +EXAMPLE: + + $ME --since=2008-01-01 > ChangeLog + $ME -- -n 5 foo > last-5-commits-to-branch-foo + +SPECIAL SYNTAX: + +The following types of strings are interpreted specially when they appear +at the beginning of a log message line. They are not copied to the output. + + Copyright-paperwork-exempt: Yes + Append the "(tiny change)" notation to the usual "date name email" + ChangeLog header to mark a change that does not require a copyright + assignment. + Co-authored-by: Joe User <user\@example.com> + List the specified name and email address on a second + ChangeLog header, denoting a co-author. + Signed-off-by: Joe User <user\@example.com> + These lines are simply elided. + +In a FILE specified via --amend, comment lines (starting with "#") are ignored. +FILE must consist of <SHA,CODE+> pairs where SHA is a 40-byte SHA1 (alone on +a line) referring to a commit in the current project, and CODE refers to one +or more consecutive lines of Perl code. Pairs must be separated by one or +more blank line. + +Here is sample input for use with --amend=FILE, from coreutils: + +3a169f4c5d9159283548178668d2fae6fced3030 +# fix typo in title: +s/all tile types/all file types/ + +1379ed974f1fa39b12e2ffab18b3f7a607082202 +# Due to a bug in vc-dwim, I mis-attributed a patch by Paul to myself. +# Change the author to be Paul. Note the escaped "@": +s,Jim .*>,Paul Eggert <eggert\\\@cs.ucla.edu>, + +EOF + } + exit $exit_code; +} + +# If the string $S is a well-behaved file name, simply return it. +# If it contains white space, quotes, etc., quote it, and return the new string. +sub shell_quote($) +{ + my ($s) = @_; + if ($s =~ m![^\w+/.,-]!) + { + # Convert each single quote to '\'' + $s =~ s/\'/\'\\\'\'/g; + # Then single quote the string. + $s = "'$s'"; + } + return $s; +} + +sub quoted_cmd(@) +{ + return join (' ', map {shell_quote $_} @_); +} + +# Parse file F. +# Comment lines (starting with "#") are ignored. +# F must consist of <SHA,CODE+> pairs where SHA is a 40-byte SHA1 +# (alone on a line) referring to a commit in the current project, and +# CODE refers to one or more consecutive lines of Perl code. +# Pairs must be separated by one or more blank line. +sub parse_amend_file($) +{ + my ($f) = @_; + + open F, '<', $f + or die "$ME: $f: failed to open for reading: $!\n"; + + my $fail; + my $h = {}; + my $in_code = 0; + my $sha; + while (defined (my $line = <F>)) + { + $line =~ /^\#/ + and next; + chomp $line; + $line eq '' + and $in_code = 0, next; + + if (!$in_code) + { + $line =~ /^([0-9a-fA-F]{40})$/ + or (warn "$ME: $f:$.: invalid line; expected an SHA1\n"), + $fail = 1, next; + $sha = lc $1; + $in_code = 1; + exists $h->{$sha} + and (warn "$ME: $f:$.: duplicate SHA1\n"), + $fail = 1, next; + } + else + { + $h->{$sha} ||= ''; + $h->{$sha} .= "$line\n"; + } + } + close F; + + $fail + and exit 1; + + return $h; +} + +# git_dir_option $SRCDIR +# +# From $SRCDIR, the --git-dir option to pass to git (none if $SRCDIR +# is undef). Return as a list (0 or 1 element). +sub git_dir_option($) +{ + my ($srcdir) = @_; + my @res = (); + if (defined $srcdir) + { + my $qdir = shell_quote $srcdir; + my $cmd = "cd $qdir && git rev-parse --show-toplevel"; + my $qcmd = shell_quote $cmd; + my $git_dir = qx($cmd); + defined $git_dir + or die "$ME: cannot run $qcmd: $!\n"; + $? == 0 + or die "$ME: $qcmd had unexpected exit code or signal ($?)\n"; + chomp $git_dir; + push @res, "--git-dir=$git_dir/.git"; + } + @res; +} + +{ + my $since_date; + my $format_string = '%s%n%b%n'; + my $amend_file; + my $append_dot = 0; + my $cluster = 1; + my $strip_tab = 0; + my $strip_cherry_pick = 0; + my $srcdir; + GetOptions + ( + help => sub { usage 0 }, + version => sub { print "$ME version $VERSION\n"; exit }, + 'since=s' => \$since_date, + 'format=s' => \$format_string, + 'amend=s' => \$amend_file, + 'append-dot' => \$append_dot, + 'cluster!' => \$cluster, + 'strip-tab' => \$strip_tab, + 'strip-cherry-pick' => \$strip_cherry_pick, + 'srcdir=s' => \$srcdir, + ) or usage 1; + + defined $since_date + and unshift @ARGV, "--since=$since_date"; + + # This is a hash that maps an SHA1 to perl code (i.e., s/old/new/) + # that makes a correction in the log or attribution of that commit. + my $amend_code = defined $amend_file ? parse_amend_file $amend_file : {}; + + my @cmd = ('git', + git_dir_option $srcdir, + qw(log --log-size), + '--pretty=format:%H:%ct %an <%ae>%n%n'.$format_string, @ARGV); + open PIPE, '-|', @cmd + or die ("$ME: failed to run '". quoted_cmd (@cmd) ."': $!\n" + . "(Is your Git too old? Version 1.5.1 or later is required.)\n"); + + my $prev_multi_paragraph; + my $prev_date_line = ''; + my @prev_coauthors = (); + while (1) + { + defined (my $in = <PIPE>) + or last; + $in =~ /^log size (\d+)$/ + or die "$ME:$.: Invalid line (expected log size):\n$in"; + my $log_nbytes = $1; + + my $log; + my $n_read = read PIPE, $log, $log_nbytes; + $n_read == $log_nbytes + or die "$ME:$.: unexpected EOF\n"; + + # Extract leading hash. + my ($sha, $rest) = split ':', $log, 2; + defined $sha + or die "$ME:$.: malformed log entry\n"; + $sha =~ /^[0-9a-fA-F]{40}$/ + or die "$ME:$.: invalid SHA1: $sha\n"; + + # If this commit's log requires any transformation, do it now. + my $code = $amend_code->{$sha}; + if (defined $code) + { + eval 'use Safe'; + my $s = new Safe; + # Put the unpreprocessed entry into "$_". + $_ = $rest; + + # Let $code operate on it, safely. + my $r = $s->reval("$code") + or die "$ME:$.:$sha: failed to eval \"$code\":\n$@\n"; + + # Note that we've used this entry. + delete $amend_code->{$sha}; + + # Update $rest upon success. + $rest = $_; + } + + # Remove lines inserted by "git cherry-pick". + if ($strip_cherry_pick) + { + $rest =~ s/^\s*Conflicts:\n.*//sm; + $rest =~ s/^\s*\(cherry picked from commit [\da-f]+\)\n//m; + } + + my @line = split "\n", $rest; + my $author_line = shift @line; + defined $author_line + or die "$ME:$.: unexpected EOF\n"; + $author_line =~ /^(\d+) (.*>)$/ + or die "$ME:$.: Invalid line " + . "(expected date/author/email):\n$author_line\n"; + + # Format 'Copyright-paperwork-exempt: Yes' as a standard ChangeLog + # `(tiny change)' annotation. + my $tiny = (grep (/^Copyright-paperwork-exempt:\s+[Yy]es$/, @line) + ? ' (tiny change)' : ''); + + my $date_line = sprintf "%s %s$tiny\n", + strftime ("%F", localtime ($1)), $2; + + my @coauthors = grep /^Co-authored-by:.*$/, @line; + # Omit meta-data lines we've already interpreted. + @line = grep !/^(?:Signed-off-by:[ ].*>$ + |Co-authored-by:[ ] + |Copyright-paperwork-exempt:[ ] + )/x, @line; + + # Remove leading and trailing blank lines. + if (@line) + { + while ($line[0] =~ /^\s*$/) { shift @line; } + while ($line[$#line] =~ /^\s*$/) { pop @line; } + } + + # Record whether there are two or more paragraphs. + my $multi_paragraph = grep /^\s*$/, @line; + + # Format 'Co-authored-by: A U Thor <email@example.com>' lines in + # standard multi-author ChangeLog format. + for (@coauthors) + { + s/^Co-authored-by:\s*/\t /; + s/\s*</ </; + + /<.*?@.*\..*>/ + or warn "$ME: warning: missing email address for " + . substr ($_, 5) . "\n"; + } + + # If clustering of commit messages has been disabled, if this header + # would be different from the previous date/name/email/coauthors header, + # or if this or the previous entry consists of two or more paragraphs, + # then print the header. + if ( ! $cluster + || $date_line ne $prev_date_line + || "@coauthors" ne "@prev_coauthors" + || $multi_paragraph + || $prev_multi_paragraph) + { + $prev_date_line eq '' + or print "\n"; + print $date_line; + @coauthors + and print join ("\n", @coauthors), "\n"; + } + $prev_date_line = $date_line; + @prev_coauthors = @coauthors; + $prev_multi_paragraph = $multi_paragraph; + + # If there were any lines + if (@line == 0) + { + warn "$ME: warning: empty commit message:\n $date_line\n"; + } + else + { + if ($append_dot) + { + # If the first line of the message has enough room, then + if (length $line[0] < 72) + { + # append a dot if there is no other punctuation or blank + # at the end. + $line[0] =~ /[[:punct:]\s]$/ + or $line[0] .= '.'; + } + } + + # Remove one additional leading TAB from each line. + $strip_tab + and map { s/^\t// } @line; + + # Prefix each non-empty line with a TAB. + @line = map { length $_ ? "\t$_" : '' } @line; + + print "\n", join ("\n", @line), "\n"; + } + + defined ($in = <PIPE>) + or last; + $in ne "\n" + and die "$ME:$.: unexpected line:\n$in"; + } + + close PIPE + or die "$ME: error closing pipe from " . quoted_cmd (@cmd) . "\n"; + # FIXME-someday: include $PROCESS_STATUS in the diagnostic + + # Complain about any unused entry in the --amend=F specified file. + my $fail = 0; + foreach my $sha (keys %$amend_code) + { + warn "$ME:$amend_file: unused entry: $sha\n"; + $fail = 1; + } + + exit $fail; +} + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "my $VERSION = '" +# time-stamp-format: "%:y-%02m-%02d %02H:%02M" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "'; # UTC" +# End: diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm new file mode 100644 index 0000000..a818968 --- /dev/null +++ b/build-aux/test-driver.scm @@ -0,0 +1,180 @@ + +;;;; test-driver.scm - Guile test driver for Automake testsuite harness + +(define script-version "2019-01-15.13") ;UTC + +;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2019 Alex Sassmannshausen <alex@pompo.co> +;;; +;;; This program is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;;; Commentary: +;;; +;;; This script provides a Guile test driver using the SRFI-64 Scheme API for +;;; test suites. SRFI-64 is distributed with Guile since version 2.0.9. +;;; +;;; This script is a lightly modified version of the orignal written by +;;; Matthieu Lirzin. The changes make it suitable for use as part of the +;;; guile-hall infrastructure. +;;; +;;;; Code: + +(use-modules (ice-9 getopt-long) + (ice-9 pretty-print) + (srfi srfi-26) + (srfi srfi-64)) + +(define (show-help) + (display "Usage: + test-driver --test-name=NAME --log-file=PATH --trs-file=PATH + [--expect-failure={yes|no}] [--color-tests={yes|no}] + [--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--] + TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] +The '--test-name', '--log-file' and '--trs-file' options are mandatory. +")) + +(define %options + '((test-name (value #t)) + (log-file (value #t)) + (trs-file (value #t)) + (color-tests (value #t)) + (expect-failure (value #t)) ;XXX: not implemented yet + (enable-hard-errors (value #t)) ;not implemented in SRFI-64 + (brief (value #t)) + (help (single-char #\h) (value #f)) + (version (single-char #\V) (value #f)))) + +(define (option->boolean options key) + "Return #t if the value associated with KEY in OPTIONS is 'yes'." + (and=> (option-ref options key #f) (cut string=? <> "yes"))) + +(define* (test-display field value #:optional (port (current-output-port)) + #:key pretty?) + "Display 'FIELD: VALUE\n' on PORT." + (if pretty? + (begin + (format port "~A:~%" field) + (pretty-print value port #:per-line-prefix "+ ")) + (format port "~A: ~S~%" field value))) + +(define* (result->string symbol #:key colorize?) + "Return SYMBOL as an upper case string. Use colors when COLORIZE is #t." + (let ((result (string-upcase (symbol->string symbol)))) + (if colorize? + (string-append (case symbol + ((pass) "[0;32m") ;green + ((xfail) "[1;32m") ;light green + ((skip) "[1;34m") ;blue + ((fail xpass) "[0;31m") ;red + ((error) "[0;35m")) ;magenta + result + "[m") ;no color + result))) + +(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port) + "Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the +file name of the current the test. COLOR? specifies whether to use colors, +and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The +current output port is supposed to be redirected to a '.log' file." + + (define (test-on-test-begin-gnu runner) + ;; Procedure called at the start of an individual test case, before the + ;; test expression (and expected value) are evaluated. + (let ((result (cute assq-ref (test-result-alist runner) <>))) + (format #t "test-name: ~A~%" (result 'test-name)) + (format #t "location: ~A~%" + (string-append (result 'source-file) ":" + (number->string (result 'source-line)))) + (test-display "source" (result 'source-form) #:pretty? #t))) + + (define (test-on-test-end-gnu runner) + ;; Procedure called at the end of an individual test case, when the result + ;; of the test is available. + (let* ((results (test-result-alist runner)) + (result? (cut assq <> results)) + (result (cut assq-ref results <>))) + (unless brief? + ;; Display the result of each test case on the console. + (format out-port "~A: ~A - ~A~%" + (result->string (test-result-kind runner) #:colorize? color?) + test-name (test-runner-test-name runner))) + (when (result? 'expected-value) + (test-display "expected-value" (result 'expected-value))) + (when (result? 'expected-error) + (test-display "expected-error" (result 'expected-error) #:pretty? #t)) + (when (result? 'actual-value) + (test-display "actual-value" (result 'actual-value))) + (when (result? 'actual-error) + (test-display "actual-error" (result 'actual-error) #:pretty? #t)) + (format #t "result: ~a~%" (result->string (result 'result-kind))) + (newline) + (format trs-port ":test-result: ~A ~A~%" + (result->string (test-result-kind runner)) + (test-runner-test-name runner)))) + + (define (test-on-group-end-gnu runner) + ;; Procedure called by a 'test-end', including at the end of a test-group. + (let ((fail (or (positive? (test-runner-fail-count runner)) + (positive? (test-runner-xpass-count runner)))) + (skip (or (positive? (test-runner-skip-count runner)) + (positive? (test-runner-xfail-count runner))))) + ;; XXX: The global results need some refinements for XPASS. + (format trs-port ":global-test-result: ~A~%" + (if fail "FAIL" (if skip "SKIP" "PASS"))) + (format trs-port ":recheck: ~A~%" + (if fail "yes" "no")) + (format trs-port ":copy-in-global-log: ~A~%" + (if (or fail skip) "yes" "no")) + (when brief? + ;; Display the global test group result on the console. + (format out-port "~A: ~A~%" + (result->string (if fail 'fail (if skip 'skip 'pass)) + #:colorize? color?) + test-name)) + #f)) + + (let ((runner (test-runner-null))) + (test-runner-on-test-begin! runner test-on-test-begin-gnu) + (test-runner-on-test-end! runner test-on-test-end-gnu) + (test-runner-on-group-end! runner test-on-group-end-gnu) + (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple) + runner)) + +;;; +;;; Entry point. +;;; + +(define (main . args) + (let* ((opts (getopt-long (command-line) %options)) + (option (cut option-ref opts <> <>))) + (cond + ((option 'help #f) (show-help)) + ((option 'version #f) (format #t "test-driver.scm ~A" script-version)) + (else + (let ((log (open-file (option 'log-file "") "w0")) + (trs (open-file (option 'trs-file "") "wl")) + (out (duplicate-port (current-output-port) "wl"))) + (redirect-port log (current-output-port)) + (redirect-port log (current-warning-port)) + (redirect-port log (current-error-port)) + (test-with-runner + (test-runner-gnu (option 'test-name #f) + #:color? (option->boolean opts 'color-tests) + #:brief? (option->boolean opts 'brief) + #:out-port out #:trs-port trs) + (load-from-path (option 'test-name #f))) + (close-port log) + (close-port trs) + (close-port out)))) + (exit 0))) diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..7b53d7e --- /dev/null +++ b/configure.ac @@ -0,0 +1,36 @@ + +dnl -*- Autoconf -*- + +AC_INIT([guile-drmaa], [0.1]) +AC_SUBST(AUTHOR, "\"Ricardo Wurmus\"") +AC_SUBST(COPYRIGHT, "'(2020 2021)") +AC_SUBST(LICENSE, gpl3+) +AC_CONFIG_AUX_DIR([build-aux]) +AM_INIT_AUTOMAKE([1.12 silent-rules subdir-objects color-tests parallel-tests -Woverride -Wno-portability]) +AM_SILENT_RULES([yes]) + +AC_CONFIG_FILES([Makefile]) +AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) + +dnl Search for 'guile' and 'guild'. This macro defines +dnl 'GUILE_EFFECTIVE_VERSION'. +GUILE_PKG([3.0 2.2 2.0]) +GUILE_PROGS +GUILE_SITE_DIR +if test "x$GUILD" = "x"; then + AC_MSG_ERROR(['guild' binary not found; please check your Guile installation.]) +fi + +dnl Installation directories for .scm and .go files. +guilemoduledir="${datarootdir}/guile/site/$GUILE_EFFECTIVE_VERSION" +guileobjectdir="${libdir}/guile/$GUILE_EFFECTIVE_VERSION/site-ccache" +AC_SUBST([guilemoduledir]) +AC_SUBST([guileobjectdir]) + +AC_PATH_PROG([SED], [sed]) +if test "x$SED" = "x"; then + AC_MSG_ERROR(['sed' could not be found; it is needed during the build.]) +fi + + +AC_OUTPUT diff --git a/doc/drmaa.texi b/doc/drmaa.texi new file mode 100644 index 0000000..494adc1 --- /dev/null +++ b/doc/drmaa.texi @@ -0,0 +1,87 @@ + +\input texinfo +@c -*-texinfo-*- + +@c %**start of header +@setfilename guile-drmaa.info +@documentencoding UTF-8 +@settitle Guile DRMAA Reference Manual +@c %**end of header + +@include version.texi + +@copying +Copyright @copyright{} 2020 Ricardo Wurmus + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A +copy of the license is included in the section entitled ``GNU Free +Documentation License''. +@end copying + +@dircategory The Algorithmic Language Scheme +@direntry +* Guile DRMAA: (guile-drmaa). +@end direntry + +@titlepage +@title The Guile DRMAA Manual +@author Ricardo Wurmus + +@page +@vskip 0pt plus 1filll +Edition @value{EDITION} @* +@value{UPDATED} @* + +@insertcopying +@end titlepage + +@contents + +@c ********************************************************************* +@node Top +@top Guile DRMAA + +This document describes Guile DRMAA version @value{VERSION}. + +@menu +* Introduction:: Why Guile DRMAA? +* Installation:: How do I install it? +@end menu + +@c ********************************************************************* +@node Introduction +@chapter Introduction + +DRMAA stands for @dfn{Distributed Resource Management Application +API}; it's a common specification implemented in different HPC cluster +schedulers to allow for programmatic submission and management of +compute jobs. + +There are two versions of the DRMAA specifications: most cluster +scheduler systems support the old version 1.0; the more recent version +2.0 has only few implementations. + +Guile DRMAA currently only provides bindings for version 1.0, allowing +you to manage jobs on most cluster schedulers with Guile Scheme. + +@c ********************************************************************* +@node Installation +@chapter Installation + +Guile DRMAA uses the GNU build system. To install Guile DRMAA from +a release tarball just unpack it and run the usual commands: + +@example +./configure +make +make install +@end example + +If you want to build the sources from the source repository you need to +bootstrap the build system first. Run the @code{bootstrap.sh} script +first and then perform the above steps. + +@bye diff --git a/drmaa/v1/ffi.ffi b/drmaa/v1/ffi.ffi new file mode 100644 index 0000000..4327926 --- /dev/null +++ b/drmaa/v1/ffi.ffi @@ -0,0 +1,20 @@ +;;; Guile DRMAA --- Guile bindings for DRMAA +;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; This file is part of Guile DRMAA. +;;; +;;; Guile DRMAA is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Guile DRMAA is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Guile DRMAA. If not, see <http://www.gnu.org/licenses/>. + +(define-ffi-module (drmaa v1 ffi) + #:include '("include/drmaa.h")) diff --git a/drmaa/v1/low.scm b/drmaa/v1/low.scm new file mode 100644 index 0000000..76f0e73 --- /dev/null +++ b/drmaa/v1/low.scm @@ -0,0 +1,655 @@ +;;; Guile DRMAA --- Guile bindings for DRMAA +;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; This file is part of Guile DRMAA. +;;; +;;; Guile DRMAA is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Guile DRMAA is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Guile DRMAA. If not, see <http://www.gnu.org/licenses/>. + +(define-module (drmaa v1 low) + #:use-module (drmaa v1 ffi) + #:use-module (bytestructures guile) + #:use-module (system foreign) + #:use-module (system ffi-help-rt) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (rnrs enums) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:export (DRMAA + + get-next-attr-name! + get-next-attr-value! + get-next-job-id! + get-num-attr-names + get-num-attr-values + get-num-job-ids + release-attr-names! + release-attr-values! + release-job-ids! + + init-session! + exit-session! + + allocate-job-template! + delete-job-template! + set-attribute! + get-attribute + set-vector-attribute! + get-vector-attribute + get-attribute-names + get-vector-attribute-names + + run-job + run-bulk-jobs + + control + job-ps + synchronize + wait + + w-if-exited? + w-exit-status + w-if-signaled? + w-termsig + w-coredump? + w-if-aborted? + + get-contact + drmaa-version + get-drm-system + get-drmaa-implementation)) + +;; XXX: patch (drmaa v1 ffi) because it uses an undefined +;; procedure. The generated code for drmaa_set_vector_attribute uses +;; unwrap~array, which is not implemented in ffi-help-rt. +;; (This may not be necessary for nyacc 1.03.1+.) +(module-define! (resolve-module '(drmaa v1 ffi)) + 'unwrap~array + (@@ (drmaa v1 ffi) unwrap~pointer)) + +(define (make-cstr-array string-list) + "Return a bytevector containing pointers to each of the strings in +STRING-LIST." + (let* ((n (length string-list)) + (pointers (map string->pointer string-list)) + (addresses (map pointer-address pointers)) + (bv (make-bytevector (* (1+ n) (sizeof '*)))) + (bv-set! (case (sizeof '*) + ((4) bytevector-u32-native-set!) + ((8) bytevector-u64-native-set!)))) + (for-each (lambda (address index) + (bv-set! bv (* (sizeof '*) index) address)) + addresses (iota n)) + ;; The vector must be NULL-terminated + (bv-set! bv (1+ n) 0) + bv)) + +(define-syntax-rule (return ret success error-message) + (cond + ((eq? ret (DRMAA 'ERRNO_SUCCESS)) success) + (else + (raise (condition + (&message + (message + (format #false "~a (~a)" + (char*->string error-message) + ret)))))))) + +(define (DRMAA sym) + (or (drmaa-v1-ffi-symbol-val (symbol-append 'DRMAA_ sym)) + (raise (condition + (&message + (message + (format #false "Unknown DRMAA symbol: ~a" sym))))))) + + +;;; String vector helpers + +(define (get-next-attr-name! names) + (let* ((name + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ATTR_BUFFER))))) + (ret (drmaa_get_next_attr_name + names name + (DRMAA 'ATTR_BUFFER)))) + (and (eq? ret (DRMAA 'ERRNO_SUCCESS)) + (char*->string name)))) + +(define (get-next-attr-value! values) + (let* ((value + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ATTR_BUFFER))))) + (ret (drmaa_get_next_attr_value + values value + (DRMAA 'ATTR_BUFFER)))) + (and (eq? ret (DRMAA 'ERRNO_SUCCESS)) + (char*->string value)))) + +(define (get-next-job-id! values) + (let* ((value + (make-char* (bytevector->pointer + ;; TODO: Perhaps not correct to use JOBNAME_BUFFER here + (make-bytevector (DRMAA 'JOBNAME_BUFFER))))) + (ret (drmaa_get_next_job_id + values value + ;; TODO: Perhaps not correct to use JOBNAME_BUFFER here + (DRMAA 'JOBNAME_BUFFER)))) + (and (eq? ret (DRMAA 'ERRNO_SUCCESS)) + (char*->string value)))) + +(define (get-num-attr-names values) + (let* ((size (make-size_t)) + (ret (drmaa_get_num_attr_names + values (pointer-to size)))) + (and (eq? ret (DRMAA 'ERRNO_SUCCESS)) + (fh-object-ref size)))) + +(define (get-num-attr-values values) + (let* ((size (make-size_t)) + (ret (drmaa_get_num_attr_values + values (pointer-to size)))) + (and (eq? ret (DRMAA 'ERRNO_SUCCESS)) + (fh-object-ref size)))) + +(define (get-num-job-ids values) + (let* ((size (make-size_t)) + (ret (drmaa_get_num_job_ids + values (pointer-to size)))) + (and (eq? ret (DRMAA 'ERRNO_SUCCESS)) + (fh-object-ref size)))) + +(define (release-attr-names! values) + (drmaa_release_attr_names values) + #true) + +(define (release-attr-values! values) + (drmaa_release_attr_values values) + #true) + +(define (release-job-ids! values) + (drmaa_release_job_ids values) + #true) + +(define (extract type) + (define next + (match type + ('job-id get-next-job-id!) + ('name get-next-attr-name!) + ('value get-next-attr-value!))) + (define release + (match type + ('job-id release-job-ids!) + ('name release-attr-names!) + ('value release-attr-values!))) + (lambda (values) + (let loop ((res '())) + (let ((item (next values))) + (if item + (loop (cons item res)) + (begin + (release values) + (reverse res))))))) + +(define extract-job-ids + (extract 'job-id)) +(define extract-names + (extract 'name)) +(define extract-values + (extract 'value)) + + +;;; Session management + +(define* (init-session! #:optional contact) + "Initialize the DRMAA library and create a new DRMAA session. If +the binary module provides only one DRMAA implementation, the string +CONTACT need not be provided; in that case the default implementation +will be used." + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_init (or contact %null-pointer) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + #true + error-message))) + +(define (exit-session!) + "Terminate an existing DRMAA session. Queued and running jobs will +not be affected by this." + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_exit error-message + (DRMAA 'ERROR_STRING_BUFFER)) + #true + error-message))) + + +;;; Job templates + +(define (allocate-job-template!) + (let ((template (make-drmaa_job_template_t*)) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_allocate_job_template (pointer-to template) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + template + error-message))) + +(define (delete-job-template! template) + ;; TODO: Call this in a finalizer. + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_delete_job_template template + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + #true + error-message))) + +(define (set-attribute! template name value) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_set_attribute template + (string->pointer name) value + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + #true + error-message))) + +(define (get-attribute template name) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER))))) + (value + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ATTR_BUFFER)))))) + (return (drmaa_get_attribute template + (string->pointer name) + value + (DRMAA 'ATTR_BUFFER) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (char*->string value) + error-message))) + +(define (set-vector-attribute! template name . values) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER))))) + (array (make-cstr-array values))) + (return (drmaa_set_vector_attribute template + name + (bytevector->pointer array) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + #true + error-message))) + +(define (get-vector-attribute template name) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER))))) + (values (make-drmaa_attr_values_t*))) + (return (drmaa_get_vector_attribute template + name + (pointer-to values) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (extract-values values) + error-message))) + +(define (get-attribute-names) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER))))) + (names (make-drmaa_attr_names_t*))) + (return (drmaa_get_attribute_names (pointer-to names) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (extract-names names) + error-message))) + +(define (get-vector-attribute-names) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER))))) + (names (make-drmaa_attr_names_t*))) + (return (drmaa_get_vector_attribute_names (pointer-to names) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (extract-names names) + error-message))) + + +;;; Job submission + +(define (run-job template) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER))))) + (job-id + (make-char* (bytevector->pointer + ;; TODO: Perhaps not correct to use JOBNAME_BUFFER here + (make-bytevector (DRMAA 'JOBNAME_BUFFER)))))) + (return (drmaa_run_job job-id + ;; TODO: Perhaps not correct to use JOBNAME_BUFFER here + (DRMAA 'JOBNAME_BUFFER) + template + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (char*->string job-id) + error-message))) + +(define* (run-bulk-jobs template end + #:key + (start 1) (increment 1)) + "Submit a set of parametric jobs, which can be run concurrently. +The attributes defined in TEMPLATE are used for every job in the set. +Each job is identical except for its index. The first job has an +index equal to START; the next has an index equal to the sum of START +and INCREMENT. END is the maximum value of the index, but the value +of the last job's index may not be equal to END if the difference +between START and END is not evenly divisible by INCREMENT. + +Return a list of job identifiers." + (unless (positive? start) + (raise (condition + (&message + (message "`start' must be greater than or equal to 1"))))) + (unless (<= start end) + (raise (condition + (&message + (message "`start' must be less than or equal to `end'"))))) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER))))) + (job-ids (make-drmaa_job_ids_t*))) + (return (drmaa_run_bulk_jobs + (pointer-to job-ids) + template + start end increment + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (extract-job-ids job-ids) + error-message))) + + +;;; Job status and control + +(define (control job-id action) + "Enact the ACTION on the job identified by JOB-ID. The following +symbols are considered valid actions: suspend, resume, hold, release, +and terminate. If JOB-ID is the symbol *, all jobs submitted during +the current session will be affected." + (unless (member action '(suspend resume hold release terminate)) + (raise (condition + (&message + (message + (format #false "Invalid action: ~a" action)))))) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER))))) + (action + (DRMAA (symbol-append 'CONTROL_ + (string->symbol + (string-upcase + (symbol->string action))))))) + (return (drmaa_control (match job-id + ('* (DRMAA 'JOB_IDS_SESSION_ALL)) + (_ job-id)) + action + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + #true + error-message))) + +(define (job-status->symbol status-code) + (cond + ((eq? status-code (DRMAA 'PS_FAILED)) + 'failed) + ((eq? status-code (DRMAA 'PS_DONE)) + 'done) + ((eq? status-code (DRMAA 'PS_USER_SYSTEM_SUSPENDED)) + 'user-system-suspended) + ((eq? status-code (DRMAA 'PS_USER_SUSPENDED)) + 'user-suspended) + ((eq? status-code (DRMAA 'PS_RUNNING)) + 'running) + ((eq? status-code (DRMAA 'PS_USER_SYSTEM_ON_HOLD)) + 'user-system-on-hold) + ((eq? status-code (DRMAA 'PS_USER_ON_HOLD)) + 'user-on-hold) + ((eq? status-code (DRMAA 'PS_SYSTEM_ON_HOLD)) + 'system-on-hold) + ((eq? status-code (DRMAA 'PS_QUEUED_ACTIVE)) + 'queued-active) + ((eq? status-code (DRMAA 'PS_UNDETERMINED)) + 'undetermined) + (else + (raise (condition + (&message + (message + (format #false "Unexpected status: ~a" status-code)))))))) + +(define (job-ps job-id) + (let ((error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER))))) + (status-code (make-uint8))) + (return (drmaa_job_ps job-id + (pointer-to status-code) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (job-status->symbol status-code) + error-message))) + +(define (synchronize job-ids timeout dispose?) + (let ((timeout + (or timeout (DRMAA 'TIMEOUT_WAIT_FOREVER))) + (job-ids (make-cstr-array job-ids)) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_synchronize (bytevector->pointer job-ids) + timeout + (if dispose? 1 0) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + #true error-message))) + +(define (wait job-id timeout) + (let ((timeout + (or timeout (DRMAA 'TIMEOUT_WAIT_FOREVER))) + (job-id-out + (make-char* (bytevector->pointer + ;; TODO: Perhaps not correct to use JOBNAME_BUFFER here + (make-bytevector (DRMAA 'JOBNAME_BUFFER))))) + (status-code (make-uint8)) + (rusage (make-drmaa_attr_values_t*)) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_wait (match job-id + ('* (DRMAA 'JOB_IDS_SESSION_ANY)) + (_ job-id)) + job-id-out + ;; TODO: Perhaps not correct to use JOBNAME_BUFFER here + (DRMAA 'JOBNAME_BUFFER) + (pointer-to status-code) + timeout + (pointer-to rusage) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (values job-id-out status-code (extract-values rusage)) + error-message))) + +(define (w-if-exited? status-code) + (let ((exited (make-uint8)) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_wifexited (pointer-to exited) + status-code + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (positive? exited) + error-message))) + +(define (w-exit-status status-code) + (let ((exit-status (make-uint8)) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_wexitstatus (pointer-to exit-status) + status-code + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + exit-status + error-message))) + +(define (w-if-signaled? status-code) + "Return #TRUE if the job was terminated because it received a signal." + (let ((signaled (make-uint8)) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_wifsignaled (pointer-to signaled) + status-code + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (positive? signaled) + error-message))) + +(define (w-termsig status-code) + "Return the name of the signal that terminated the job." + (let ((signal + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'SIGNAL_BUFFER))))) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_wtermsig signal + (DRMAA 'SIGNAL_BUFFER) + status-code + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (char*->string signal) + error-message))) + +(define (w-coredump? status-code) + "Return #TRUE if the STATUS-CODE indicates that a core image of the +terminated job was created." + (let ((core-dumped (make-uint8)) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_wcoredump (pointer-to core-dumped) + status-code + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (positive? core-dumped) + error-message))) + +(define (w-if-aborted? status-code) + "Return #TRUE if the STATUS-CODE indicates that the job ended before +entering the running state." + (let ((aborted (make-uint8)) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_wifaborted (pointer-to aborted) + status-code + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (positive? aborted) + error-message))) + + +;;; Auxilliary functions + +(define (get-contact) + "When called before INIT-SESSION! return a string containing a +comma-delimited list of default DRMAA implementation contact strings, +one per DRM implementation provided. If called after INIT-SESSION! +return the contact string for the DRM system for which the library has +been initialized." + (let ((contact + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'CONTACT_BUFFER))))) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_get_DRM_system contact + (DRMAA 'CONTACT_BUFFER) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (char*->string contact) + error-message))) + +(define (drmaa-version) + "Return as a pair the major and minor version of the DRMAA C binding +specification implemented by the selected DRMAA implementation." + (let ((major (make-uint8)) + (minor (make-uint8)) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_version (pointer-to major) + (pointer-to minor) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (cons (fh-object-ref major) + (fh-object-ref minor)) + error-message))) + +(define (get-drm-system) + "When called before INIT-SESSION! return a string containing a +comma-delimited list of DRM system identifiers, one per DRM system +implementation provided. If called after INIT-SESSION! return the +selected DRM system." + (let ((drm-system + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'DRM_SYSTEM_BUFFER))))) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_get_DRM_system drm-system + (DRMAA 'DRM_SYSTEM_BUFFER) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (char*->string drm-system) + error-message))) + +(define (get-drmaa-implementation) + "When called before INIT-SESSION! return a string containing a +comma-delimited list of DRMAA implementations, one per DRMAA +implementation provided. If called after INIT-SESSION! return the +selected DRMAA implementation." + (let ((drmaa-implementation + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'DRMAA_IMPL_BUFFER))))) + (error-message + (make-char* (bytevector->pointer + (make-bytevector (DRMAA 'ERROR_STRING_BUFFER)))))) + (return (drmaa_get_DRMAA_implementation drmaa-implementation + (DRMAA 'DRMAA_IMPL_BUFFER) + error-message + (DRMAA 'ERROR_STRING_BUFFER)) + (char*->string drmaa-implementation) + error-message))) diff --git a/guix.scm b/guix.scm new file mode 100644 index 0000000..c616028 --- /dev/null +++ b/guix.scm @@ -0,0 +1,37 @@ +(use-modules + (guix packages) + ((guix licenses) #:prefix license:) + (guix download) + (guix build-system gnu) + (gnu packages) + (gnu packages autotools) + (gnu packages base) + (gnu packages mes) + (gnu packages guile) + (gnu packages guile-xyz) + (gnu packages pkg-config) + (gnu packages texinfo) + (gnu packages parallel)) + +(package + (name "guile-drmaa") + (version "0.1") + (source "./guile-drmaa-0.1.tar.gz") + (build-system gnu-build-system) + (arguments `()) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config) + ("texinfo" ,texinfo) + ("sed" ,sed))) + (inputs + `(("guile" ,guile-3.0))) + (propagated-inputs + `(("guile-bytestructures" ,guile-bytestructures) + ("nyacc" ,nyacc))) + (synopsis "") + (description "") + (home-page "") + (license license:gpl3+)) + diff --git a/include/drmaa.h b/include/drmaa.h new file mode 100644 index 0000000..f7329ce --- /dev/null +++ b/include/drmaa.h @@ -0,0 +1,567 @@ +/* + * FedStage DRMAA utilities library + * Copyright (C) 2006-2008 FedStage Systems + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see <http://www.gnu.org/licenses/>. + */ +/* + * Documentation taken from: + * + * Distributed Resource Management Application API C Bindings v1.0 + * + * Copyright (C) Global Grid Forum (2003). All Rights Reserved. + * + * This document and translations of it may be copied and furnished to + * others, and derivative works that comment on or otherwise explain it + * or assist in its implementation may be prepared, copied, published + * and distributed, in whole or in part, without restriction of any kind, + * provided that the above copyright notice and this paragraph are included + * on all such copies and derivative works. However, this document itself + * may not be modified in any way, such as by removing the copyright notice + * or references to the GGF or other organizations, except as needed for the + * purpose of developing Grid Recommendations in which case the procedures + * for copyrights defined in the GGF Document process must be followed, + * or as required to translate it into languages other than English. + * + * The limited permissions granted above are perpetual and will not be + * revoked by the GGF or its successors or assigns. + * This document and the information contained herein is provided on an + * "AS IS" basis and THE GLOBAL GRID FORUM DISCLAIMS ALL WARRANTIES, EXPRESS + * OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE + * INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES + * OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. + */ + +/** + * @file drmaa.h + * DRMAA interface functions. + * @author Łukasz Cieśnik <lukasz.ciesnik@fedstage.com> + */ + +#ifndef __DRMAA_H +#define __DRMAA_H + +#include <stddef.h> +#include <stdio.h> + +/** @defgroup drmaa_jobt Job template operations. */ + +/** @defgroup drmaa DRMAA interface. */ +/* @{ */ + +typedef struct drmaa_job_template_s drmaa_job_template_t; +typedef struct drmaa_attr_names_s drmaa_attr_names_t; +typedef struct drmaa_attr_values_s drmaa_attr_values_t; +typedef struct drmaa_job_ids_s drmaa_job_ids_t; + +#define DRMAA_ATTR_BUFFER 1024 +#define DRMAA_CONTACT_BUFFER 1024 +#define DRMAA_DRM_SYSTEM_BUFFER 1024 +#define DRMAA_DRMAA_IMPL_BUFFER 1024 +#define DRMAA_ERROR_STRING_BUFFER 4096 +#define DRMAA_JOBNAME_BUFFER 128 +#define DRMAA_SIGNAL_BUFFER 32 + +#define DRMAA_TIMEOUT_NO_WAIT 0 +#define DRMAA_TIMEOUT_WAIT_FOREVER -1 +#define DRMAA_PS_UNDETERMINED 0x00 +#define DRMAA_PS_QUEUED_ACTIVE 0x10 +#define DRMAA_PS_SYSTEM_ON_HOLD 0x11 +#define DRMAA_PS_USER_ON_HOLD 0x12 +#define DRMAA_PS_USER_SYSTEM_ON_HOLD 0x13 +#define DRMAA_PS_RUNNING 0x20 +#define DRMAA_PS_SYSTEM_SUSPENDED 0x21 +#define DRMAA_PS_USER_SUSPENDED 0x22 +#define DRMAA_PS_USER_SYSTEM_SUSPENDED 0x23 +#define DRMAA_PS_DONE 0x30 +#define DRMAA_PS_FAILED 0x40 +#define DRMAA_CONTROL_SUSPEND 0 +#define DRMAA_CONTROL_RESUME 1 +#define DRMAA_CONTROL_HOLD 2 +#define DRMAA_CONTROL_RELEASE 3 +#define DRMAA_CONTROL_TERMINATE 4 +#define DRMAA_JOB_IDS_SESSION_ALL "DRMAA_JOB_IDS_SESSION_ALL" +#define DRMAA_JOB_IDS_SESSION_ANY "DRMAA_JOB_IDS_SESSION_ANY" + +#define DRMAA_BLOCK_EMAIL "drmaa_block_email" +#define DRMAA_DEADLINE_TIME "drmaa_deadline_time" +#define DRMAA_DURATION_HLIMIT "drmaa_duration_hlimit" +#define DRMAA_DURATION_SLIMIT "drmaa_duration_slimit" +#define DRMAA_ERROR_PATH "drmaa_error_path" +#define DRMAA_INPUT_PATH "drmaa_input_path" +#define DRMAA_JOB_CATEGORY "drmaa_job_category" +#define DRMAA_JOB_NAME "drmaa_job_name" +#define DRMAA_JOIN_FILES "drmaa_join_files" +#define DRMAA_JS_STATE "drmaa_js_state" +#define DRMAA_NATIVE_SPECIFICATION "drmaa_native_specification" +#define DRMAA_OUTPUT_PATH "drmaa_output_path" +#define DRMAA_REMOTE_COMMAND "drmaa_remote_command" +#define DRMAA_START_TIME "drmaa_start_time" +#define DRMAA_TRANSFER_FILES "drmaa_transfer_files" +#define DRMAA_V_ARGV "drmaa_v_argv" +#define DRMAA_V_EMAIL "drmaa_v_email" +#define DRMAA_V_ENV "drmaa_v_env" +#define DRMAA_WCT_HLIMIT "drmaa_wct_hlimit" +#define DRMAA_WCT_SLIMIT "drmaa_wct_slimit" +#define DRMAA_WD "drmaa_wd" + +#define DRMAA_SUBMISSION_STATE_ACTIVE "drmaa_active" +#define DRMAA_SUBMISSION_STATE_HOLD "drmaa_hold" +#define DRMAA_PLACEHOLDER_HD "$drmaa_hd_ph$" +#define DRMAA_PLACEHOLDER_WD "$drmaa_wd_ph$" +#define DRMAA_PLACEHOLDER_INCR "$drmaa_incr_ph$" + +#define DRMAA_ERRNO_SUCCESS 0 +#define DRMAA_ERRNO_INTERNAL_ERROR 1 +#define DRMAA_ERRNO_DRM_COMMUNICATION_FAILURE 2 +#define DRMAA_ERRNO_AUTH_FAILURE 3 +#define DRMAA_ERRNO_INVALID_ARGUMENT 4 +#define DRMAA_ERRNO_NO_ACTIVE_SESSION 5 +#define DRMAA_ERRNO_NO_MEMORY 6 +#define DRMAA_ERRNO_INVALID_CONTACT_STRING 7 +#define DRMAA_ERRNO_DEFAULT_CONTACT_STRING_ERROR 8 +#define DRMAA_ERRNO_NO_DEFAULT_CONTACT_STRING_SELECTED 9 +#define DRMAA_ERRNO_DRMS_INIT_FAILED 10 +#define DRMAA_ERRNO_ALREADY_ACTIVE_SESSION 11 +#define DRMAA_ERRNO_DRMS_EXIT_ERROR 12 +#define DRMAA_ERRNO_INVALID_ATTRIBUTE_FORMAT 13 +#define DRMAA_ERRNO_INVALID_ATTRIBUTE_VALUE 14 +#define DRMAA_ERRNO_CONFLICTING_ATTRIBUTE_VALUES 15 +#define DRMAA_ERRNO_TRY_LATER 16 +#define DRMAA_ERRNO_DENIED_BY_DRM 17 +#define DRMAA_ERRNO_INVALID_JOB 18 +#define DRMAA_ERRNO_RESUME_INCONSISTENT_STATE 19 +#define DRMAA_ERRNO_SUSPEND_INCONSISTENT_STATE 20 +#define DRMAA_ERRNO_HOLD_INCONSISTENT_STATE 21 +#define DRMAA_ERRNO_RELEASE_INCONSISTENT_STATE 22 +#define DRMAA_ERRNO_EXIT_TIMEOUT 23 +#define DRMAA_ERRNO_NO_RUSAGE 24 +#define DRMAA_ERRNO_NO_MORE_ELEMENTS 25 +#define DRMAA_NO_ERRNO 26 /* Try to be compatible with SGE drmaa.h which defines DRMAA error codes as enum */ + +#if defined(__cplusplus) +extern "C" { +#endif + + +/** + * The drmaa_init() function SHALL initialize DRMAA library and create + * a new DRMAA session, using the contact parameter, if provided, to + * determine to which DRMS to connect. This function MUST be called + * before any other DRMAA function, except for drmaa_get_DRM_system(), + * drmaa_get_DRMAA_implementation(), drmaa_get_contact(), and + * drmaa_strerror(). If @a contact is @c NULL, the default DRM system + * SHALL be used, provided there is only one DRMAA implementation + * in the provided binary module. When there is more than one DRMAA + * implementation in the binary module, drmaa_init() SHALL return + * the DRMAA_ERRNO_NO_DEFAULT_CONTACT_STRING_SELECTED error code. + * The drmaa_init() function SHOULD be called by only one of the threads. + * The main thread is RECOMMENDED. A call by another thread SHALL return + * the DRMAA_ERRNO_ALREADY_ACTIVE_SESSION error code. + */ +int drmaa_init( + const char *contact, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The drmaa_exit() function SHALL disengage from DRMAA library and + * allow the DRMAA library to perform any necessary internal cleanup. + * This routine SHALL end the current DRMAA session but SHALL NOT + * affect any jobs (e.g, queued and running jobs SHALL remain queued and + * running). drmaa_exit() SHOULD be called by only one of the threads. + * The first call to call drmaa_exit() by a thread will operate normally. + * All other calls from the same and other threads SHALL fail, returning + * a DRMAA_ERRNO_NO_ACTIVE_SESSION error code. + */ +int drmaa_exit( char *error_diagnosis, size_t error_diag_len ); + + + +/** + * The function drmaa_allocate_job_template() SHALL allocate a new job + * template, returned in @a jt. This template is used to describe the + * job to be submitted. This description is accomplished by setting the + * desired scalar and vector attributes to their appropriate values. This + * template is then used in the job submission process. + * @addtogroup drmaa_jobt + */ +int drmaa_allocate_job_template( + drmaa_job_template_t **jt, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The function drmaa_delete_job_template() SHALL free the job template + * pointed to by @a jt. + * @addtogroup drmaa_jobt + */ +int drmaa_delete_job_template( + drmaa_job_template_t *jt, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The function drmaa_set_attribute() SHALL set the value of the scalar + * attribute, @a name, in the job template, @a jt, to the value, @a value. + * @addtogroup drmaa_jobt + */ +int drmaa_set_attribute( + drmaa_job_template_t *jt, + const char *name, const char *value, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The function drmaa_get_attribute() SHALL fill the @a value buffer with + * up to @a value_len characters of the scalar attribute, @a name's, value + * in the given job template. + * @addtogroup drmaa_jobt + */ +int drmaa_get_attribute( + drmaa_job_template_t *jt, + const char *name, char *value, size_t value_len, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The function drmaa_set_vector_attribute() SHALL set the vector attribute, + * @a name, in the job template, @a jt, to the value(s), @a value. The DRMAA + * implementation MUST accept value values that are arrays of one or more + * strings terminated by a @c NULL entry. + * @addtogroup drmaa_jobt + */ +int drmaa_set_vector_attribute( + drmaa_job_template_t *jt, + const char *name, const char *value[], + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The function drmaa_get_vector_attribute() SHALL store in @a values an + * opaque values string vector containing the values of the vector attribute, + * @a name's, value in the given job template. + * @addtogroup drmaa_jobt + */ +int drmaa_get_vector_attribute( + drmaa_job_template_t *jt, + const char *name, drmaa_attr_values_t **values, + char *error_diagnosis, size_t error_diag_len + ); + + + +/** + * The function drmaa_get_attribute_names() SHALL return the set of supported + * scalar attribute names in an opaque names string vector stored in + * @a values. This vector SHALL include all required scalar attributes, all + * supported optional scalar attributes, all DRM-specific scalar attributes, + * and no unsupported optional attributes. + */ +int drmaa_get_attribute_names( + drmaa_attr_names_t **values, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The function drmaa_get_vector_attribute_names() SHALL return the set + * of supported vector attribute names in an opaque names string vector + * stored in @a values. This vector SHALL include all required vector + * attributes, all supported optional vector attributes, all DRM-specific + * vector attributes, and no unsupported optional attributes. + */ +int drmaa_get_vector_attribute_names( + drmaa_attr_names_t **values, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * @defgroup drmaa_viter Vector iteration functions. + * @ingroup drmaa + * + * The drmaa_get_next_<i>X</i>() functions SHALL store up to @a value_len + * bytes of the next attribute name / attribute value / job identifier + * from the @a values opaque string vector in the @a value buffer. + * The opaque string vector's internal iterator SHALL then be moved forward + * to the next entry. If there are no more values those functions return + * @ref DRMAA_ERRNO_INVALID_ARGUMENT (but this is outside DRMAA specification). + * + * The drmaa_get_num_<i>X</i>() functions SHALL store the number of elements + * in the space provided by @a size. + * + * The drmaa_release_<i>X</i>() functions free the memory used by the + * @a values opaque string vector. All memory used by strings contained + * therein is also freed. + */ +/* @addtogroup drmaa_viter @{ */ +int drmaa_get_next_attr_name( drmaa_attr_names_t* values, + char *value, size_t value_len ); +int drmaa_get_next_attr_value( drmaa_attr_values_t* values, + char *value, size_t value_len ); +int drmaa_get_next_job_id( drmaa_job_ids_t* values, + char *value, size_t value_len ); +int drmaa_get_num_attr_names( drmaa_attr_names_t* values, size_t *size ); +int drmaa_get_num_attr_values(drmaa_attr_values_t* values, size_t *size ); +int drmaa_get_num_job_ids( drmaa_job_ids_t* values, size_t *size ); +void drmaa_release_attr_names( drmaa_attr_names_t* values ); +void drmaa_release_attr_values( drmaa_attr_values_t* values ); +void drmaa_release_job_ids( drmaa_job_ids_t* values ); +/* @} */ + +/** + * The drmaa_run_job() function submits a single job with the attributes + * defined in the job template, @a jt. Upon success, up to @a job_id_len + * characters of the submitted job's job identifier are stored in the buffer, + * @a job_id. + */ +int drmaa_run_job( + char *job_id, size_t job_id_len, const drmaa_job_template_t *jt, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The drmaa_run_bulk_jobs() function submits a set of parametric jobs which + * can be run concurrently. The attributes defined in the job template, + * @a jt are used for every parametric job in the set. Each job in the + * set is identical except for it's index. The first parametric job has an + * index equal to @a start. The next job has an index equal to @a start + + * @a incr, and so on. The last job has an index equal to <code>start + n * + * incr</code>, where @c n is equal to <code>(end - start) / incr</code>. + * Note that the value of the last job's index may not be equal to end if the + * difference between @a start and @a end is not evenly divisble by @a incr. + * The smallest valid value for @a start is 1. The largest valid value for + * @a end is 2147483647 (2^31-1). The @a start value must be less than or + * equal to the @a end value, and only positive index numbers are allowed. + * The index number can be determined by the job in an implementation + * specific fashion. On success, an opaque job id string vector containing + * job identifiers for all submitted jobs SHALL be returned into @a job_ids. + * The job identifiers in the opaque job id string vector can be extracted + * using the drmaa_get_next_job_id() function. The caller is responsible + * for releasing the opaque job id string vector returned into @a job_ids + * using the drmaa_release_job_ids() function. + */ +int drmaa_run_bulk_jobs( + drmaa_job_ids_t **jobids, + const drmaa_job_template_t *jt, + int start, int end, int incr, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The drmaa_control() function SHALL enact the action indicated + * by @a action on the job specified by the job identifier, @a jobid. + * The action parameter's value may be one of the following: + * - DRMAA_CONTROL_SUSPEND + * - DRMAA_CONTROL_RESUME + * - DRMAA_CONTROL_HOLD + * - DRMAA_CONTROL_RELEASE + * - DRMAA_CONTROL_TERMINATE + * The drmaa_control() function SHALL return after the DRM system has + * acknowledged the command, not necessarily after the desired action has + * been performed. If @a jobid is DRMAA_JOB_IDS_SESSION_ALL, this function + * SHALL perform the specified action on all jobs submitted during this + * session as of this function is called. + */ +int drmaa_control( + const char *job_id, int action, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The drmaa_job_ps() function SHALL store in @a remote_ps the program + * status of the job identified by @a job_id. The possible values of + * a program's staus are: + * - DRMAA_PS_UNDETERMINED + * - DRMAA_PS_QUEUED_ACTIVE + * - DRMAA_PS_SYSTEM_ON_HOLD + * - DRMAA_PS_USER_ON_HOLD + * - DRMAA_PS_USER_SYSTEM_ON_HOLD + * - DRMAA_PS_RUNNING + * - DRMAA_PS_SYSTEM_SUSPENDED + * - DRMAA_PS_USER_SUSPENDED + * - DRMAA_PS_DONE + * - DRMAA_PS_FAILED + * Terminated jobs have a status of DRMAA_PS_FAILED. + */ +int drmaa_job_ps( + const char *job_id, int *remote_ps, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The drmaa_synchronize() function SHALL cause the calling thread to + * block until all jobs specified by @a job_ids have finished execution. + * If @a job_ids contains DRMAA_JOB_IDS_SESSION_ALL, then this function + * SHALL wait for all jobs submitted during this DRMAA session as of the + * point in time when drmaa_synchronize() is called. To avoid thread race + * conditions in multithreaded applications, the DRMAA implementation user + * should explicitly synchronize this call with any other job submission + * calls or control calls that may change the number of remote jobs. + * + * The @a timeout parameter value indicates how many seconds to remain + * blocked in this call waiting for results to become available, before + * returning with a DRMAA_ERRNO_EXIT_TIMEOUT error code. The value, + * DRMAA_TIMEOUT_WAIT_FOREVER, MAY be specified to wait indefinitely for + * a result. The value, DRMAA_TIMEOUT_NO_WAIT, MAY be specified to return + * immediately with a DRMAA_ERRNO_EXIT_TIMEOUT error code if no result is + * available. If the call exits before the timeout has elapsed, all the + * jobs have been waited on or there was an interrupt. The caller should + * check system time before and after this call in order to be sure of how + * much time has passed. The @a dispose parameter specifies how to treat + * the reaping of the remote job's internal data record, which includes a + * record of the job's consumption of system resources during its execution + * and other statistical information. If the @a dispose parameter's value + * is 1, the DRMAA implementation SHALL dispose of the job's data record at + * the end of the drmaa_synchroniize() call. If the @a dispose parameter's + * value is 0, the data record SHALL be left for future access via the + * drmaa_wait() method. + */ +int drmaa_synchronize( + const char *job_ids[], signed long timeout, int dispose, + char *error_diagnosis, size_t error_diag_len + ); + +/** + * The drmaa_wait() function SHALL wait for a job identified by @a job_id + * to finish execution or fail. If the special string, JOB_IDS_SESSION_ANY, + * is provided as the job_id, this function will wait for any job from the + * session to finish execution or fail. In this case, any job for which exit + * status information is available will satisfy the requirement, including + * jobs which preivously finished but have never been the subject of a + * drmaa_wait() call. This routine is modeled on the @c wait3 POSIX routine. + * + * The @a timeout parameter value indicates how many seconds + * to remain blocked in this call waiting for a result, before + * returning with a DRMAA_ERRNO_EXIT_TIMEOUT error code. The value, + * DRMAA_TIMEOUT_WAIT_FOREVER, MAY be specified to wait indefinitely for + * a result. The value, DRMAA_TIMEOUT_NO_WAIT, MAY be specified to return + * immediately with a DRMAA_ERRNO_EXIT_TIMEOUT error code if no result is + * available. If the call exits before the timeout has elapsed, the job + * has been successfully waited on or there was an interrupt. The caller + * should check system time before and after this call in order to be sure + * of how much time has passed. + * + * Upon success, drmaa_wait() fills @a job_id_out with up to @a + * job_id_out_len characters of the waited job's id, stat with the + * a code that includes information about the conditions under which + * the job terminated, and @a rusage with an array of <name>=<value> + * strings that describe the amount of resources consumed by the job + * and are implementation defined. The @a stat parameter is further + * described below. The @a rusage parameter's values may be accessed via + * drmaa_get_next_attr_value(). + * + * The drmaa_wait() function reaps job data records on a successful + * call, so any subsequent calls to drmaa_wait() will fail, returning + * a DRMAA_ERRNO_INVALID_JOB error code, meaning that the job's data + * record has already been reaped. This error code is the same as + * if the job were unknown. If drmaa_wait() exists due to a timeout, + * DRMAA_ERRNO_EXIT_TIMEOUT is returned and no rusage information is reaped. + * (The only case where drmaa_wait() can be successfully called on a single + * job more than once is when the previous call(s) to drmaa_wait() returned + * DRMAA_ERRNO_EXIT_TIMEOUT.) + * + * The stat parameter, set by a successful call to drmaa_wait(), is used + * to retrieve further input about the exit condition of the waited + * job, identified by job_id_out, through the following functions: + * drmaa_wifexited(), drmaa_wexitstatus(), drmaa_wifsignaled(), + * drmaa_wtermsig(),drmaa_wcoredump() and drmaa_wifaborted(). + */ +int drmaa_wait( + const char *job_id, + char *job_id_out, size_t job_id_out_len, int *stat, + signed long timeout, drmaa_attr_values_t **rusage, + char *error_diagnosis, size_t error_diag_len + ); + +int drmaa_wifexited( int *exited, int stat, + char *error_diagnosis, size_t error_diag_len ); +int drmaa_wexitstatus( int *exit_status, int stat, + char *error_diagnosis, size_t error_diag_len ); +int drmaa_wifsignaled( int *signaled, int stat, + char *error_diagnosis, size_t error_diag_len ); +int drmaa_wtermsig( char *signal, size_t signal_len, int stat, + char *error_diagnosis, size_t error_diag_len ); +int drmaa_wcoredump( int *core_dumped, int stat, + char *error_diagnosis, size_t error_diag_len ); +int drmaa_wifaborted( int *aborted, int stat, + char *error_diagnosis, size_t error_diag_len ); + +/** + * The drmaa_strerror() function SHALL return the error string describing + * the DRMAA error number @a drmaa_errno. + */ +const char *drmaa_strerror( int drmaa_errno ); + +/** + * The drmaa_get_contact() function, if called before drmaa_init(), SHALL + * return a string containing a comma-delimited list of default DRMAA + * implementation contacts strings, one per DRM implementation provided. + * If called after drmaa_init(), drmaa_get_contacts() SHALL return the + * contact string for the DRM system for which the library has been + * initialized. + */ +int drmaa_get_contact( char *contact, size_t contact_len, + char *error_diagnosis, size_t error_diag_len ); + +/** + * The drmaa_version() function SHALL set major and minor to the major and + * minor versions of the DRMAA C binding specification implemented by the + * DRMAA implementation. + */ +int drmaa_version( unsigned int *major, unsigned int *minor, + char *error_diagnosis, size_t error_diag_len ); + +/** + * The drmaa_get_DRM_system() function, if called before drmaa_init(), + * SHALL return a string containing a comma-delimited list of DRM system + * identifiers, one per DRM system implementation provided. If called after + * drmaa_init(), drmaa_get_DRM_system() SHALL return the selected DRM system. + */ +int drmaa_get_DRM_system( char *drm_system, size_t drm_system_len, + char *error_diagnosis, size_t error_diag_len ); + +/** + * The drmaa_get_DRMAA_implementation() function, if called before + * drmaa_init(), SHALL return a string containing a comma-delimited list of + * DRMAA implementations, one per DRMAA implementation provided. If called + * after drmaa_init(), drmaa_get_DRMAA_implementation() SHALL return the + * selected DRMAA implementation. + */ +int drmaa_get_DRMAA_implementation( char *drmaa_impl, size_t drmaa_impl_len, + char *error_diagnosis, size_t error_diag_len ); + +/* @} */ + + + + +int +drmaa_read_configuration_file( + const char *filename, int must_exist, + char *error_diagnosis, size_t error_diag_len + ); + +int +drmaa_read_configuration( + const char *configuration, size_t conf_len, + char *error_diagnosis, size_t error_diag_len + ); + + +#if defined(__cplusplus) +} /* extern "C" */ +#endif + +#endif /* __DRMAA_H */ + diff --git a/pre-inst-env.in b/pre-inst-env.in new file mode 100644 index 0000000..1556fcd --- /dev/null +++ b/pre-inst-env.in @@ -0,0 +1,14 @@ + +#!/bin/sh + +abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" +abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" + +GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" +GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" +export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH + +PATH="$abs_top_builddir/scripts:$PATH" +export PATH + +exec "$@" |