code:
#!/bin/sh
exec guile --no-auto-compile -e main -s "$0" "$@"
!#
;;;; test-driver.scm - Guile test driver for Automake testsuite harness

(define script-version "2021-02-02.05") ;UTC

;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; 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.
;;;
;;;; Code:

(use-modules (ice-9 format)
             (ice-9 getopt-long)
             (ice-9 pretty-print)
             (ice-9 regex)
             (srfi srfi-1)
             (srfi srfi-19)
             (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}]
               [--select=REGEXP] [--exclude=REGEXP] [--errors-only={yes|no}]
               [--enable-hard-errors={yes|no}] [--brief={yes|no}}]
               [--show-duration={yes|no}] [--]
               TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS]
The '--test-name' option is mandatory.  The '--select' and '--exclude' options
allow selecting or excluding individual test cases via a regexp, respectively.
The '--errors-only' option can be set to \"yes\" to limit the logged test case
metadata to only those test cases that failed.  When set to \"yes\", the
'--brief' option disables printing the individual test case result to the
console.  When '--show-duration' is set to \"yes\", the time elapsed per test
case is shown.\n"))

(define %options
  '((test-name                 (value #t))
    (log-file                  (value #t))
    (trs-file                  (value #t))
    (select                    (value #t))
    (exclude                   (value #t))
    (errors-only               (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))
    (show-duration             (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)       "")  ;green
                         ((xfail)      "")  ;light green
                         ((skip)       "")  ;blue
                         ((fail xpass) "")  ;red
                         ((error)      "")) ;magenta
                       result
                       "")          ;no color
        result)))

;;;
;;; SRFI 64 custom test runner.
;;;

(define* (test-runner-gnu test-name #:key color? brief? errors-only?
                          show-duration?
                          (out-port (current-output-port))
                          (trs-port (%make-void-port "w"))
                          select exclude)
  "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.
When BRIEF? is true, the individual test cases results are masked and only the
summary is shown.  ERRORS-ONLY? reduces the amount of test case metadata
logged to only that of the failed test cases.  OUT-PORT and TRS-PORT must be
output ports.  OUT-PORT defaults to the current output port, while TRS-PORT
defaults to a void port, which means no TRS output is logged.  SELECT and
EXCLUDE may take a regular expression to select or exclude individual test
cases based on their names."

  (define test-cases-start-time (make-hash-table))

  (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 ((test-case-name (test-runner-test-name runner))
          (start-time     (current-time time-monotonic)))
      (hash-set! test-cases-start-time test-case-name start-time)))

  (define (test-skipped? runner)
    (eq? 'skip (test-result-kind runner)))

  (define (test-failed? runner)
    (not (or (test-passed? runner)
             (test-skipped? runner))))

  (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 <>))
           (test-case-name (test-runner-test-name runner))
           (start (hash-ref test-cases-start-time test-case-name))
           (end (current-time time-monotonic))
           (time-elapsed (time-difference end start))
           (time-elapsed-seconds (+ (time-second time-elapsed)
                                    (* 1e-9 (time-nanosecond time-elapsed)))))
      (unless (or brief? (and errors-only? (test-skipped? runner)))
        ;; Display the result of each test case on the console.
        (format out-port "~a: ~a - ~a ~@[[~,3fs]~]~%"
                (result->string (test-result-kind runner) #:colorize? color?)
                test-name test-case-name
                (and show-duration? time-elapsed-seconds)))

      (unless (and errors-only? (not (test-failed? 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)
        (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 [~,3fs]~%"
              (result->string (test-result-kind runner))
              (test-runner-test-name runner) time-elapsed-seconds)))

  (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))

;;;
;;; SRFI 64 test specifiers.
;;;
(define (test-match-name* regexp)
  "Return a test specifier that matches a test name against REGEXP."
  (lambda (runner)
    (string-match regexp (test-runner-test-name runner))))

(define (test-match-name*/negated regexp)
  "Return a negated test specifier version of test-match-name*."
  (lambda (runner)
    (not (string-match regexp (test-runner-test-name runner)))))

;;; XXX: test-match-all is a syntax, which isn't convenient to use with a list
;;; of test specifiers computed at run time.  Copy this SRFI 64 internal
;;; definition here, which is the procedural equivalent of 'test-match-all'.
(define (%test-match-all . pred-list)
  (lambda (runner)
    (let ((result #t))
      (let loop ((l pred-list))
	(if (null? l)
	    result
	    (begin
	      (if (not ((car l) runner))
		  (set! result #f))
	      (loop (cdr l))))))))

;;;
;;; 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 (and=> (option 'log-file #f) (cut open-file <> "w0")))
             (trs (and=> (option 'trs-file #f) (cut open-file <> "wl")))
             (out (duplicate-port (current-output-port) "wl"))
             (test-name (option 'test-name #f))
             (select (option 'select #f))
             (exclude (option 'exclude #f))
             (test-specifiers (filter-map
                               identity
                               (list (and=> select test-match-name*)
                                     (and=> exclude test-match-name*/negated))))
             (test-specifier (apply %test-match-all test-specifiers))
             (color-tests (if (assoc 'color-tests opts)
                              (option->boolean opts 'color-tests)
                              #t)))
        (when log
          (redirect-port log (current-output-port))
          (redirect-port log (current-warning-port))
          (redirect-port log (current-error-port)))
        (test-with-runner
            (test-runner-gnu test-name
                             #:color? color-tests
                             #:brief? (option->boolean opts 'brief)
                             #:errors-only? (option->boolean opts 'errors-only)
                             #:show-duration? (option->boolean
                                               opts 'show-duration)
                             #:out-port out #:trs-port trs)
          (test-apply test-specifier
                      (lambda _
                        (load-from-path test-name))))
        (and=> log close-port)
        (and=> trs close-port)
        (close-port out))))
    (exit 0)))

;;; Local Variables:
;;; eval: (add-hook 'write-file-functions 'time-stamp)
;;; time-stamp-start: "(define script-version \""
;;; time-stamp-format: "%:y-%02m-%02d.%02H"
;;; time-stamp-time-zone: "UTC"
;;; time-stamp-end: "\") ;UTC"
;;; End:

;;;; test-driver.scm ends here.


code:
#!/bin/sh

# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
# GNU Guix 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.
#
# GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

# Usage: ./test-env COMMAND ARG...
#
# Run the daemon in the build directory, and run COMMAND within
# `pre-inst-env'.  This is used to run unit tests with the just-built
# daemon, unless `--disable-daemon' was passed at configure time.

# Make sure 'cd' behaves deterministically and doesn't write anything to
# stdout.
unset CDPATH

case "$1" in
    --quiet-stderr)
	# Silence the daemon's output, which is often useless, as well as that
	# of Bash (such as "Terminated" messages when 'guix-daemon' is
	# killed.)
	exec 2> /dev/null
	shift
	;;
esac

if [ -x "@abs_top_builddir@/guix-daemon" ]
then
    NIX_STORE_DIR="@GUIX_TEST_ROOT@/store"

    # Do that because store.scm calls `canonicalize-path' on it.
    mkdir -p "$NIX_STORE_DIR"

    # Canonicalize the store directory name in an attempt to avoid symlinks in
    # it or its parent directories.  See <http://bugs.gnu.org/17935>.
    NIX_STORE_DIR="`cd "@GUIX_TEST_ROOT@/store"; pwd -P`"

    GUIX_LOG_DIRECTORY="@GUIX_TEST_ROOT@/var/log/guix"
    GUIX_DATABASE_DIRECTORY="@GUIX_TEST_ROOT@/db"

    # Choose a PID-dependent name to allow for parallel builds.  Note
    # that the directory name must be chosen so that the socket's file
    # name is less than 108-char long (the size of `sun_path' in glibc).
    # Currently, in Nix builds, we're at ~106 chars...
    GUIX_STATE_DIRECTORY="@GUIX_TEST_ROOT@/var/$$"

    # We can't exit when we reach the limit, because perhaps the test doesn't
    # actually rely on the daemon, but at least warn.
    if test "`echo -n "$GUIX_STATE_DIRECTORY/daemon-socket/socket" | wc -c`" -ge 108
    then
	echo "warning: exceeding socket file name limit; test may fail!" >&2
    fi

    # The configuration directory, for import/export signing keys.
    GUIX_CONFIGURATION_DIRECTORY="@GUIX_TEST_ROOT@/etc"
    if [ ! -d "$GUIX_CONFIGURATION_DIRECTORY" ]
    then
	# Copy the keys so that the secret key has the right permissions (the
	# daemon errors out when this is not the case.)
	mkdir -p "$GUIX_CONFIGURATION_DIRECTORY"
	cp "@abs_top_srcdir@/tests/signing-key.sec"	\
	    "@abs_top_srcdir@/tests/signing-key.pub"	\
	    "$GUIX_CONFIGURATION_DIRECTORY"
	chmod 400 "$GUIX_CONFIGURATION_DIRECTORY/signing-key.sec"
    fi

    # A place to store data of the substituter.
    GUIX_BINARY_SUBSTITUTE_URL="file://$GUIX_STATE_DIRECTORY/substituter-data"
    rm -rf "$GUIX_STATE_DIRECTORY/substituter-data"
    mkdir -p "$GUIX_STATE_DIRECTORY/substituter-data"

    # For a number of tests, we want to allow unsigned narinfos, for
    # simplicity.
    GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES=yes

    # Place for the substituter's cache.
    XDG_CACHE_HOME="$GUIX_STATE_DIRECTORY/cache-$$"

    export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR		\
	GUIX_LOG_DIRECTORY GUIX_STATE_DIRECTORY GUIX_DATABASE_DIRECTORY	\
	GUIX_BINARY_SUBSTITUTE_URL				\
        GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES			\
        GUIX_CONFIGURATION_DIRECTORY XDG_CACHE_HOME

    # Launch the daemon without chroot support because is may be
    # unavailable, for instance if we're not running as root.
    "@abs_top_builddir@/pre-inst-env"				\
	"@abs_top_builddir@/guix-daemon" --disable-chroot	\
	--substitute-urls="$GUIX_BINARY_SUBSTITUTE_URL" &

    daemon_pid=$!
    trap "kill $daemon_pid ; rm -rf $GUIX_STATE_DIRECTORY" EXIT

    # The test suite expects the 'guile-bootstrap' package to be available.
    # Normally the Guile bootstrap tarball is downloaded by a fixed-output
    # derivation but when network access is missing we allow users to drop
    # the tarball in 'gnu/packages/bootstrap/SYSTEM' and "intern" it here.
    bootstrap_directory="@abs_top_builddir@/gnu/packages/bootstrap/@guix_system@"
    if [ -d "$bootstrap_directory" ]
    then
	# Make sure 'guix-daemon' is listening before invoking 'guix
	# download'.
	"@abs_top_builddir@/pre-inst-env" "@GUILE@" -c \
	     '(use-modules (guix))
(let loop ((i 10))
  (catch #t
    (lambda () (open-connection))
    (lambda (key . args)
      (if (zero? i)
          (apply throw key args)
          (begin (usleep 500000) (loop (- i 1)))))))'

	for file in "$bootstrap_directory"/guile-*
	do
	    [ -f "$file" ] &&					\
	    "@abs_top_builddir@/pre-inst-env"			\
		guix download "file://$file" > /dev/null
	done
    fi
fi

# Avoid issues that could stem from l10n, such as language/encoding
# mismatches.
unset LANGUAGE
LC_MESSAGES=C
export LC_MESSAGES

# Disable grafts by default because they can cause things to be built
# regardless of '--dry-run'.
GUIX_BUILD_OPTIONS="--no-grafts"
export GUIX_BUILD_OPTIONS

# Ignore user settings.
unset GUIX_PACKAGE_PATH

storedir="@storedir@"
prefix="@prefix@"
datarootdir="@datarootdir@"
datadir="@datadir@"
localstatedir="@localstatedir@"
export storedir prefix datarootdir datadir localstatedir

"@abs_top_builddir@/pre-inst-env" "$@"
exit $?

repo_name: maximed/guix

license: mit


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;;
;;; This script updates the list of new and updated packages in 'NEWS'.
;;;
;;; Code:

(use-modules (gnu) (guix)
             (guix build utils)
             ((guix ui) #:select (fill-paragraph))
             (srfi srfi-1)
             (srfi srfi-11)
             (ice-9 match)
             (ice-9 rdelim)
             (ice-9 regex)
             (ice-9 vlist)
             (ice-9 pretty-print))

(define %header-rx
  (make-regexp "^\\* Changes in (version )?([0-9.]+) \\(since ([0-9.]+)\\)"))

(define (NEWS->versions port)
  "Return two values: the previous version and the current version as read
from PORT, which is an input port on the 'NEWS' file."
  (let loop ()
    (let ((line (read-line port)))
      (cond ((eof-object? line)
             (error "failed to determine previous and current version"
                    port))
            ((regexp-exec %header-rx line)
             =>
             (lambda (match)
               (values (match:substring match 3)
                       (match:substring match 2))))
            (else
             (loop))))))

(define (skip-to-org-heading port)
  "Read from PORT until an Org heading is found."
  (let loop ()
    (let ((next (peek-char port)))
      (cond ((eqv? next #\*)
             #t)
            ((eof-object? next)
             (error "next heading could not be found"))
            (else
             (read-line port)
             (loop))))))

(define (rewrite-org-section input output heading-rx proc)
  "Write to OUTPUT the text read from INPUT, but with the first Org section
matching HEADING-RX replaced by NEW-HEADING and CONTENTS."
  (let loop ()
    (let ((line (read-line input)))
      (cond ((eof-object? line)
             (error "failed to match heading regexp" heading-rx))
            ((regexp-exec heading-rx line)
             =>
             (lambda (match)
               (proc match output)
               (skip-to-org-heading input)
               (dump-port input output)
               #t))
            (else
             (display line output)
             (newline output)
             (loop))))))

(define (enumeration->paragraph lst)
  "Turn LST, a list of strings, into a single string that is a ready-to-print
paragraph."
  (fill-paragraph (string-join (sort lst string<?) ", ")
                  75))

(define (write-packages-added news-file old new)
  "Write to NEWS-FILE the list of packages added between OLD and NEW."
  (let ((added (lset-difference string=? (map car new) (map car old))))
    (with-atomic-file-replacement news-file
      (lambda (input output)
        (rewrite-org-section input output
                             (make-regexp "^(\\*+).*new packages")
                             (lambda (match port)
                               (let ((stars (match:substring match 1)))
                                 (format port
                                         "~a ~a new packages~%~%"
                                         stars (length added)))))))))

(define (write-packages-updates news-file old new)
  "Write to NEWS-FILE the list of packages upgraded between OLD and NEW."
  (define important
    '("gcc-toolchain" "glibc" "binutils" "gdb"         ;toolchain
      "shepherd" "linux-libre" "xorg-server" "cups"    ;OS
      "gnome" "xfce" "enlightenment" "lxde" "mate"     ;desktop env.
      "guile" "bash" "python" "python2" "perl"         ;languages
      "ghc" "rust" "go" "julia" "r" "ocaml"
      "icedtea" "openjdk" "clojure" "sbcl" "racket"
      "emacs" "gimp" "inkscape" "libreoffice"          ;applications
      "octave" "icecat" "gnupg"))

  (let* ((table    (fold (lambda (package table)
                           (match package
                             ((name . version)
                              (vhash-cons name version table))))
                         vlist-null
                         new))
         (latest   (lambda (name)
                     (let ((versions (vhash-fold* cons '() name table)))
                       (match (sort versions version>?)
                         ((latest . _) latest)))))
         (upgraded (filter-map (match-lambda
                                 ((package . new-version)
                                  (match (assoc package old)
                                    ((_ . old-version)
                                     (and (string=? new-version
                                                    (latest package))
                                          (version>? new-version old-version)
                                          (cons package new-version)))
                                    (_ #f))))
                               new))
         (noteworthy (filter (match-lambda
                               ((package . version)
                                (member package important)))
                             upgraded)))
    (with-atomic-file-replacement news-file
      (lambda (input output)
        (rewrite-org-section input output
                             (make-regexp "^(\\*+).*package updates")
                             (lambda (match port)
                               (let ((stars (match:substring match 1))
                                     (lst   (map (match-lambda
                                                   ((package . version)
                                                    (string-append package " "
                                                                   version)))
                                                 noteworthy)))
                                 (format port
                                         "~a ~a package updates~%~%Noteworthy updates:~%~a~%~%"
                                         stars (length upgraded)
                                         (enumeration->paragraph lst)))))))))

(define (main . args)
  (match args
    ((news-file data-directory)
     ;; Don't browse things listed in the user's $GUIX_PACKAGE_PATH and
     ;; in external channels.
     (parameterize ((%package-module-path
                     %default-package-module-path))
       (define (package-file version)
         (string-append data-directory "/packages-"
                        version ".txt"))

       (define (package<? p1 p2)
         (string<? (package-full-name p1) (package-full-name p2)))

       (let-values (((previous-version new-version)
                     (call-with-input-file news-file NEWS->versions)))
         (format (current-error-port) "Updating NEWS for ~a to ~a...~%"
                 previous-version new-version)
         (let* ((old (call-with-input-file (package-file previous-version)
                       read))
                (all-packages/sorted (sort (fold-packages (lambda (p r)
                                                            (cons p r))
                                                          '())
                                           package<?))
                (new (map (lambda (p)
                            (cons (package-name p) (package-version p)))
                          all-packages/sorted)))
           (call-with-output-file (package-file new-version)
             (lambda (port)
               (pretty-print new port)))

           (write-packages-added news-file old new)
           (write-packages-updates news-file old new)))))
    (x
     (format (current-error-port) "Usage: update-NEWS NEWS-FILE DATA-DIRECTORY

Update the list of new and updated packages in NEWS-FILE using the
previous-version package list from DATA-DIRECTORY.\n")
     (exit 1))))

(apply main (cdr (command-line)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;;
;;; This scripts updates the definition of the 'guix' package in Guix for the
;;; current commit.  It requires Git to be installed.
;;;
;;; Code:

(use-modules (guix)
             (guix ui)
             (guix git-download)
             (guix upstream)
             (guix utils)
             (guix base32)
             (guix build utils)
             (guix scripts hash)
             (gnu packages package-management)
             (ice-9 match)
             (ice-9 popen)
             (ice-9 regex)
             (ice-9 textual-ports)
             (srfi srfi-1)
             (srfi srfi-2)
             (srfi srfi-26))

(define %top-srcdir
  (string-append (current-source-directory) "/.."))

(define (package-definition-location)
  "Return the source properties of the definition of the 'guix' package."
  (call-with-input-file (location-file (package-location guix))
    (lambda (port)
      (let loop ()
        (match (read port)
          ((? eof-object?)
           (error "definition of 'guix' package could not be found"
                  (port-filename port)))
          (('define-public 'guix value)
           (source-properties value))
          (_
           (loop)))))))

(define* (update-definition commit hash
                            #:key version old-hash)
  "Return a one-argument procedure that takes a string, the definition of the
'guix' package, and returns a string, the update definition for VERSION,
COMMIT."
  (define (linear-offset str line column)
    ;; Return the offset in characters to reach LINE and COLUMN (both
    ;; zero-indexed) in STR.
    (call-with-input-string str
      (lambda (port)
        (let loop ((offset 0))
          (cond ((and (= (port-column port) column)
                      (= (port-line port) line))
                 offset)
                ((eof-object? (read-char port))
                 (error "line and column not reached!"
                        str))
                (else
                 (loop (+ 1 offset))))))))

  (define (update-hash str)
    ;; Replace OLD-HASH with HASH in STR.
    (string-replace-substring str
                              (bytevector->nix-base32-string old-hash)
                              (bytevector->nix-base32-string hash)))

  (lambda (str)
    (match (call-with-input-string str read)
      (('let (('version old-version)
              ('commit old-commit)
              ('revision old-revision))
         defn)
       (let* ((location (source-properties defn))
              (line     (assq-ref location 'line))
              (column   0)
              (offset   (linear-offset str line column)))
         (string-append (format #f "(let ((version \"~a\")
        (commit \"~a\")
        (revision ~a))\n"
                                (or version old-version)
                                commit
                                (if (and version
                                         (not (string=? version old-version)))
                                    0
                                    (+ 1 old-revision)))
                        (string-drop (update-hash str) offset))))
      (exp
       (error "'guix' package definition is not as expected" exp)))))

(define (git-add-worktree directory commit)
  "Create a new git worktree at DIRECTORY, detached on commit COMMIT."
  (invoke "git" "worktree" "add" "--detach" directory commit))

(define (call-with-temporary-git-worktree commit proc)
  "Execute PROC in the context of a temporary git worktree created from
COMMIT.  PROC receives the temporary directory file name as an argument."
  (call-with-temporary-directory
   (lambda (tmp-directory)
     (dynamic-wind
       (lambda ()
         #t)
       (lambda ()
         (git-add-worktree tmp-directory commit)
         (proc tmp-directory))
       (lambda ()
         (invoke "git" "worktree" "remove" "--force" tmp-directory))))))

(define %savannah-guix-git-repo-push-url-regexp
  "git.(savannah|sv).gnu.org:?/srv/git/guix.git \\(push\\)")

(define-syntax-rule (with-input-pipe-to-string prog arg ...)
  (let* ((input-pipe (open-pipe* OPEN_READ prog arg ...))
	 (output (get-string-all input-pipe))
	 (exit-val (status:exit-val (close-pipe input-pipe))))
    (unless (zero? exit-val)
      (error (format #f "Command ~s exited with non-zero exit status: ~s"
                     (string-join (list prog arg ...)) exit-val)))
    (string-trim-both output)))

(define (find-origin-remote)
  "Find the name of the git remote with the Savannah Guix git repo URL."
  (and-let* ((remotes (string-split (with-input-pipe-to-string
                                     "git" "remote" "-v")
                                    #\newline))
             (origin-entry (find (cut string-match
                                      %savannah-guix-git-repo-push-url-regexp
                                      <>)
                                 remotes)))
    (first (string-split origin-entry #\tab))))

(define (commit-already-pushed? remote commit)
  "True if COMMIT is found in the REMOTE repository."
  (not (string-null? (with-input-pipe-to-string
                      "git" "branch" "-r" "--contains" commit
                      (string-append remote "/master")))))

(define (keep-source-in-store store source)
  "Add SOURCE to the store under the name that the 'guix' package expects."

  ;; Add SOURCE to the store, but this time under the real name used in the
  ;; 'origin'.  This allows us to build the package without having to make a
  ;; real checkout; thus, it also works when working on a private branch.
  (reload-module
   (resolve-module '(gnu packages package-management)))

  (let* ((source (add-to-store store
                               (origin-file-name (package-source guix))
                               #t "sha256" source
                               #:select? (git-predicate source)))
         (root   (store-path-package-name source)))

    ;; Add an indirect GC root for SOURCE in the current directory.
    (false-if-exception (delete-file root))
    (symlink source root)
    (add-indirect-root store
                       (string-append (getcwd) "/" root))

    (info (G_ "source code kept in ~a (GC root: ~a)~%")
          source root)))

(define (main . args)
  (match args
    ((commit version)
     (with-directory-excursion %top-srcdir
       (or (getenv "GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT")
           (let ((remote (find-origin-remote)))
             (unless remote
               (leave (G_ "Failed to find the origin git remote.~%")))
             (commit-already-pushed? remote commit))
           (leave (G_ "Commit ~a is not pushed upstream.  Aborting.~%") commit))
       (call-with-temporary-git-worktree commit
           (lambda (tmp-directory)
             (let* ((hash (nix-base32-string->bytevector
                           (string-trim-both
                            (with-output-to-string
		              (lambda ()
		                (guix-hash "-rx" tmp-directory))))))
                    (location (package-definition-location))
                    (old-hash (content-hash-value
                               (origin-hash (package-source guix)))))
               (edit-expression location
                                (update-definition commit hash
                                                   #:old-hash old-hash
                                                   #:version version))
               ;; When GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT is set, the sources are
               ;; added to the store.  This is used as part of 'make release'.
               (when (getenv "GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT")
                 (with-store store
                   (keep-source-in-store store tmp-directory))))))))
    ((commit)
     ;; Automatically deduce the version and revision numbers.
     (main commit #f))))

(apply main (cdr (command-line)))


code:
dnl -*- Autoconf -*- fragment for the C++ daemon.

AC_MSG_CHECKING([whether to build daemon])
AC_MSG_RESULT([$guix_build_daemon])

dnl C++ environment.  This macro must be used unconditionnaly.
AC_PROG_CXX
AM_PROG_AR
AC_LANG([C++])

if test "x$guix_build_daemon" = "xyes"; then

  GUIX_ASSERT_CXX11

  AC_PROG_RANLIB
  AC_CONFIG_HEADERS([nix/config.h])

  dnl Use 64-bit file system calls so that we can support files > 2 GiB.
  AC_SYS_LARGEFILE

  dnl Look for zlib, a required dependency.
  AC_CHECK_LIB([z], [gzdopen], [true],
    [AC_MSG_ERROR([Guix requires zlib.  See http://www.zlib.net/.])])
  AC_CHECK_HEADERS([zlib.h], [true],
    [AC_MSG_ERROR([Guix requires zlib.  See http://www.zlib.net/.])])

  dnl Look for libbz2, an optional dependency.
  AC_CHECK_LIB([bz2], [BZ2_bzWriteOpen], [HAVE_LIBBZ2=yes], [HAVE_LIBBZ2=no])
  if test "x$HAVE_LIBBZ2" = xyes; then
    AC_CHECK_HEADERS([bzlib.h])
    HAVE_LIBBZ2="$ac_cv_header_bzlib_h"
  fi

  dnl Look for SQLite, a required dependency.
  PKG_CHECK_MODULES([SQLITE3], [sqlite3 >= 3.6.19])

  AC_DEFINE_UNQUOTED([SYSTEM], ["$guix_system"],
    [Guix host system type--i.e., platform and OS kernel tuple.])

  case "$LIBGCRYPT_PREFIX" in
    no)
      LIBGCRYPT_CFLAGS=""
      ;;
    *)
      LIBGCRYPT_CFLAGS="-I$LIBGCRYPT_PREFIX/include"
      ;;
  esac

  case "$LIBGCRYPT_LIBDIR" in
    no | "")
      LIBGCRYPT_LIBS="-lgcrypt"
      ;;
    *)
      LIBGCRYPT_LIBS="-L$LIBGCRYPT_LIBDIR -lgcrypt"
      ;;
  esac

  AC_SUBST([LIBGCRYPT_CFLAGS])
  AC_SUBST([LIBGCRYPT_LIBS])

  save_CFLAGS="$CFLAGS"
  save_LDFLAGS="$LDFLAGS"
  CFLAGS="$CFLAGS $LIBGCRYPT_CFLAGS"
  LDFLAGS="$LDFLAGS $LIBGCRYPT_LDFLAGS"

  have_gcrypt=yes
  AC_CHECK_LIB([gcrypt], [gcry_md_open], [:], [have_gcrypt=no])
  AC_CHECK_HEADER([gcrypt.h], [:], [have_gcrypt=no])
  if test "x$have_gcrypt" != "xyes"; then
    AC_MSG_ERROR([GNU libgcrypt not found; please install it.])
  fi

  CFLAGS="$save_CFLAGS"
  LDFLAGS="$save_LDFLAGS"

  dnl Chroot support.
  AC_CHECK_FUNCS([chroot unshare])
  AC_CHECK_HEADERS([sched.h sys/param.h sys/mount.h sys/syscall.h])

  if test "x$ac_cv_func_chroot" != "xyes"; then
    AC_MSG_ERROR(['chroot' function missing, bailing out])
  fi

  dnl lutimes and lchown: used when canonicalizing store items.
  dnl posix_fallocate: used when extracting archives.
  dnl vfork: to speed up spawning of helper programs.
  dnl   `--> now disabled because of unpredictable behavior:
  dnl        see <http://lists.gnu.org/archive/html/guix-devel/2014-05/msg00036.html>
  dnl        and Nix commit f794465c (Nov. 2012).
  dnl sched_setaffinity: to improve RPC locality.
  dnl statvfs: to detect disk-full conditions.
  dnl strsignal: for error reporting.
  dnl statx: fine-grain 'stat' call, new in glibc 2.28.
  AC_CHECK_FUNCS([lutimes lchown posix_fallocate sched_setaffinity \
     statvfs nanosleep strsignal statx])

  dnl Check whether the store optimiser can optimise symlinks.
  AC_MSG_CHECKING([whether it is possible to create a link to a symlink])
  ln -s bla tmp_link
  if ln tmp_link tmp_link2 2> /dev/null; then
      AC_MSG_RESULT(yes)
      AC_DEFINE(CAN_LINK_SYMLINK, 1, [Whether link() works on symlinks.])
  else
      AC_MSG_RESULT(no)
  fi
  rm -f tmp_link tmp_link2

  dnl Check for <locale>.
  AC_LANG_PUSH(C++)
  AC_CHECK_HEADERS([locale])
  AC_LANG_POP(C++)

  dnl Check whether we have the `personality' syscall, which allows us
  dnl to do i686-linux builds on x86_64-linux machines.
  AC_CHECK_HEADERS([sys/personality.h])

  dnl Determine the appropriate default list of substitute URLs (GnuTLS
  dnl is required so we can default to 'https'.)
  guix_substitute_urls="https://ci.guix.gnu.org https://bordeaux.guix.gnu.org"

  AC_MSG_CHECKING([for default substitute URLs])
  AC_MSG_RESULT([$guix_substitute_urls])

  AC_DEFINE_UNQUOTED([GUIX_SUBSTITUTE_URLS], ["$guix_substitute_urls"],
    [Default list of substitute URLs used by 'guix-daemon'.])

  dnl Check for Guile-SSH, which is required by 'guix offload'.
  GUIX_CHECK_GUILE_SSH

  case "x$guix_cv_have_recent_guile_ssh" in
    xyes)
      guix_build_daemon_offload="yes"
      AC_DEFINE([HAVE_DAEMON_OFFLOAD_HOOK], [1],
	[Define if the daemon's 'offload' build hook is being built (requires Guile-SSH).])
      ;;
    *)
      guix_build_daemon_offload="no"
      ;;
  esac

  dnl Temporary directory used to store the daemon's data.
  GUIX_TEST_ROOT_DIRECTORY
  GUIX_TEST_ROOT="$ac_cv_guix_test_root"
  AC_SUBST([GUIX_TEST_ROOT])

  GUIX_CHECK_LOCALSTATEDIR
fi

AM_CONDITIONAL([HAVE_LIBBZ2], [test "x$HAVE_LIBBZ2" = "xyes"])
AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"])
AM_CONDITIONAL([BUILD_DAEMON_OFFLOAD],			\
  [test "x$guix_build_daemon" = "xyes"			\
   && test "x$guix_build_daemon_offload" = "xyes"])


code:
#                                               -*- Autoconf -*-
# Process this file with autoconf to produce a configure script.

AC_PREREQ([2.69])
AC_INIT([GNU Guix],
  [m4_esyscmd([build-aux/git-version-gen .tarball-version])],
  [bug-guix@gnu.org], [guix],
  [https://www.gnu.org/software/guix/])
AC_CONFIG_AUX_DIR([build-aux])

AM_INIT_AUTOMAKE([1.14 gnu silent-rules subdir-objects \
 color-tests parallel-tests -Woverride -Wno-portability])

# Enable silent rules by default.
AM_SILENT_RULES([yes])

AC_CONFIG_SRCDIR([guix.scm])
AC_CONFIG_MACRO_DIR([m4])

dnl For the C++ code.  This must be used early.
AC_USE_SYSTEM_EXTENSIONS

AM_GNU_GETTEXT([external])
AM_GNU_GETTEXT_VERSION([0.19.1])

GUIX_SYSTEM_TYPE
GUIX_ASSERT_SUPPORTED_SYSTEM
GUIX_CHANNEL_METADATA

AM_CONDITIONAL([CROSS_COMPILING], [test "x$cross_compiling" = "xyes"])

AC_ARG_WITH(store-dir,
  AS_HELP_STRING([--with-store-dir=PATH],
    [file name of the store (defaults to /gnu/store)]),
  [storedir="$withval"],
  [storedir="/gnu/store"])
AC_SUBST(storedir)

AC_ARG_WITH([bash-completion-dir],
  AS_HELP_STRING([--with-bash-completion-dir=DIR],
    [name of the Bash completion directory]),
  [bashcompletiondir="$withval"],
  [bashcompletiondir='${sysconfdir}/bash_completion.d'])
AC_SUBST([bashcompletiondir])

AC_ARG_WITH([zsh-completion-dir],
  AS_HELP_STRING([--with-zsh-completion-dir=DIR],
    [name of the Zsh completion directory]),
  [zshcompletiondir="$withval"],
  [zshcompletiondir='${datadir}/zsh/site-functions'])
AC_SUBST([zshcompletiondir])

AC_ARG_WITH([fish-completion-dir],
  AS_HELP_STRING([--with-fish-completion-dir=DIR],
    [name of the Fish completion directory]),
  [fishcompletiondir="$withval"],
  [fishcompletiondir='${datadir}/fish/vendor_completions.d'])
AC_SUBST([fishcompletiondir])

AC_ARG_WITH([selinux-policy-dir],
  AS_HELP_STRING([--with-selinux-policy-dir=DIR],
    [name of the SELinux policy directory]),
  [selinux_policydir="$withval"],
  [selinux_policydir='${datadir}/selinux/'])
AC_SUBST([selinux_policydir])

dnl Better be verbose.
AC_MSG_CHECKING([for the store directory])
AC_MSG_RESULT([$storedir])

AC_ARG_ENABLE([daemon],
  [AS_HELP_STRING([--disable-daemon], [do not build the Nix daemon (C++)])],
  [guix_build_daemon="$enableval"],
  [guix_build_daemon="yes"])

# Prepare a version of $localstatedir & co. that does not contain references
# to shell variables.
guix_prefix="`eval echo $prefix | sed -e"s|NONE|/usr/local|g"`"
guix_localstatedir="`eval echo $localstatedir | sed -e "s|NONE|$guix_prefix|g"`"
guix_sysconfdir="`eval echo $sysconfdir | sed -e "s|NONE|$guix_prefix|g"`"
guix_sbindir="`eval echo $sbindir | sed -e "s|NONE|$guix_prefix|g"`"
AC_SUBST([guix_localstatedir])
AC_SUBST([guix_sysconfdir])
AC_SUBST([guix_sbindir])

GUIX_CHECK_FILE_NAME_LIMITS([can_run_tests])
AM_CONDITIONAL([CAN_RUN_TESTS], [test "x$can_run_tests" = "xyes"])

dnl We require pkg.m4 (from pkg-config) and guile.m4 (from Guile.)
dnl Make sure they are available.
m4_pattern_forbid([PKG_CHECK_MODULES])
m4_pattern_forbid([GUILE_MODULE_AVAILABLE])
m4_pattern_forbid([^GUILE_P])
m4_pattern_allow([^GUILE_PKG_ERRORS])
m4_pattern_forbid([^GUIX_])

dnl Search for 'guile' and 'guild'.  This macro defines
dnl 'GUILE_EFFECTIVE_VERSION'.
GUILE_PKG([3.0])
GUILE_PROGS
if test "x$GUILD" = "x"; then
   AC_MSG_ERROR(['guild' binary not found; please check your Guile installation.])
fi

dnl Get CFLAGS and LDFLAGS for libguile.
GUILE_FLAGS

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])

dnl The GnuTLS bindings are necessary for substitutes over HTTPS and for 'guix
dnl pull', among other things.
GUILE_MODULE_AVAILABLE([have_gnutls], [(gnutls)])
if test "x$have_gnutls" != "xyes"; then
  AC_MSG_ERROR([The Guile bindings of GnuTLS are missing; please install them.])
fi

dnl Check for Guile-Git.
GUILE_MODULE_AVAILABLE([have_guile_git], [(git)])
if test "x$have_guile_git" != "xyes"; then
  AC_MSG_ERROR([Guile-Git is missing; please install it.])
fi

dnl Check for Guile-JSON.
GUIX_CHECK_GUILE_JSON
if test "x$guix_cv_have_recent_guile_json" != "xyes"; then
  AC_MSG_ERROR([Guile-JSON is missing; please install it.])
fi

dnl Guile-Sqlite3 is used by the (guix store ...) modules.
GUIX_CHECK_GUILE_SQLITE3
if test "x$guix_cv_have_recent_guile_sqlite3" != "xyes"; then
  AC_MSG_ERROR([A recent Guile-SQLite3 could not be found; please install it.])
fi

GUIX_CHECK_GUILE_GCRYPT
if test "x$guix_cv_have_recent_guile_gcrypt" != "xyes"; then
  AC_MSG_ERROR([A recent Guile-Gcrypt could not be found; please install it.])
fi

GUIX_CHECK_GUILE_GIT
if test "x$guix_cv_have_recent_guile_git" != "xyes"; then
  AC_MSG_ERROR([A recent Guile-Git could not be found; please install it.])
fi

dnl Check for the optional Guile-Lib.
GUILE_MODULE_EXPORTS([have_guile_lib], [(htmlprag)], [%strict-tokenizer?])
AM_CONDITIONAL([HAVE_GUILE_LIB], [test "x$have_guile_lib" = "xyes"])
AM_COND_IF(HAVE_GUILE_LIB,,
  [AC_MSG_WARN([The Guile-Lib requirement was not satisfied (>= 0.2.7);
Some features such as the Go importer will not be usable.])])

dnl Check for Guile-zlib.
GUIX_CHECK_GUILE_ZLIB
if test "x$guix_cv_have_recent_guile_zlib" != "xyes"; then
  AC_MSG_ERROR([A recent Guile-zlib could not be found; please install it.])
fi

dnl Check for Guile-lzlib.
GUILE_MODULE_AVAILABLE([have_guile_lzlib], [(lzlib)])
if test "x$have_guile_lzlib" != "xyes"; then
  AC_MSG_ERROR([Guile-lzlib is missing; please install it.])
fi

dnl Check for Guile-Avahi.
GUILE_MODULE_AVAILABLE([have_guile_avahi], [(avahi)])
AM_CONDITIONAL([HAVE_GUILE_AVAHI],
  [test "x$have_guile_avahi" = "xyes"])

dnl Guile-newt is used by the graphical installer.
GUILE_MODULE_AVAILABLE([have_guile_newt], [(newt)])

AC_ARG_ENABLE([installer],
    AS_HELP_STRING([--enable-installer], [Build the graphical installer sources.]))

AS_IF([test "x$enable_installer" = "xyes"], [
if test "x$have_guile_newt" != "xyes"; then
  AC_MSG_ERROR([Guile-newt could not be found; please install it.])
fi
])

AM_CONDITIONAL([ENABLE_INSTALLER],
  [test "x$enable_installer" = "xyes"])

dnl Make sure we have a full-fledged Guile.
GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])

AC_PROG_SED

dnl Decompressors, for use by the substituter and other modules.
AC_PATH_PROG([GZIP], [gzip])
AC_PATH_PROG([BZIP2], [bzip2])
AC_PATH_PROG([XZ], [xz])
AC_SUBST([GZIP])
AC_SUBST([BZIP2])
AC_SUBST([XZ])

LIBGCRYPT_LIBDIR="no"
LIBGCRYPT_PREFIX="no"

AC_ARG_WITH([libgcrypt-prefix],
  [AS_HELP_STRING([--with-libgcrypt-prefix=DIR], [search for GNU libgcrypt in DIR])],
  [case "$withval" in
    yes|no)
      ;;
    *)
      LIBGCRYPT_PREFIX="$withval"
      LIBGCRYPT_LIBDIR="$withval/lib"
      ;;
   esac])

AC_ARG_WITH([libgcrypt-libdir],
  [AS_HELP_STRING([--with-libgcrypt-libdir=DIR],
     [search for GNU libgcrypt's shared library in DIR])],
  [case "$withval" in
    yes|no)
      LIBGCRYPT_LIBDIR="no"
      ;;
    *)
      LIBGCRYPT_LIBDIR="$withval"
      ;;
   esac])

dnl If none of the --with-libgcrypt-* options was used, try to determine the
dnl the library directory.
case "x$LIBGCRYPT_PREFIX$LIBGCRYPT_LIBDIR" in
  xnono)
    GUIX_LIBGCRYPT_LIBDIR([LIBGCRYPT_LIBDIR])
    ;;
esac

AC_SUBST([LIBGCRYPT_PREFIX])
AC_SUBST([LIBGCRYPT_LIBDIR])

dnl Check for Guile-SSH, for the (guix ssh) module.
GUIX_CHECK_GUILE_SSH
AM_CONDITIONAL([HAVE_GUILE_SSH],
  [test "x$guix_cv_have_recent_guile_ssh" = "xyes"])

AC_CACHE_SAVE

m4_include([config-daemon.ac])

dnl `dot' (from the Graphviz package) is only needed for maintainers.
dnl See `Building from Git' in the manual for more info.
AM_MISSING_PROG([DOT], [dot])

dnl Manual pages.
AM_MISSING_PROG([HELP2MAN], [help2man])

dnl Documentation translation.
AM_MISSING_PROG([PO4A_TRANSLATE], [po4a-translate])
AM_MISSING_PROG([PO4A_UPDATEPO], [po4a-updatepo])

case "$storedir" in
  /gnu/store)
    ;;
  *)
    AC_MSG_WARN([Using a store directory other than '/gnu/store' will prevent you])
    AC_MSG_WARN([from downloading substitutes from gnu.org.])
    ;;
esac

AC_CONFIG_FILES([Makefile
                 po/guix/Makefile.in
                 po/packages/Makefile.in
                 etc/guix-daemon.cil
                 guix/config.scm])

AC_CONFIG_FILES([etc/committer.scm], [chmod +x etc/committer.scm])
AC_CONFIG_FILES([test-env:build-aux/test-env.in], [chmod +x test-env])
AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
  [chmod +x pre-inst-env])

AC_OUTPUT