;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 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/>.

(define-module (tests services configuration)
  #:use-module (gnu services configuration)
  #:use-module (guix gexp)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-64))

;;; Tests for the (gnu services configuration) module.

(test-begin "services-configuration")


;;;
;;; define-configuration macro.
;;;

(define-configuration port-configuration
  (port (number 80) "The port number.")
  (no-serialization))

(test-equal "default value, no serialization"
  80
  (port-configuration-port (port-configuration)))

(define-configuration port-configuration-cs
  (port (number 80) "The port number." empty-serializer))

(test-equal "default value, custom serializer"
  80
  (port-configuration-cs-port (port-configuration-cs)))

(define serialize-number "")
(define-configuration port-configuration-ndv
  (port (number) "The port number."))

(test-equal "no default value, provided"
  55
  (port-configuration-ndv-port (port-configuration-ndv
                                (port 55))))

(test-assert "no default value, not provided"
  (guard (c ((configuration-error? c)
             #t))
    (port-configuration-ndv-port (port-configuration-ndv))))

(define (custom-number-serializer name value)
  (format #f "~a = ~a;" name value))

(define-configuration serializable-configuration
  (port (number 80) "The port number." custom-number-serializer))

(test-assert "serialize-configuration"
  (gexp?
   (let ((config (serializable-configuration)))
     (serialize-configuration config serializable-configuration-fields))))

(define-configuration serializable-configuration
  (port (number 80) "The port number." custom-number-serializer)
  (no-serialization))

(test-assert "serialize-configuration with no-serialization"
  ;; When serialization is disabled, the serializer is set to #f, so
  ;; attempting to use it fails with a 'wrong-type-arg' error.
  (not (false-if-exception
        (let ((config (serializable-configuration)))
          (serialize-configuration config serializable-configuration-fields)))))


;;;
;;; define-maybe macro.
;;;
(define-maybe number)

(define-configuration config-with-maybe-number
  (port (maybe-number 80) "The port number."))

(define (serialize-number field value)
  (format #f "~a=~a" field value))

(test-equal "maybe value serialization"
  "port=80"
  (serialize-maybe-number "port" 80))

(define-maybe/no-serialization string)

(define-configuration config-with-maybe-string/no-serialization
  (name (maybe-string) "The name of the item.")
  (no-serialization))

(test-assert "maybe value without serialization no procedure bound"
  (not (defined? 'serialize-maybe-string)))
):
Add call to 'prctl'.  Call 'mount' for NEW_ROOT and define 'is_tmpfs'.
When IS_TMPFS is true, call 'umount' and 'rmdir' after 'waitpid';
otherwise, call 'rm_rf' only when 'waitpid' returns -1 the second time.
(exec_with_loader): Call 'prctl'.  Remove NEW_ROOT only when 'waitpid'
returns -1 the second time, otherwise leave it behind.
* tests/guix-pack-relocatable.sh (wait_for_file): New function.
Add test.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2020-10-30 10:00:29 -0500'>2020-10-30</span></td><td><a href='/guix/commit/gnu/packages/aux-files/run-in-namespace.c?id=a73896425e92e5162766afdf042748b18f2462af'>guix: pack: Fix offset calculation for store directory mount point.</a><span class='msg-avail'>...<span class='msg-tooltip'>Fixes wrapping of non-package things, where the target store directory may
differ in length from the original.

* guix/scripts/pack.scm (wrapped-package)&lt;build-wrapper&gt;: Define
WRAPPER_PROGRAM macro with wrapper's file name.
* gnu/packages/aux-files/run-in-namespace.c (main): Offset index by len of
that file name.
</span></span></td><td>Eric Bavier</td></tr>
<tr><td><span title='2020-08-27 19:58:16 +0200'>2020-08-27</span></td><td><a href='/guix/commit/gnu/packages/aux-files/run-in-namespace.c?id=28dce8f02db38a41e59ecdf3786baa6f732636ff'>pack: fakechroot: Honor $LD_LIBRARY_PATH.</a><span class='msg-avail'>...<span class='msg-tooltip'>Until now, when using the "fakechroot" engine, $LD_LIBRARY_PATH would
always be ignored.  However, it's useful in some cases to allow users to
specify LD_LIBRARY_PATH, so honor it.

* gnu/packages/aux-files/run-in-namespace.c (concat_paths): New function.
(exec_with_loader): Concatenante $LD_LIBRARY_PATH to the relocated
AUDIT_LIBRARY_PATH.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2020-07-28 14:41:05 +0200'>2020-07-28</span></td><td><a href='/guix/commit/gnu/packages/aux-files/run-in-namespace.c?id=c088aa2988ef82289c87ebfd6d07d8f1464dd8f0'>pack: "fakechroot" engine always creates its store.</a><span class='msg-avail'>...<span class='msg-tooltip'>Previously it would silently fail to create the /gnu/store symlink when
the host has a read-only /gnu as is the case in these tests.

* gnu/packages/aux-files/run-in-namespace.c (exec_with_loader): Unlink
the ancestor of ORIGINAL_STORE under NEW_ROOT.  Check the return value
of 'symlink' when creating NEW_STORE.
* tests/guix-pack-relocatable.sh: Check the contents of the store as
seen by the wrapped executable, with all three engines, and with both
"/gnu" and "/gnu/store" erased.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2020-07-28 14:41:04 +0200'>2020-07-28</span></td><td><a href='/guix/commit/gnu/packages/aux-files/run-in-namespace.c?id=c6c0d5a22c2ee3d7164dab0129b2e4852a4ae76c'>pack: "fakechroot" execution engine can load its audit module.</a><span class='msg-avail'>...<span class='msg-tooltip'>Fixes &lt;https://bugs.gnu.org/42558&gt;.

Until now, loading 'pack-audit.so' in a truly non-Guix environment would
usually fail because 'pack-audit.so' depends on 'libgcc_s.so' and
'libc.so', none of which could be found.

Furthermore, the test was not working as expected: the trick

  unshare -mrf sh -c 'mount -t tmpfs none /gnu ; ...'

would allow the fakechroot engine to make its store available as
/gnu/store as a result of another bug.

* gnu/packages/aux-files/run-in-namespace.c (relocated_search_path): New
function.
(exec_with_loader): Pass "--library-path" to the loader.
* guix/scripts/pack.scm (wrapped-package)[build](runpath): New procedure.
(elf-loader-compile-flags): Pass "-DLOADER_AUDIT_RUNPATH".
* tests/guix-pack-relocatable.sh: Remove 'STORE_PARENT'.
(run_without_store): New function.  Erase $NIX_STORE_DIR instead of
$STORE_PARENT.
Use 'run_without_store' throughout.
</span></span></td><td>Ludovic Courtès</td></tr>