;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017-2021, 2023 Ludovic Courtès ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2021, 2023 Maxim Cournoyer ;;; ;;; 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 . (define-module (test-pack) #:use-module (guix scripts pack) #:use-module (guix store) #:use-module (guix derivations)
aboutsummaryrefslogtreecommitdiff
blob: 80350db49520d57fab86fa42c1b28c392b14284e (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2016, 2017, 2021, 2022 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Michael Rohleder <mike@rohleder.de>
;;;
;;; 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 (gnu packages libidn)
  #:use-module (gnu packages)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages libunistring)
  #:use-module (guix licenses)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu))

(define-public libidn
  (package
   (name "libidn")
   (version "1.41")
   (source (origin
            (method url-fetch)
            (uri (string-append "mirror://gnu/libidn/libidn-" version
                                ".tar.gz"))
            (sha256
             (base32
              "0ic9zlqqppwaqr3i0r8lb8f47rrazzc8d5pfgg8vs6mqciip0kc8"))))
   (build-system gnu-build-system)
   ;; FIXME: No Java and C# libraries are currently built.
   (arguments
    `(#:configure-flags '("--disable-static")))
   (synopsis "Internationalized string processing library")
   (description
     "libidn is a library implementing of the Stringprep, Punycode and IDNA
specifications.  These are used to encode and decode internationalized domain
names according to the IDNA2003 specifications.  It includes native C, C# and
Java libraries.")
   ;; The C code is dual-licensed gpl2+ lgpl3+, the manual is fdl1.3+,
   ;; the command line tool is gpl3+.
   (license (list gpl2+ gpl3+ lgpl3+ fdl1.3+))
   (home-page "https://www.gnu.org/software/libidn/")))

(define-public libidn2
  (package
    (name "libidn2")
    (version "2.3.4")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/libidn/" name "-" version
                                  ".tar.gz"))
              (sha256
               (base32
                "0pxlvf37j9ivg2wp56q1xvx7g6y9cfmpd87mskwd2lg0nirbmjlk"))))
    (inputs
     (list libunistring))
    (build-system gnu-build-system)
    (arguments
     `(#:configure-flags '("--disable-static")))
    (synopsis "Internationalized domain name library for IDNA2008")
    (description "Libidn2 is an internationalized domain library implementing
the IDNA2008 specifications.   Libidn2 is believed to be a complete IDNA2008
implementation, but has yet to be as extensively used as the original Libidn
library.")
    (home-page "https://www.gnu.org/software/libidn/#libidn2")
    (properties '((ftp-directory . "/gnu/libidn")))
    ;; The command-line tool 'idn2' is GPL3+, while the library is dual-licensed
    ;; GPL2+ or LGPL3+.
    (license (list gpl2+ gpl3+ lgpl3+))))
'("alpha" "lambda")) (integer? (path-id db #$tree))))))))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "docker-image + localstatedir" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (tarball (docker-image "docker-pack" profile #:symlinks '(("/bin/Guile" -> "bin/guile")) #:localstatedir? #t)) (check (gexp->derivation "check-tarball" (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils) (ice-9 match)) (define bin (string-append "." #$profile "/bin")) (setenv "PATH" (string-append #$%tar-bootstrap "/bin")) (mkdir "base") (with-directory-excursion "base" (invoke "tar" "xvf" #$tarball)) (match (find-files "base" "layer.tar") ((layer) (invoke "tar" "xvf" layer))) (when (and (file-exists? (string-append bin "/guile")) (file-exists? "var/guix/db/db.sqlite") (file-is-directory? "tmp") (string=? (string-append #$%bootstrap-guile "/bin") (pk 'binlink (readlink bin))) (string=? (string-append #$profile "/bin/guile") (pk 'guilelink (readlink "bin/Guile")))) (mkdir #$output))))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "squashfs-image + localstatedir" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (image (squashfs-image "squashfs-pack" profile #:symlinks '(("/bin" -> "bin")) #:localstatedir? #t)) (check (gexp->derivation "check-tarball" (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils) (ice-9 match)) (define bin (string-append "." #$profile "/bin")) (setenv "PATH" (string-append #$squashfs-tools "/bin")) (invoke "unsquashfs" #$image) (with-directory-excursion "squashfs-root" (when (and (file-exists? (string-append bin "/guile")) (file-exists? "var/guix/db/db.sqlite") (string=? (string-append #$%bootstrap-guile "/bin") (pk 'binlink (readlink bin))) ;; This is a relative symlink target. (string=? (string-drop (string-append #$profile "/bin") 1) (pk 'guilelink (readlink "bin")))) (mkdir #$output)))))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "deb archive with symlinks and control files" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (deb (debian-archive "deb-pack" profile #:compressor %gzip-compressor #:symlinks '(("/opt/gnu/bin" -> "bin")) #:archiver %tar-bootstrap #:extra-options (list #:triggers-file (plain-file "triggers" "activate-noawait /usr/share/icons/hicolor\n") #:postinst-file (plain-file "postinst" "echo running configure script\n")))) (check (gexp->derivation "check-deb-pack" (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils) (ice-9 match) (ice-9 popen) (ice-9 rdelim) (ice-9 textual-ports) (rnrs base)) (setenv "PATH" (string-join (list (string-append #+%tar-bootstrap "/bin") (string-append #+dpkg "/bin") (string-append #+%ar-bootstrap "/bin")) ":")) ;; Validate the output of 'dpkg --info'. (let* ((port (open-pipe* OPEN_READ "dpkg" "--info" #$deb)) (info (get-string-all port)) (exit-val (status:exit-val (close-pipe port)))) (assert (zero? exit-val)) (assert (string-contains info (string-append "Package: " #+(package-name %bootstrap-guile)))) (assert (string-contains info (string-append "Version: " #+(package-version %bootstrap-guile))))) ;; Sanity check .deb contents. (invoke "ar" "-xv" #$deb) (assert (file-exists? "debian-binary")) (assert (file-exists? "data.tar.gz")) (assert (file-exists? "control.tar.gz")) ;; Verify there are no hard links in data.tar.gz, as hard ;; links would cause dpkg to fail unpacking the archive. (define hard-links (let ((port (open-pipe* OPEN_READ "tar" "-tvf" "data.tar.gz"))) (let loop ((hard-links '())) (match (read-line port) ((? eof-object?) (assert (zero? (status:exit-val (close-pipe port)))) hard-links) (line (if (string-prefix? "u" line) (loop (cons line hard-links)) (loop hard-links))))))) (unless (null? hard-links) (error "hard links found in data.tar.gz" hard-links)) ;; Verify the presence of the control files. (invoke "tar" "-xf" "control.tar.gz") (assert (file-exists? "control")) (assert (and (file-exists? "postinst") (= #o111 ;script is executable (logand #o111 (stat:perms (stat "postinst")))))) (assert (file-exists? "triggers")) (mkdir #$output)))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "rpm archive can be installed/uninstalled" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (rpm-pack (rpm-archive "rpm-pack" profile #:compressor %gzip-compressor #:symlinks '(("/bin/guile" -> "bin/guile")) #:extra-options '(#:relocatable? #t))) (check (gexp->derivation "check-rpm-pack" (with-imported-modules (source-module-closure '((guix build utils))) #~(begin (use-modules (guix build utils)) (define fakeroot #+(file-append fakeroot "/bin/fakeroot")) (define rpm #+(file-append rpm-for-tests "/bin/rpm")) (mkdir-p "/tmp/lib/rpm") ;; Install the RPM package. This causes RPM to validate the ;; signatures, header as well as the file digests, which ;; makes it a rather thorough test. (mkdir "test-prefix") (invoke fakeroot rpm "--install" (string-append "--prefix=" (getcwd) "/test-prefix") #$rpm-pack) ;; Invoke the installed Guile command. (invoke "./test-prefix/bin/guile" "--version") ;; Uninstall the RPM package. (invoke fakeroot rpm "--erase" "guile-bootstrap") ;; Required so the above is run. (mkdir #$output)))))) (built-derivations (list check))))) (test-end) ;; Local Variables: ;; eval: (put 'test-assertm 'scheme-indent-function 2) ;; End: