Initial commit.

* Makefile.am: New file.
* bootstrap: New file.
* build-aux/pre-inst-env.in: New file.
* configure.ac: New file.
* loadavg.scm: New file.
* loadavg/config.scm.in: New file.
* loadavg/ui.scm: New file.
* scripts/loadavg.in: New file.

8 files changed, 385 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
new file mode 100644
index 0000000..e7fb007
--- /dev/null
+++ b/Makefile.am
@@ -0,0 +1,95 @@
+# Guile loadavg --- loadavg command-line interface.
+# Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+#
+# This file is part of Guile loadavg.
+#
+# Guile loadavg 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 loadavg 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 loadavg.  If not, see
+# <http://www.gnu.org/licenses/>.
+
+bin_SCRIPTS = scripts/loadavg
+
+# Handle substitution of fully-expanded Autoconf variables.
+do_subst = $(SED)					\
+  -e 's,[@]GUILE[@],$(GUILE),g'
+
+scripts/loadavg: scripts/loadavg.in Makefile
+	$(AM_V_at)rm -f $@ $@-t
+	$(AM_V_at)$(MKDIR_P) "$(@D)"
+	$(AM_V_GEN)$(do_subst) < "$(srcdir)/$@.in" > "$@-t"
+	$(AM_V_at)chmod a+x,a-w "$@-t" && mv -f "$@-t" "$@"
+
+AM_V_GUILEC = $(AM_V_GUILEC_$(V))
+AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY))
+AM_V_GUILEC_0 = @echo "  GUILEC     " $@;
+
+MODULES =				\
+  loadavg/ui.scm			\
+  loadavg.scm
+
+GO_FILES = $(MODULES:%.scm=%.go)
+
+nobase_dist_guilemodule_DATA = $(MODULES)
+nobase_nodist_guileccache_DATA = $(GO_FILES)
+
+# 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>.
+guile_install_go_files = install-nobase_nodist_guileccacheDATA
+$(guile_install_go_files): install-nobase_dist_guilemoduleDATA
+
+GUILEC_ENV =					\
+  GUILE_AUTO_COMPILE=0
+
+GUILEC_OPTS =					\
+  -Warity-mismatch				\
+  -Wformat					\
+  -Wunbound-variable
+
+if GUIX_DIR
+  guix_module_part=":$(guixmoduledir)"
+  guix_ccache_part=":$(guixccachedir)"
+else
+  guix_module_part=
+  guix_ccache_part=
+endif
+
+# Guile PATHs shouldn't be unset: some guix modules want to load
+# (gnutls) module, that's why 'guix' package propagates 'gnutls', i.e.
+# a directory with gnutls module is placed in GUILE_LOAD_PATH.
+
+GUILEC_ENV +=										   \
+  GUILE_LOAD_PATH="$(abs_srcdir)$(guix_module_part):$$GUILE_LOAD_PATH"			   \
+  GUILE_LOAD_COMPILED_PATH="$(abs_builddir)$(guix_ccache_part):$$GUILE_LOAD_COMPILED_PATH"
+
+$(GO_FILES): %.go: %.scm
+	-$(AM_V_GUILEC) $(GUILEC_ENV) \
+	$(GUILD) compile $(GUILEC_OPTS) --output=$@ $<
+
+# Test extensions; has to be unconditional.
+TEST_EXTENSIONS = .scm
+
+SCM_TESTS =					\
+  tests/vm.scm
+
+TESTS = $(SCM_TESTS)
+
+AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" GUILE_AUTO_COMPILE=0
+
+SCM_LOG_DRIVER =				\
+  $(top_builddir)/pre-inst-env			\
+  $(GUILE) --no-auto-compile -e main		\
+      $(top_srcdir)/build-aux/test-driver.scm
+
+AM_SCM_LOG_DRIVER_FLAGS = --brief=yes
diff --git a/bootstrap b/bootstrap
new file mode 100755
index 0000000..cb774bc
--- /dev/null
+++ b/bootstrap
@@ -0,0 +1,5 @@
+#!/bin/sh
+# Create the build system.
+
+set -e -x
+exec autoreconf -vfi
diff --git a/build-aux/pre-inst-env.in b/build-aux/pre-inst-env.in
new file mode 100644
index 0000000..c8c122e
--- /dev/null
+++ b/build-aux/pre-inst-env.in
@@ -0,0 +1,43 @@
+#!/bin/sh
+
+# Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+#
+# This file is part of Guile loadavg.
+#
+# Guile loadavg 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 loadavg 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 loadavg.  If not, see <http://www.gnu.org/licenses/>.
+
+# Usage: ./pre-inst-env COMMAND ARG...
+#
+# Run COMMAND in a pre-installation environment.  Typical use is
+# "./pre-inst-env loadavg".
+
+# By default we may end up with absolute directory names that contain '..',
+# which get into $GUILE_LOAD_PATH, leading to '..' in the module file names
+# recorded by Guile.  To avoid that, make sure we get a real absolute
+# directory name.  Additionally, use '-P' to get the canonical directory name
+# so that Guile's 'relative' %file-port-name-canonicalization can actually
+# work (see <http://bugs.gnu.org/17935>.)
+abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd -P`"
+abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd -P`"
+
+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
+
+# Define $PATH so that `feed' and friends are easily found.
+
+PATH="$abs_top_builddir/scripts:$abs_top_builddir:$PATH"
+export PATH
+
+exec "$@"
diff --git a/configure.ac b/configure.ac
new file mode 100644
index 0000000..f8a1754
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,56 @@
+AC_INIT([Guile-loadavg], [0.0.1], [go.wigust@gmail.com], [guile-loadavg],
+  [https://gitlab.com/wigust/guile-loadavg/])
+
+PKG_CHECK_MODULES([GUILE], [guile-2.2])
+GUILE_PKG([2.2])
+GUILE_PROGS
+AC_ARG_WITH([guile-site-dir],
+  [AS_HELP_STRING([--with-guile-site-dir],
+    [installation directory for Guile (*.scm) files])],
+  [guilemoduledir="$withval"],
+  [guilemoduledir="$datarootdir/guile/site/$GUILE_EFFECTIVE_VERSION"])
+AC_SUBST([guilemoduledir])
+AC_MSG_CHECKING([for the Guile module directory])
+AC_MSG_RESULT([$guilemoduledir])
+
+AC_ARG_WITH([guile-site-ccache-dir],
+  [AS_HELP_STRING([--with-guile-site-ccache-dir],
+    [installation directory for Guile compiled (*.go) files])],
+  [guileccachedir="$withval"],
+  [guileccachedir="$libdir/guile/$GUILE_EFFECTIVE_VERSION/site-ccache"])
+AC_SUBST([guileccachedir])
+AC_MSG_CHECKING([for the Guile ccache directory])
+AC_MSG_RESULT([$guileccachedir])
+
+AC_ARG_WITH([guix-site-dir],
+  [AS_HELP_STRING([--with-guix-site-dir],
+    [directory with Guix modules (*.scm files)])],
+  [guixmoduledir="$withval"],
+  [guixmoduledir=""])
+AC_SUBST([guixmoduledir])
+
+AC_ARG_WITH([guix-site-ccache-dir],
+  [AS_HELP_STRING([--with-guix-site-ccache-dir],
+    [directory with Guix compiled (*.go) files])],
+  [guixccachedir="$withval"],
+  [guixccachedir=""])
+
+dnl If ccache dir is not specified, set it to the module dir.
+AS_IF([test "x$guixccachedir" = "x" -a \
+            "x$guixmoduledir" != "x"],
+      [guixccachedir="$guixmoduledir"])
+
+AC_SUBST([guixccachedir])
+
+AM_CONDITIONAL([GUIX_DIR], [test "x$guixmoduledir" != "x"])
+
+AC_PROG_SED
+
+AM_INIT_AUTOMAKE([foreign])
+AC_CONFIG_FILES([Makefile
+                 loadavg/config.scm])
+
+AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
+  [chmod +x pre-inst-env])
+
+AC_OUTPUT
diff --git a/loadavg.scm b/loadavg.scm
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/loadavg.scm
diff --git a/loadavg/config.scm.in b/loadavg/config.scm.in
new file mode 100644
index 0000000..fd2ea56
--- /dev/null
+++ b/loadavg/config.scm.in
@@ -0,0 +1,38 @@
+;;; Guile loadavg --- loadavg command-line interface.
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;;
+;;; This file is part of Guile loadavg.
+;;;
+;;; Guile loadavg 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 loadavg 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 loadavg.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (loadavg config)
+  #:export (%loadavg-bug-report-address
+            %loadavg-home-page-url
+            %loadavg-package-name
+            %loadavg-version
+
+            %cvm))
+
+(define %loadavg-package-name
+  "@PACKAGE_NAME@")
+
+(define %loadavg-bug-report-address
+  "go.wigust@gmail.com")
+
+(define %loadavg-home-page-url
+  "@PACKAGE_URL@")
+
+(define %loadavg-version
+  "@PACKAGE_VERSION@")
diff --git a/loadavg/ui.scm b/loadavg/ui.scm
new file mode 100644
index 0000000..0ee4adc
--- /dev/null
+++ b/loadavg/ui.scm
@@ -0,0 +1,121 @@
+(define-module (loadavg ui)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-1)
+  #:use-module (ssh session)
+  #:use-module (ssh auth)
+  #:use-module (ssh popen)
+  #:use-module ((guix ui) #:select (colorize-string))
+  #:autoload   (ice-9 ftw)  (scandir)
+  #:use-module ((guix ui) #:select (G_ leave))
+  #:use-module (loadavg config)
+  #:export (loadavg-main))
+
+(define (show-bug-report-information)
+  ;; TRANSLATORS: The placeholder indicates the bug-reporting address for this
+  ;; package.  Please add another line saying "Report translation bugs to
+  ;; ...\n" with the address for translation bugs (typically your translation
+  ;; team's web or email address).
+  (format #t (G_ "
+Report bugs to: ~a.") %loadavg-bug-report-address)
+  (format #t (G_ "
+~a home page: <~a>") %loadavg-package-name %loadavg-home-page-url)
+  (newline))
+
+(define (show-loadavg-usage)
+  (format (current-error-port)
+          "Try `loadavg --help' for more information.~%")
+  (exit 1))
+
+(define (command-files)
+  "Return the list of source files that define LOADAVG sub-commands."
+  (define directory
+    (and=> (search-path %load-path "loadavg.scm")
+           (compose (cut string-append <> "/loadavg/scripts")
+                    dirname)))
+
+  (define dot-scm?
+    (cut string-suffix? ".scm" <>))
+
+  (if directory
+      (scandir directory dot-scm?)
+      '()))
+
+(define (commands)
+  "Return the list of LOADAVG command names."
+  (map (compose (cut string-drop-right <> 4)
+                basename)
+       (command-files)))
+
+(define (show-loadavg-help)
+  (format
+    #t
+    "Usage: loadavg COMMAND ARGS...\nRun COMMAND with ARGS.\n")
+  (newline)
+  (format
+    #t
+    "COMMAND must be one of the sub-commands listed below:\n")
+  (newline)
+  (format
+    #t
+    "~{   ~a~%~}"
+    (sort (commands) string<?))
+  (show-bug-report-information))
+
+(define program-name
+  ;; Name of the command-line program currently executing, or #f.
+  (make-parameter #f))
+
+(define (run-loadavg-command command . args)
+  "Run COMMAND with the given ARGS.  Report an error when COMMAND is not
+found."
+  (define module
+    (catch 'misc-error
+      (lambda ()
+        (resolve-interface `(loadavg scripts ,command)))
+      (lambda -
+        (format (current-error-port)
+                "loadavg: ~a: command not found~%" command)
+        (show-loadavg-usage))))
+
+  (let ((command-main (module-ref module
+                                  (symbol-append 'loadavg- command))))
+    (parameterize ((program-name command))
+      ;; Disable canonicalization so we don't don't stat unreasonably.
+      (with-fluids ((%file-port-name-canonicalization #f))
+        (dynamic-wind
+          (const #f)
+          (lambda ()
+            (apply command-main args))
+          (lambda ()
+            ;; Abuse 'exit-hook' (which is normally meant to be used by the
+            ;; REPL) to run things like profiling hooks upon completion.
+            (run-hook exit-hook)))))))
+
+(define (run-loadavg . args)
+  "Run the 'loadavg' command defined by command line ARGS."
+  ;; The default %LOAD-EXTENSIONS includes the empty string, which doubles the
+  ;; number of 'stat' calls per entry in %LOAD-PATH.  Shamelessly remove it.
+  (set! %load-extensions '(".scm"))
+
+  (match args
+    (()
+     (format (current-error-port) "loadavg: missing command name~%")
+     (show-loadavg-usage))
+    ((or ("-h") ("--help"))
+     (show-loadavg-help))
+    ((command args ...)
+     (apply run-loadavg-command (string->symbol command) args))))
+
+(define (loadavg-main arg0 . args)
+  (apply run-loadavg args))
+
+
+;;;
+;;; main
+;;;
+
+(define* (main #:optional (args (command-line)))
+  (exit (apply loadavg-main args)))
diff --git a/scripts/loadavg.in b/scripts/loadavg.in
new file mode 100644
index 0000000..aa4363d
--- /dev/null
+++ b/scripts/loadavg.in
@@ -0,0 +1,27 @@
+#!@GUILE@ \
+--no-auto-compile -e main -s
+!#
+
+;;; Guile loadavg --- loadavg command-line interface.
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;;
+;;; This file is part of Guile loadavg.
+;;;
+;;; Guile loadavg 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 loadavg 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 loadavg.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define* (main #:optional (args (command-line)))
+  (let ((loadavg-main (module-ref (resolve-interface '(loadavg ui))
+                              'loadavg-main)))
+    (exit (apply loadavg-main args))))