me
/
guix
Archived
1
0
Fork 0
Code

Merge branch 'master' into core-updates

master
Marius Bakke 2020-05-05 20:43:21 +02:00
parent ba151b7e1a 751d1f01e4
commit 87a40d7203
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
66 changed files with 7763 additions and 649 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

157
.guix-authorizations 100644
View File

@ -0,0 +1,157 @@
;; This is the list of OpenPGP keys currently authorized to sign commits in
;; this repository.
(authorizations
(version 0)
(("AD17 A21E F8AE D8F1 CC02 DBD9 F7D5 C9BF 765C 61E3"
(name "andreas"))
("2A39 3FFF 68F4 EF7A 3D29 12AF 6F51 20A0 22FB B2D5"
(name "ajgrf"))
("306F CB8F 2C01 C25D 29D3 0556 61EF 502E F602 52F2"
(name "alexvong1995"))
("4FB9 9F49 2B12 A365 7997 E664 8246 0C08 2A0E E98F"
(name "alezost"))
("50F3 3E2E 5B0C 3D90 0424 ABE8 9BDC F497 A4BB CC7F"
(name "ambrevar"))
("27D5 86A4 F890 0854 329F F09F 1260 E464 82E6 3562"
(name "apteryx"))
("7F73 0343 F2F0 9F3C 77BF 79D3 2E25 EE8B 6180 2BB3"
(name "arunisaac"))
(;; primary: "3B12 9196 AE30 0C3C 0E90 A26F A715 5567 3271 9948"
"9A2B 401E D001 0650 1584 BAAC 8BC4 F447 6E8A 8E00"
(name "atheia"))
(;; primary: "BE62 7373 8E61 6D6D 1B3A 08E8 A21A 0202 4881 6103"
"39B3 3C8D 9448 0D2D DCC2 A498 8B44 A0CD C7B9 56F2"
(name "bandali"))
(;; primary: "34FF 38BC D151 25A6 E340 A0B5 3453 2F9F AFCA 8B8E"
"A0C5 E352 2EF8 EF5C 64CD B7F0 FD73 CAC7 19D3 2566"
(name "bavier"))
("3774 8024 880F D3FF DCA2 C9AB 5893 6E0E 2F1B 5A4C"
(name "beffa"))
("BCF8 F737 2CED 080A 67EB 592D 2A6A D9F4 AAC2 0DF6"
(name "benwoodcroft"))
("45CC 63B8 5258 C9D5 5F34 B239 D37D 0EA7 CECC 3912"
(name "biscuolo"))
("7988 3B9F 7D6A 4DBF 3719 0367 2506 A96C CF63 0B21"
(name "boskovits"))
("DFC0 C7F7 9EE6 0CA7 AE55 5E19 6722 43C4 A03F 0EEE"
(name "brettgilio"))
(;; primary: "8929 BBC5 73CD 9206 3DDD 979D 3D36 CAA0 116F 0F99"
"1C9B F005 1A1A 6A44 5257 599A A949 03A1 66A1 8FAE"
(name "bricewge"))
(;; primary: "0401 7A2A 6D9A 0CCD C81D 8EC2 96AB 007F 1A7E D999"
"09CD D25B 5244 A376 78F6 EEA8 0CC5 2153 1979 91A5"
(name "carl"))
("3E89 EEE7 458E 720D 9754 E0B2 5E28 A33B 0B84 F577"
(name "cbaines"))
("3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5"
(name "civodul"))
("510A 8628 E2A7 7678 8F8C 709C 4BC0 2592 5FF8 F4D3"
(name "cwebber"))
(;; primary: "295A F991 6F46 F8A1 34B0 29DA 8086 3842 F0FE D83B"
"76CE C6B1 7274 B465 C02D B3D9 E71A 3554 2C30 BAA5"
(name "dannym"))
("B3C0 DB4D AD73 BA5D 285E 19AE 5143 0234 CEFD 87C3"
(name "davexunit"))
("8CCB A7F5 52B9 CBEA E1FB 2915 8328 C747 0FF1 D807" ;FIXME: to be confirmed!
(name "davexunit (2nd)"))
("53C4 1E6E 41AA FE55 335A CA5E 446A 2ED4 D940 BF14"
(name "daviwil"))
("6909 6DFD D702 8BED ACC5 884B C5E0 51C7 9C0B ECDB"
(name "dvc"))
("5F43 B681 0437 2F4B A898 A64B 33B9 E9FD E28D 2C23"
(name "dvc (old)"))
("A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351"
(name "efraim"))
("9157 41FE B22F A4E3 3B6E 8F8D F4C1 D391 7EAC EE93"
(name "efraim (old)"))
(;; primary: "2453 02B1 BAB1 F867 FDCA 96BC 8F3F 861F 82EB 7A9A"
"CBC5 9C66 EC27 B971 7940 6B3E 6BE8 208A DF21 FE3F"
(name "glv"))
("2219 43F4 9E9F 276F 9499 3382 BF28 6CB6 593E 5FFD"
(name "hoebjo"))
("B943 509D 633E 80DD 27FC 4EED 634A 8DFF D3F6 31DF"
(name "htgoebel"))
("7440 26BA 7CA3 C668 E940 1D53 0B43 1E98 3705 6942"
(name "ipetkov"))
(;; primary: "66A5 6D9C 9A98 BE7F 719A B401 2652 5665 AE72 7D37"
"0325 78A6 8298 94E7 2AA2 66F5 D415 BF25 3B51 5976"
(name "iyzsong"))
;; https://lists.gnu.org/archive/html/guix-devel/2018-04/msg00229.html
("DB34 CB51 D25C 9408 156F CDD6 A12F 8797 8D70 1B99"
(name "janneke (old)"))
("1A85 8392 E331 EAFD B8C2 7FFB F3C1 A0D9 C1D6 5273"
(name "janneke"))
(;; primary: "1BA4 08C5 8BF2 0EA7 3179 635A 865D C0A3 DED9 B5D0"
"E31D 9DDE EBA5 4A14 8A20 4550 DA45 97F9 47B4 1025"
(name "jlicht"))
("83B6 703A DCCA 3B69 4BCE 2DA6 E6A5 EE3C 1946 7A0D"
(name "kkebreau"))
("45E5 75FA 53EA 8BD6 1BCE 0B4E 3ADC 75F0 13D6 78F9"
(name "leungbk"))
(;; primary: "4F71 6F9A 8FA2 C80E F1B5 E1BA 5E35 F231 DE1A C5E0"
"B051 5948 F1E7 D3C1 B980 38A0 2646 FA30 BACA 7F08"
(name "lfam"))
("2AE3 1395 932B E642 FC0E D99C 9BED 6EDA 32E5 B0BC"
(name "lsl88"))
("CBF5 9755 CBE7 E7EF EF18 3FB1 DD40 9A15 D822 469D"
(name "marusich"))
("BBB0 2DDF 2CEA F6A8 0D1D E643 A2A0 6DF2 A33A 54FA"
(name "mbakke"))
("D919 0965 CE03 199E AF28 B3BE 7CEF 2984 7562 C516"
(name "mhw"))
("4008 6A7E 0252 9B60 31FB 8607 8354 7635 3176 9CA6"
(name "mothacehe"))
(;; primary: "F5BC 5534 C36F 0087 B39D 36EF 1C9D C4FE B9DB 7C4B"
"F5DA 2032 4B87 3D0B 7A38 7672 0DB0 FF88 4F55 6D79"
(name "nckx"))
("E576 BFB2 CF6E B13D F571 33B9 E315 A758 4613 1564"
(name "niedzejkob"))
("ED0E F1C8 E126 BA83 1B48 5FE9 DA00 B4F0 48E9 2F2D"
(name "ngz"))
("CEF4 CB91 4856 BA38 0A20 A7E2 3008 88CB 39C6 3817"
(name "pelzflorian"))
(;; primary: "B68B DF22 73F9 DA0E 63C1 8A32 515B F416 9242 D600"
"C699 ED09 E51B CE89 FD1D A078 AAC7 E891 896B 568A"
(name "pgarlick"))
("3A86 380E 58A8 B942 8D39 60E1 327C 1EF3 8DF5 4C32"
(name "phant0mas"))
("74D6 A930 F44B 9B84 9EA5 5606 C166 AA49 5F7F 189C"
(name "reepca"))
("BCA6 89B6 3655 3801 C3C6 2150 197A 5888 235F ACAC"
(name "rekado"))
("0154 E1B9 1CC9 D9EF 7764 8DE7 F3A7 27DB 44FC CA36"
(name "rhelling"))
(;; From commit cc51c03ff867d4633505354819c6d88af88bf919 (March 2020).
;; See <https://lists.gnu.org/archive/html/guix-devel/2020-03/msg00070.html>.
"F556 FD94 FB8F 8B87 79E3 6832 CBD0 CD51 38C1 9AFC"
(name "roelj"))
(;; From commit 2cbede5935eb6a40173bbdf30a9ad22bf7574c22 (Jan. 2020). See
;; <https://lists.gnu.org/archive/html/guix-devel/2020-01/msg00499.html>.
"1EFB 0909 1F17 D28C CBF9 B13A 53D4 57B2 D636 EE82"
(name "roptat"))
(;; primary: "D6B0 C593 DA8C 5EDC A44C 7A58 C336 91F7 1188 B004"
"A02C 2D82 0EF4 B25B A6B5 1D90 2AC6 A5EC 1C35 7C59"
(name "samplet"))
("77DD AD2D 97F5 31BB C0F3 C7FD DFB5 EB09 AA62 5423"
(name "sleep_walker"))
("F494 72F4 7A59 00D5 C235 F212 89F9 6D48 08F3 59C7"
(name "snape"))
("9ADE 9ECF 2B19 C180 9C99 5CEA A1F4 CFCC 5283 6BAC"
(name "taylanub"))
;; https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00826.html
(;; primary: "1DD1 681F E285 E07F 11DC 0C59 2E15 A6BC D77D 54FD"
"3D2C DA58 819C 08C2 A649 D43D 5C3B 064C 724A 5726"
(name "thomasd"))
("6580 7361 3BFC C5C7 E2E4 5D45 DC51 8FC8 7F97 16AA"
(name "vagrantc"))
(;; primary: "C955 CC5D C048 7FB1 7966 40A9 199A F6A3 67E9 4ABB"
"7238 7123 8EAC EB63 4548 5857 167F 8EA5 001A FA9C"
(name "wigust"))
("FF47 8FB2 64DE 32EC 2967 25A3 DDC0 F535 8812 F8F2"
(name "wingo"))))

7
Makefile.am
View File

@ -70,6 +70,7 @@ MODULES = \
guix/docker.scm \
guix/json.scm \
guix/records.scm \
guix/openpgp.scm \
guix/pki.scm \
guix/progress.scm \
guix/combinators.scm \
@ -415,6 +416,7 @@ SCM_TESTS = \
tests/nar.scm \
tests/networking.scm \
tests/opam.scm \
tests/openpgp.scm \
tests/packages.scm \
tests/pack.scm \
tests/pki.scm \
@ -565,6 +567,11 @@ EXTRA_DIST += \
tests/signing-key.pub \
tests/signing-key.sec \
tests/cve-sample.json \
tests/civodul.key \
tests/rsa.key \
tests/dsa.key \
tests/ed25519.key \
tests/ed25519.sec \
build-aux/config.rpath \
bootstrap \
doc/build.scm \

194
build-aux/git-authenticate.scm
View File

@ -23,8 +23,10 @@
(use-modules (git)
(guix git)
(guix gnupg)
(guix utils)
(guix openpgp)
(guix base16)
((guix utils)
#:select (cache-directory with-atomic-file-output))
((guix build utils) #:select (mkdir-p))
(guix i18n)
(guix progress)
@ -33,6 +35,7 @@
(srfi srfi-26)
(srfi srfi-34)
(srfi srfi-35)
(rnrs bytevectors)
(rnrs io ports)
(ice-9 match)
(ice-9 format)
@ -215,7 +218,8 @@
;; Fingerprint of authorized signing keys.
(map (match-lambda
((name fingerprint)
(string-filter char-set:graphic fingerprint)))
(base16-string->bytevector
(string-downcase (string-filter char-set:graphic fingerprint)))))
%committers))
(define %commits-with-bad-signature
@ -226,93 +230,146 @@
;; Commits lacking a signature.
'())
(define-syntax-rule (with-temporary-files file1 file2 exp ...)
(call-with-temporary-output-file
(lambda (file1 port1)
(call-with-temporary-output-file
(lambda (file2 port2)
exp ...)))))
(define (commit-signing-key repo commit-id)
"Return the OpenPGP key ID that signed COMMIT-ID (an OID). Raise an
exception if the commit is unsigned or has an invalid signature."
(define (commit-signing-key repo commit-id keyring)
"Return the OpenPGP key that signed COMMIT-ID (an OID). Raise an exception
if the commit is unsigned, has an invalid signature, or if its signing key is
not in KEYRING."
(let-values (((signature signed-data)
(catch 'git-error
(lambda ()
(commit-extract-signature repo commit-id))
(lambda _
(values #f #f)))))
(if (not signature)
(raise (condition
(&message
(message (format #f (G_ "commit ~a lacks a signature")
commit-id)))))
(begin
(with-fluids ((%default-port-encoding "UTF-8"))
(with-temporary-files data-file signature-file
(call-with-output-file data-file
(cut display signed-data <>))
(call-with-output-file signature-file
(cut display signature <>))
(unless signature
(raise (condition
(&message
(message (format #f (G_ "commit ~a lacks a signature")
commit-id))))))
(let-values (((status data)
(with-error-to-port (%make-void-port "w")
(lambda ()
(gnupg-verify* signature-file data-file
#:key-download 'always)))))
(match status
('invalid-signature
;; There's a signature but it's invalid.
(raise (condition
(&message
(message (format #f (G_ "signature verification failed \
(let ((signature (string->openpgp-packet signature)))
(with-fluids ((%default-port-encoding "UTF-8"))
(let-values (((status data)
(verify-openpgp-signature signature keyring
(open-input-string signed-data))))
(match status
('bad-signature
;; There's a signature but it's invalid.
(raise (condition
(&message
(message (format #f (G_ "signature verification failed \
for commit ~a")
(oid->string commit-id)))))))
('missing-key
(raise (condition
(&message
(message (format #f (G_ "could not authenticate \
(oid->string commit-id)))))))
('missing-key
(raise (condition
(&message
(message (format #f (G_ "could not authenticate \
commit ~a: key ~a is missing")
(oid->string commit-id)
data))))))
('valid-signature
(match data
((fingerprint . user)
fingerprint)))))))))))
(oid->string commit-id)
data))))))
('good-signature data)))))))
(define (authenticate-commit repository commit)
(define (read-authorizations port)
"Read authorizations in the '.guix-authorizations' format from PORT, and
return a list of authorized fingerprints."
(match (read port)
(('authorizations ('version 0)
(((? string? fingerprints) _ ...) ...)
_ ...)
(map (lambda (fingerprint)
(base16-string->bytevector
(string-downcase (string-filter char-set:graphic fingerprint))))
fingerprints))))
(define* (commit-authorized-keys repository commit
#:optional (default-authorizations '()))
"Return the list of OpenPGP fingerprints authorized to sign COMMIT, based on
authorizations listed in its parent commits. If one of the parent commits
does not specify anything, fall back to DEFAULT-AUTHORIZATIONS."
(define (commit-authorizations commit)
(catch 'git-error
(lambda ()
(let* ((tree (commit-tree commit))
(entry (tree-entry-bypath tree ".guix-authorizations"))
(blob (blob-lookup repository (tree-entry-id entry))))
(read-authorizations
(open-bytevector-input-port (blob-content blob)))))
(lambda (key error)
(if (= (git-error-code error) GIT_ENOTFOUND)
default-authorizations
(throw key error)))))
(apply lset-intersection bytevector=?
(map commit-authorizations (commit-parents commit))))
(define (authenticate-commit repository commit keyring)
"Authenticate COMMIT from REPOSITORY and return the signing key fingerprint.
Raise an error when authentication fails."
(define id
(commit-id commit))
(define signing-key
(commit-signing-key repository id))
(commit-signing-key repository id keyring))
(unless (member signing-key %authorized-signing-keys)
(unless (member (openpgp-public-key-fingerprint signing-key)
(commit-authorized-keys repository commit
%authorized-signing-keys))
(raise (condition
(&message
(message (format #f (G_ "commit ~a not signed by an authorized \
key: ~a")
(oid->string id) signing-key))))))
(oid->string id)
(openpgp-format-fingerprint
(openpgp-public-key-fingerprint
signing-key))))))))
signing-key)
(define (load-keyring-from-blob repository oid keyring)
"Augment KEYRING with the keyring available in the blob at OID, which may or
may not be ASCII-armored."
(let* ((blob (blob-lookup repository oid))
(port (open-bytevector-input-port (blob-content blob))))
(get-openpgp-keyring (if (port-ascii-armored? port)
(open-bytevector-input-port (read-radix-64 port))
port)
keyring)))
(define (load-keyring-from-reference repository reference)
"Load the '.key' files from the tree at REFERENCE in REPOSITORY and return
an OpenPGP keyring."
(let* ((reference (reference-lookup repository reference))
(target (reference-target reference))
(commit (commit-lookup repository target))
(tree (commit-tree commit)))
(fold (lambda (name keyring)
(if (string-suffix? ".key" name)
(let ((entry (tree-entry-bypath tree name)))
(load-keyring-from-blob repository
(tree-entry-id entry)
keyring))
keyring))
%empty-keyring
(tree-list tree))))
(define* (authenticate-commits repository commits
#:key (report-progress (const #t)))
#:key
(keyring-reference "refs/heads/keyring")
(report-progress (const #t)))
"Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for
each of them. Return an alist showing the number of occurrences of each key."
(parameterize ((current-keyring (string-append (config-directory)
"/keyrings/channels/guix.kbx")))
(fold (lambda (commit stats)
(report-progress)
(let ((signer (authenticate-commit repository commit)))
(match (assoc signer stats)
(#f (cons `(,signer . 1) stats))
((_ . count) (cons `(,signer . ,(+ count 1))
(alist-delete signer stats))))))
'()
commits)))
each of them. Return an alist showing the number of occurrences of each key.
The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY."
(define keyring
(load-keyring-from-reference repository keyring-reference))
(fold (lambda (commit stats)
(report-progress)
(let ((signer (authenticate-commit repository commit keyring)))
(match (assq signer stats)
(#f (cons `(,signer . 1) stats))
((_ . count) (cons `(,signer . ,(+ count 1))
(alist-delete signer stats))))))
'()
commits))
(define commit-short-id
(compose (cut string-take <> 7) oid->string commit-id))
@ -409,7 +466,10 @@ COMMIT-ID is written to cache, though)."
(format #t (G_ "Signing statistics:~%"))
(for-each (match-lambda
((signer . count)
(format #t " ~a ~10d~%" signer count)))
(format #t " ~a ~10d~%"
(openpgp-format-fingerprint
(openpgp-public-key-fingerprint signer))
count)))
(sort stats
(match-lambda*
(((_ . count1) (_ . count2))
@ -423,7 +483,3 @@ COMMIT-ID is written to cache, though)."
(G_ "Usage: git-authenticate START [END]
Authenticate commits START to END or the current head.\n"))))))
;;; Local Variables:
;;; eval: (put 'with-temporary-files 'scheme-indent-function 2)
;;; End:

24
doc/contributing.texi
View File

@ -1187,18 +1187,38 @@ the OpenPGP key you will use to sign commits, and giving its fingerprint
(see below). See @uref{https://emailselfdefense.fsf.org/en/}, for an
introduction to public-key cryptography with GnuPG.
@c See <https://sha-mbles.github.io/>.
Set up GnuPG such that it never uses the SHA1 hash algorithm for digital
signatures, which is known to be unsafe since 2019, for instance by
adding the following line to @file{~/.gnupg/gpg.conf} (@pxref{GPG
Esoteric Options,,, gnupg, The GNU Privacy Guard Manual}):
@example
digest-algo sha512
@end example
@item
Maintainers ultimately decide whether to grant you commit access,
usually following your referrals' recommendation.
@item
@cindex OpenPGP, signed commits
If and once you've been given access, please send a message to
@email{guix-devel@@gnu.org} to say so, again signed with the OpenPGP key
you will use to sign commits (do that before pushing your first commit).
That way, everyone can notice and ensure you control that OpenPGP key.
@c TODO: Add note about adding the fingerprint to the list of authorized
@c keys once that has stabilized.
@quotation Important
Before you can push for the first time, maintainers must:
@enumerate
@item
add your OpenPGP key to the @code{keyring} branch;
@item
add your OpenPGP fingerprint to the @file{.guix-authorizations} file of
the branch(es) you will commit to.
@end enumerate
@end quotation
@item
Make sure to read the rest of this section and... profit!

4
doc/guix-cookbook.texi
View File

@ -1594,7 +1594,7 @@ An example configuration can look like this:
@cindex stumpwm fonts
By default StumpWM uses X11 fonts, which could be small or pixelated on
your system. You could fix this by installing StumpWM contrib Lisp
module @code{sbcl-stumpwm-ttf-fonts}, adding it to Guix system packages:
module @code{sbcl-ttf-fonts}, adding it to Guix system packages:
@lisp
(use-modules (gnu))
@ -1603,7 +1603,7 @@ module @code{sbcl-stumpwm-ttf-fonts}, adding it to Guix system packages:
(operating-system
;; …
(packages (append (list sbcl stumpwm `(,stumpwm "lib"))
sbcl-stumpwm-ttf-fonts font-dejavu %base-packages)))
sbcl-ttf-fonts font-dejavu %base-packages)))
@end lisp
Then you need to add the following code to a StumpWM configuration file

136
doc/guix.texi
View File

@ -79,6 +79,7 @@ Copyright @copyright{} 2020 Naga Malleswari@*
Copyright @copyright{} 2020 Brice Waegeneire@*
Copyright @copyright{} 2020 R Veera Kumar@*
Copyright @copyright{} 2020 Pierre Langlois@*
Copyright @copyright{} 2020 pinoaffe@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -1768,22 +1769,11 @@ can do so by running Emacs with the @code{--no-site-file} option
@subsection The GCC toolchain
@cindex GCC
@cindex ld-wrapper
Guix offers individual compiler packages such as @code{gcc} but if you
are in need of a complete toolchain for compiling and linking source
code what you really want is the @code{gcc-toolchain} package. This
package provides a complete GCC toolchain for C/C++ development,
including GCC itself, the GNU C Library (headers and binaries, plus
debugging symbols in the @code{debug} output), Binutils, and a linker
wrapper.
The wrapper's purpose is to inspect the @code{-L} and @code{-l} switches
passed to the linker, add corresponding @code{-rpath} arguments, and
invoke the actual linker with this new set of arguments. You can instruct the
wrapper to refuse to link against libraries not in the store by setting the
@code{GUIX_LD_WRAPPER_ALLOW_IMPURITIES} environment variable to @code{no}.
@c XXX: The contents of this section were moved under
@c ``Development'', since it makes more sense there and is not specific
@c foreign distros. Remove it from here eventually?
@xref{Packages for C Development}, for information on packages for C/C++
development.
@node Upgrading Guix
@section Upgrading Guix
@ -4681,6 +4671,7 @@ easily distributed to users who do not run Guix.
@menu
* Invoking guix environment:: Setting up development environments.
* Invoking guix pack:: Creating software bundles.
* Packages for C Development:: Working with C code with Guix.
@end menu
@node Invoking guix environment
@ -5344,6 +5335,27 @@ In addition, @command{guix pack} supports all the common build options
(@pxref{Common Build Options}) and all the package transformation
options (@pxref{Package Transformation Options}).
@node Packages for C Development
@section Packages for C Development
@cindex GCC
@cindex ld-wrapper
@cindex linker wrapper
@cindex toolchain, for C development
If you need a complete toolchain for compiling and linking C or C++
source code, use the @code{gcc-toolchain} package. This package
provides a complete GCC toolchain for C/C++ development, including GCC
itself, the GNU C Library (headers and binaries, plus debugging symbols
in the @code{debug} output), Binutils, and a linker wrapper.
The wrapper's purpose is to inspect the @code{-L} and @code{-l} switches
passed to the linker, add corresponding @code{-rpath} arguments, and
invoke the actual linker with this new set of arguments. You can instruct the
wrapper to refuse to link against libraries not in the store by setting the
@code{GUIX_LD_WRAPPER_ALLOW_IMPURITIES} environment variable to @code{no}.
@c *********************************************************************
@node Programming Interface
@ -14379,6 +14391,86 @@ Whether to enable password-based authentication.
@end table
@end deftp
@cindex AutoSSH
@deffn {Scheme Variable} autossh-service-type
This is the type for the @uref{https://www.harding.motd.ca/autossh,
AutoSSH} program that runs a copy of @command{ssh} and monitors it,
restarting it as necessary should it die or stop passing traffic.
AutoSSH can be run manually from the command-line by passing arguments
to the binary @command{autossh} from the package @code{autossh}, but it
can also be run as a Guix service. This latter use case is documented
here.
AutoSSH can be used to forward local traffic to a remote machine using
an SSH tunnel, and it respects the @file{~/.ssh/config} of the user it
is run as.
For example, to specify a service running autossh as the user
@code{pino} and forwarding all local connections to port @code{8081} to
@code{remote:8081} using an SSH tunnel, add this call to the operating
system's @code{services} field:
@lisp
(service autossh-service-type
(autossh-configuration
(user "pino")
(ssh-options (list "-T" "-N" "-L" "8081:localhost:8081" "remote.net"))))
@end lisp
@end deffn
@deftp {Data Type} autossh-configuration
This data type represents the configuration of an AutoSSH service.
@table @asis
@item @code{user} (default @code{"autossh"})
The user as which the AutoSSH service is to be run.
This assumes that the specified user exists.
@item @code{poll} (default @code{600})
Specifies the connection poll time in seconds.
@item @code{first-poll} (default @code{#f})
Specifies how many seconds AutoSSH waits before the first connection
test. After this first test, polling is resumed at the pace defined in
@code{poll}. When set to @code{#f}, the first poll is not treated
specially and will also use the connection poll specified in
@code{poll}.
@item @code{gate-time} (default @code{30})
Specifies how many seconds an SSH connection must be active before it is
considered successful.
@item @code{log-level} (default @code{1})
The log level, corresponding to the levels used by syslog---so @code{0}
is the most silent while @code{7} is the chattiest.
@item @code{max-start} (default @code{#f})
The maximum number of times SSH may be (re)started before AutoSSH exits.
When set to @code{#f}, no maximum is configured and AutoSSH may restart indefinitely.
@item @code{message} (default @code{""})
The message to append to the echo message sent when testing connections.
@item @code{port} (default @code{"0"})
The ports used for monitoring the connection. When set to @code{"0"},
monitoring is disabled. When set to @code{"@var{n}"} where @var{n} is
a positive integer, ports @var{n} and @var{n}+1 are used for
monitoring the connection, such that port @var{n} is the base
monitoring port and @code{n+1} is the echo port. When set to
@code{"@var{n}:@var{m}"} where @var{n} and @var{m} are positive
integers, the ports @var{n} and @var{n}+1 are used for monitoring the
connection, such that port @var{n} is the base monitoring port and
@var{m} is the echo port.
@item @code{ssh-options} (default @code{'()})
The list of command-line arguments to pass to @command{ssh} when it is
run. Options @option{-f} and @option{-M} are reserved for AutoSSH and
may cause undefined behaviour.
@end table
@end deftp
@defvr {Scheme Variable} %facebook-host-aliases
This variable contains a string for use in @file{/etc/hosts}
(@pxref{Host Names,,, libc, The GNU C Library Reference Manual}). Each
@ -26074,10 +26166,10 @@ pointed to by the @code{GIT_SSL_CAINFO} environment variable. Thus, you
would typically run something like:
@example
$ guix install nss-certs
$ export SSL_CERT_DIR="$HOME/.guix-profile/etc/ssl/certs"
$ export SSL_CERT_FILE="$HOME/.guix-profile/etc/ssl/certs/ca-certificates.crt"
$ export GIT_SSL_CAINFO="$SSL_CERT_FILE"
guix install nss-certs
export SSL_CERT_DIR="$HOME/.guix-profile/etc/ssl/certs"
export SSL_CERT_FILE="$HOME/.guix-profile/etc/ssl/certs/ca-certificates.crt"
export GIT_SSL_CAINFO="$SSL_CERT_FILE"
@end example
As another example, R requires the @code{CURL_CA_BUNDLE} environment
@ -26085,8 +26177,8 @@ variable to point to a certificate bundle, so you would have to run
something like this:
@example
$ guix install nss-certs
$ export CURL_CA_BUNDLE="$HOME/.guix-profile/etc/ssl/certs/ca-certificates.crt"
guix install nss-certs
export CURL_CA_BUNDLE="$HOME/.guix-profile/etc/ssl/certs/ca-certificates.crt"
@end example
For other applications you may want to look up the required environment

56
gnu/build/bootloader.scm
View File

@ -18,8 +18,12 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build bootloader)
#:use-module (guix build utils)
#:use-module (guix utils)
#:use-module (ice-9 binary-ports)
#:export (write-file-on-device))
#:use-module (ice-9 format)
#:export (write-file-on-device
install-efi-loader))
;;;
@ -36,3 +40,53 @@
(seek output offset SEEK_SET)
(put-bytevector output bv))
#:binary #t)))))
;;;
;;; EFI bootloader.
;;;
(define (install-efi grub grub-config esp)
"Write a self-contained GRUB EFI loader to the mounted ESP using GRUB-CONFIG."
(let* ((system %host-type)
;; Hard code the output location to a well-known path recognized by
;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
(grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
(efi-directory (string-append esp "/EFI/BOOT"))
;; Map grub target names to boot file names.
(efi-targets (cond ((string-prefix? "x86_64" system)
'("x86_64-efi" . "BOOTX64.EFI"))
((string-prefix? "i686" system)
'("i386-efi" . "BOOTIA32.EFI"))
((string-prefix? "armhf" system)
'("arm-efi" . "BOOTARM.EFI"))
((string-prefix? "aarch64" system)
'("arm64-efi" . "BOOTAA64.EFI")))))
;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
(setenv "TMPDIR" esp)
(mkdir-p efi-directory)
(invoke grub-mkstandalone "-O" (car efi-targets)
"-o" (string-append efi-directory "/"
(cdr efi-targets))
;; Graft the configuration file onto the image.
(string-append "boot/grub/grub.cfg=" grub-config))))
(define (install-efi-loader grub-efi esp)
"Install in ESP directory the given GRUB-EFI bootloader. Configure it to
load the Grub bootloader located in the 'Guix_image' root partition."
(let ((grub-config "grub.cfg"))
(call-with-output-file grub-config
(lambda (port)
;; Create a tiny configuration file telling the embedded grub where to
;; load the real thing. XXX This is quite fragile, and can prevent
;; the image from booting when there's more than one volume with this
;; label present. Reproducible almost-UUIDs could reduce the risk
;; (not eliminate it).
(format port
"insmod part_msdos~@
search --set=root --label Guix_image~@
configfile /boot/grub/grub.cfg~%")))
(install-efi grub-efi grub-config esp)
(delete-file grub-config)))

45
gnu/build/file-systems.scm
View File

@ -98,6 +98,47 @@ takes a bytevector and returns #t when it's a valid superblock."
(define null-terminated-latin1->string
(cut latin1->string <> zero?))
(define (bytevector-utf16-length bv)
"Given a bytevector BV containing a NUL-terminated UTF16-encoded string,
determine where the NUL terminator is and return its index. If there's no
NUL terminator, return the size of the bytevector."
(let ((length (bytevector-length bv)))
(let loop ((index 0))
(if (< index length)
(if (zero? (bytevector-u16-ref bv index 'little))
index
(loop (+ index 2)))
length))))
(define* (bytevector->u16-list bv endianness #:optional (index 0))
(if (< index (bytevector-length bv))
(cons (bytevector-u16-ref bv index endianness)
(bytevector->u16-list bv endianness (+ index 2)))
'()))
;; The initrd doesn't have iconv data, so do the conversion ourselves.
(define (utf16->string bv endianness)
(list->string
(map integer->char
(reverse
(let loop ((remainder (bytevector->u16-list bv endianness))
(result '()))
(match remainder
(() result)
((a) (cons a result))
((a b x ...)
(if (and (>= a #xD800) (< a #xDC00) ; high surrogate
(>= b #xDC00) (< b #xE000)) ; low surrogate
(loop x (cons (+ #x10000
(* #x400 (- a #xD800))
(- b #xDC00))
result))
(loop (cons b x) (cons a result))))))))))
(define (null-terminated-utf16->string bv endianness)
(utf16->string (sub-bytevector bv 0 (bytevector-utf16-length bv))
endianness))
;;;
;;; Ext2 file systems.
@ -377,7 +418,9 @@ if DEVICE does not contain an F2FS file system."
(define (f2fs-superblock-volume-name sblock)
"Return the volume name of SBLOCK as a string of at most 512 characters, or
#f if SBLOCK has no volume name."
(utf16->string (sub-bytevector sblock (- (+ #x470 12) #x400) 512) %f2fs-endianness))
(null-terminated-utf16->string
(sub-bytevector sblock (- (+ #x470 12) #x400) 512)
%f2fs-endianness))
(define (check-f2fs-file-system device)
"Return the health of a F2FS file system on DEVICE."

273
gnu/build/image.scm 100644
View File

@ -0,0 +1,273 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@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 (gnu build image)
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
#:use-module (guix store database)
#:use-module (gnu build bootloader)
#:use-module (gnu build install)
#:use-module (gnu build linux-boot)
#:use-module (gnu image)
#:use-module (gnu system uuid)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (make-partition-image
genimage
initialize-efi-partition
initialize-root-partition
make-iso9660-image))
(define (sexp->partition sexp)
"Take SEXP, a tuple as returned by 'partition->gexp', and turn it into a
<partition> record."
(match sexp
((size file-system label uuid)
(partition (size size)
(file-system file-system)
(label label)
(uuid uuid)))))
(define (size-in-kib size)
"Convert SIZE expressed in bytes, to kilobytes and return it as a string."
(number->string
(inexact->exact (ceiling (/ size 1024)))))
(define (estimate-partition-size root)
"Given the ROOT directory, evalute and return its size. As this doesn't
take the partition metadata size into account, take a 25% margin."
(* 1.25 (file-size root)))
(define* (make-ext4-image partition target root
#:key
(owner-uid 0)
(owner-gid 0))
"Handle the creation of EXT4 partition images. See 'make-partition-image'."
(let ((size (partition-size partition))
(label (partition-label partition))
(uuid (partition-uuid partition))
(options "lazy_itable_init=1,lazy_journal_init=1"))
(invoke "mke2fs" "-t" "ext4" "-d" root
"-L" label "-U" (uuid->string uuid)
"-E" (format #f "root_owner=~a:~a,~a"
owner-uid owner-gid options)
target
(format #f "~ak"
(size-in-kib
(if (eq? size 'guess)
(estimate-partition-size root)
size))))))
(define* (make-vfat-image partition target root)
"Handle the creation of VFAT partition images. See 'make-partition-image'."
(let ((size (partition-size partition))
(label (partition-label partition)))
(invoke "mkdosfs" "-n" label "-C" target "-F" "16" "-S" "1024"
(size-in-kib
(if (eq? size 'guess)
(estimate-partition-size root)
size)))
(for-each (lambda (file)
(unless (member file '("." ".."))
(invoke "mcopy" "-bsp" "-i" target
(string-append root "/" file)
(string-append "::" file))))
(scandir root))))
(define* (make-partition-image partition-sexp target root)
"Create and return the image of PARTITION-SEXP as TARGET. Use the given
ROOT directory to populate the image."
(let* ((partition (sexp->partition partition-sexp))
(type (partition-file-system partition)))
(cond
((string=? type "ext4")
(make-ext4-image partition target root))
((string=? type "vfat")
(make-vfat-image partition target root))
(else
(format (current-error-port)
"Unsupported partition type~%.")))))
(define* (genimage config target)
"Use genimage to generate in TARGET directory, the image described in the
given CONFIG file."
;; genimage needs a 'root' directory.
(mkdir "root")
(invoke "genimage" "--config" config
"--outputpath" target))
(define* (register-closure prefix closure
#:key
(deduplicate? #t) (reset-timestamps? #t)
(schema (sql-schema)))
"Register CLOSURE in PREFIX, where PREFIX is the directory name of the
target store and CLOSURE is the name of a file containing a reference graph as
produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is
true, reset timestamps on store files and, if DEDUPLICATE? is true,
deduplicates files common to CLOSURE and the rest of PREFIX."
(let ((items (call-with-input-file closure read-reference-graph)))
(register-items items
#:prefix prefix
#:deduplicate? deduplicate?
#:reset-timestamps? reset-timestamps?
#:registration-time %epoch
#:schema schema)))
(define* (initialize-efi-partition root
#:key
bootloader-package
#:allow-other-keys)
"Install in ROOT directory, an EFI loader using BOOTLOADER-PACKAGE."
(install-efi-loader bootloader-package root))
(define* (initialize-root-partition root
#:key
bootcfg
bootcfg-location
(deduplicate? #t)
references-graphs
(register-closures? #t)
system-directory
#:allow-other-keys)
"Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to
install the bootloader configuration.
If REGISTER-CLOSURES? is true, register REFERENCES-GRAPHS in the store. If
DEDUPLICATE? is true, then also deduplicate files common to CLOSURES and the
rest of the store when registering the closures. SYSTEM-DIRECTORY is the name
of the directory of the 'system' derivation."
(populate-root-file-system system-directory root)
(populate-store references-graphs root)
(when register-closures?
(for-each (lambda (closure)
(register-closure root
closure
#:reset-timestamps? #t
#:deduplicate? deduplicate?))
references-graphs))
(when bootcfg
(install-boot-config bootcfg bootcfg-location root)))
(define* (make-iso9660-image xorriso grub-mkrescue-environment
grub bootcfg system-directory root target
#:key (volume-id "Guix_image") (volume-uuid #f)
register-closures? (references-graphs '())
(compression? #t))
"Given a GRUB package, creates an iso image as TARGET, using BOOTCFG as
GRUB configuration and OS-DRV as the stuff in it."
(define grub-mkrescue
(string-append grub "/bin/grub-mkrescue"))
(define grub-mkrescue-sed.sh
(string-append (getcwd) "/" "grub-mkrescue-sed.sh"))
;; Use a modified version of grub-mkrescue-sed.sh, see below.
(copy-file (string-append xorriso
"/bin/grub-mkrescue-sed.sh")
grub-mkrescue-sed.sh)
;; Force grub-mkrescue-sed.sh to use the build directory instead of /tmp
;; that is read-only inside the build container.
(substitute* grub-mkrescue-sed.sh
(("/tmp/") (string-append (getcwd) "/"))
(("MKRESCUE_SED_XORRISO_ARGS \\$x")
(format #f "MKRESCUE_SED_XORRISO_ARGS $(echo $x | sed \"s|/tmp|~a|\")"
(getcwd))))
;; 'grub-mkrescue' calls out to mtools programs to create 'efi.img', a FAT
;; file system image, and mtools honors SOURCE_DATE_EPOCH for the mtime of
;; those files. The epoch for FAT is Jan. 1st 1980, not 1970, so choose
;; that.
(setenv "SOURCE_DATE_EPOCH"
(number->string
(time-second
(date->time-utc (make-date 0 0 0 0 1 1 1980 0)))))
;; Our patched 'grub-mkrescue' honors this environment variable and passes
;; it to 'mformat', which makes it the serial number of 'efi.img'. This
;; allows for deterministic builds.
(setenv "GRUB_FAT_SERIAL_NUMBER"
(number->string (if volume-uuid
;; On 32-bit systems the 2nd argument must be
;; lower than 2^32.
(string-hash (iso9660-uuid->string volume-uuid)
(- (expt 2 32) 1))
#x77777777)
16))
(setenv "MKRESCUE_SED_MODE" "original")
(setenv "MKRESCUE_SED_XORRISO" (string-append xorriso "/bin/xorriso"))
(setenv "MKRESCUE_SED_IN_EFI_NO_PT" "yes")
(for-each (match-lambda
((name . value) (setenv name value)))
grub-mkrescue-environment)
(apply invoke grub-mkrescue
(string-append "--xorriso=" grub-mkrescue-sed.sh)
"-o" target
(string-append "boot/grub/grub.cfg=" bootcfg)
root
"--"
;; Set all timestamps to 1.
"-volume_date" "all_file_dates" "=1"
`(,@(if compression?
'(;; ‘zisofs’ compression reduces the total image size by
;; ~60%.
"-zisofs" "level=9:block_size=128k" ; highest compression
;; It's transparent to our Linux-Libre kernel but not to
;; GRUB. Don't compress the kernel, initrd, and other
;; files read by grub.cfg, as well as common
;; already-compressed file names.
"-find" "/" "-type" "f"
;; XXX Even after "--" above, and despite documentation
;; claiming otherwise, "-or" is stolen by grub-mkrescue
;; which then chokes on it (as ‘-o …’) and dies. Don't use
;; "-or".
"-not" "-wholename" "/boot/*"
"-not" "-wholename" "/System/*"
"-not" "-name" "unicode.pf2"
"-not" "-name" "bzImage"
"-not" "-name" "*.gz" ; initrd & all man pages
"-not" "-name" "*.png" ; includes grub-image.png
"-exec" "set_filter" "--zisofs"
"--")
'())
"-volid" ,(string-upcase volume-id)
,@(if volume-uuid
`("-volume_date" "uuid"
,(string-filter (lambda (value)
(not (char=? #\- value)))
(iso9660-uuid->string
volume-uuid)))
'()))))

21
gnu/build/install.scm
View File

@ -25,7 +25,6 @@
#:export (install-boot-config
evaluate-populate-directive
populate-root-file-system
register-closure
install-database-and-gc-roots
populate-single-profile-directory))
@ -51,9 +50,14 @@ that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
(copy-file bootcfg pivot)
(rename-file pivot target)))
(define (evaluate-populate-directive directive target)
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
(default-uid 0))
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under
directory TARGET."
directory TARGET. DEFAULT-UID and DEFAULT-GID are the default UID and GID in
the context of the caller. If the directive matches those defaults then,
'chown' won't be run."
(let loop ((directive directive))
(catch 'system-error
(lambda ()
@ -63,7 +67,12 @@ directory TARGET."
(('directory name uid gid)
(let ((dir (string-append target name)))
(mkdir-p dir)
(chown dir uid gid)))
;; If called from a context without "root" permissions, "chown"
;; to root will fail. In that case, do not try to run "chown"
;; and assume that the file will be chowned elsewhere (when
;; interned in the store for instance).
(or (and (= uid default-uid) (= gid default-gid))
(chown dir uid gid))))
(('directory name uid gid mode)
(loop `(directory ,name ,uid ,gid))
(chmod (string-append target name) mode))
@ -98,9 +107,7 @@ directory TARGET."
(define (directives store)
"Return a list of directives to populate the root file system that will host
STORE."
`(;; Note: the store's GID is fixed precisely so we can set it here rather
;; than at activation time.
(directory ,store 0 30000 #o1775)
`((directory ,store 0 0 #o1775)
(directory "/etc")
(directory "/var/log") ; for shepherd

175
gnu/build/vm.scm
View File

@ -27,6 +27,7 @@
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
#:use-module (guix store database)
#:use-module (gnu build bootloader)
#:use-module (gnu build linux-boot)
#:use-module (gnu build install)
#:use-module (gnu system uuid)
@ -57,8 +58,7 @@
estimated-partition-size
root-partition-initializer
initialize-partition-table
initialize-hard-disk
make-iso9660-image))
initialize-hard-disk))
;;; Commentary:
;;;
@ -439,159 +439,6 @@ system that is passed to 'populate-root-file-system'."
(mkdir-p directory)
(symlink bootcfg (string-append directory "/bootcfg"))))
(define (install-efi grub esp config-file)
"Write a self-contained GRUB EFI loader to the mounted ESP using CONFIG-FILE."
(let* ((system %host-type)
;; Hard code the output location to a well-known path recognized by
;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
(grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
(efi-directory (string-append esp "/EFI/BOOT"))
;; Map grub target names to boot file names.
(efi-targets (cond ((string-prefix? "x86_64" system)
'("x86_64-efi" . "BOOTX64.EFI"))
((string-prefix? "i686" system)
'("i386-efi" . "BOOTIA32.EFI"))
((string-prefix? "armhf" system)
'("arm-efi" . "BOOTARM.EFI"))
((string-prefix? "aarch64" system)
'("arm64-efi" . "BOOTAA64.EFI")))))
;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
(setenv "TMPDIR" esp)
(mkdir-p efi-directory)
(invoke grub-mkstandalone "-O" (car efi-targets)
"-o" (string-append efi-directory "/"
(cdr efi-targets))
;; Graft the configuration file onto the image.
(string-append "boot/grub/grub.cfg=" config-file))))
(define* (make-iso9660-image xorriso grub-mkrescue-environment
grub config-file os-drv target
#:key (volume-id "Guix_image") (volume-uuid #f)
register-closures? (closures '()))
"Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as
GRUB configuration and OS-DRV as the stuff in it."
(define grub-mkrescue
(string-append grub "/bin/grub-mkrescue"))
(define grub-mkrescue-sed.sh
(string-append xorriso "/bin/grub-mkrescue-sed.sh"))
(define target-store
(string-append "/tmp/root" (%store-directory)))
(define items
;; The store items to add to the image.
(delete-duplicates
(append-map (lambda (closure)
(map store-info-item
(call-with-input-file (string-append "/xchg/" closure)
read-reference-graph)))
closures)))
(populate-root-file-system os-drv "/tmp/root")
(mount (%store-directory) target-store "" MS_BIND)
(when register-closures?
(display "registering closures...\n")
(for-each (lambda (closure)
(register-closure
"/tmp/root"
(string-append "/xchg/" closure)
;; TARGET-STORE is a read-only bind-mount so we shouldn't try
;; to modify it.
#:deduplicate? #f
#:reset-timestamps? #f))
closures)
(register-bootcfg-root "/tmp/root" config-file))
;; 'grub-mkrescue' calls out to mtools programs to create 'efi.img', a FAT
;; file system image, and mtools honors SOURCE_DATE_EPOCH for the mtime of
;; those files. The epoch for FAT is Jan. 1st 1980, not 1970, so choose
;; that.
(setenv "SOURCE_DATE_EPOCH"
(number->string
(time-second
(date->time-utc (make-date 0 0 0 0 1 1 1980 0)))))
;; Our patched 'grub-mkrescue' honors this environment variable and passes
;; it to 'mformat', which makes it the serial number of 'efi.img'. This
;; allows for deterministic builds.
(setenv "GRUB_FAT_SERIAL_NUMBER"
(number->string (if volume-uuid
;; On 32-bit systems the 2nd argument must be
;; lower than 2^32.
(string-hash (iso9660-uuid->string volume-uuid)
(- (expt 2 32) 1))
#x77777777)
16))
(setenv "MKRESCUE_SED_MODE" "original")
(setenv "MKRESCUE_SED_XORRISO" (string-append xorriso
"/bin/xorriso"))
(setenv "MKRESCUE_SED_IN_EFI_NO_PT" "yes")
(for-each (match-lambda
((name . value) (setenv name value)))
grub-mkrescue-environment)
(let ((pipe
(apply open-pipe* OPEN_WRITE
grub-mkrescue
(string-append "--xorriso=" grub-mkrescue-sed.sh)
"-o" target
(string-append "boot/grub/grub.cfg=" config-file)
"etc=/tmp/root/etc"
"var=/tmp/root/var"
"run=/tmp/root/run"
;; /mnt is used as part of the installation
;; process, as the mount point for the target
;; file system, so create it.
"mnt=/tmp/root/mnt"
"-path-list" "-"
"--"
;; Set all timestamps to 1.
"-volume_date" "all_file_dates" "=1"
;; ‘zisofs’ compression reduces the total image size by ~60%.
"-zisofs" "level=9:block_size=128k" ; highest compression
;; It's transparent to our Linux-Libre kernel but not to GRUB.
;; Don't compress the kernel, initrd, and other files read by
;; grub.cfg, as well as common already-compressed file names.
"-find" "/" "-type" "f"
;; XXX Even after "--" above, and despite documentation claiming
;; otherwise, "-or" is stolen by grub-mkrescue which then chokes
;; on it (as ‘-o …’) and dies. Don't use "-or".
"-not" "-wholename" "/boot/*"
"-not" "-wholename" "/System/*"
"-not" "-name" "unicode.pf2"
"-not" "-name" "bzImage"
"-not" "-name" "*.gz" ; initrd & all man pages
"-not" "-name" "*.png" ; includes grub-image.png
"-exec" "set_filter" "--zisofs"
"--"
"-volid" (string-upcase volume-id)
(if volume-uuid
`("-volume_date" "uuid"
,(string-filter (lambda (value)
(not (char=? #\- value)))
(iso9660-uuid->string
volume-uuid)))
`()))))
;; Pass lines like 'gnu/store/…-x=/gnu/store/…-x' corresponding to the
;; '-path-list -' option.
(for-each (lambda (item)
(format pipe "~a=~a~%"
(string-drop item 1) item))
items)
(unless (zero? (close-pipe pipe))
(error "oh, my! grub-mkrescue failed" grub-mkrescue))))
(define* (initialize-hard-disk device
#:key
bootloader-package
@ -633,30 +480,16 @@ passing it a directory name where it is mounted."
(when esp
;; Mount the ESP somewhere and install GRUB UEFI image.
(let ((mount-point (string-append target "/boot/efi"))
(grub-config (string-append target "/tmp/grub-standalone.cfg")))
(let ((mount-point (string-append target "/boot/efi")))
(display "mounting EFI system partition...\n")
(mkdir-p mount-point)
(mount (partition-device esp) mount-point
(partition-file-system esp))
;; Create a tiny configuration file telling the embedded grub
;; where to load the real thing.
;; XXX This is quite fragile, and can prevent the image from booting
;; when there's more than one volume with this label present.
;; Reproducible almost-UUIDs could reduce the risk (not eliminate it).
(call-with-output-file grub-config
(lambda (port)
(format port
"insmod part_msdos~@
search --set=root --label Guix_image~@
configfile /boot/grub/grub.cfg~%")))
(display "creating EFI firmware image...")
(install-efi grub-efi mount-point grub-config)
(install-efi-loader grub-efi mount-point)
(display "done.\n")
(delete-file grub-config)
(umount mount-point)))
;; Register BOOTCFG as a GC root.

45
gnu/ci.scm
View File

@ -38,6 +38,7 @@
#:select (lookup-compressor self-contained-tarball))
#:use-module (gnu bootloader)
#:use-module (gnu bootloader u-boot)
#:use-module (gnu image)
#:use-module (gnu packages)
#:use-module (gnu packages gcc)
#:use-module (gnu packages base)
@ -49,6 +50,7 @@
#:use-module (gnu packages make-bootstrap)
#:use-module (gnu packages package-management)
#:use-module (gnu system)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu system install)
#:use-module (gnu tests)
@ -213,32 +215,23 @@ system.")
(expt 2 20))
(if (member system %guixsd-supported-systems)
(if (member system %u-boot-systems)
(list (->job 'flash-image
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(system-disk-image
(operating-system (inherit installation-os)
(bootloader (bootloader-configuration
(bootloader u-boot-bootloader)
(target #f))))
#:disk-image-size
(* 1500 MiB))))))
(list (->job 'usb-image
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(system-disk-image installation-os
#:disk-image-size
(* 1500 MiB)))))
(->job 'iso9660-image
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(system-disk-image installation-os
#:file-system-type
"iso9660"))))))
(list (->job 'usb-image
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(system-image
(image
(inherit efi-disk-image)
(size (* 1500 MiB))
(operating-system installation-os))))))
(->job 'iso9660-image
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(system-image
(image
(inherit iso9660-image)
(operating-system installation-os)))))))
'()))
(define channel-build-system

76
gnu/image.scm 100644
View File

@ -0,0 +1,76 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@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 (gnu image)
#:use-module (guix records)
#:export (partition
partition?
partition-device
partition-size
partition-file-system
partition-label
partition-uuid
partition-flags
partition-initializer
image
image-name
image-format
image-size
image-operating-system
image-partitions
image-compression?
image-volatile-root?
image-substitutable?))
;;;
;;; Partition record.
;;;
(define-record-type* <partition> partition make-partition
partition?
(device partition-device (default #f))
(size partition-size)
(file-system partition-file-system (default "ext4"))
(label partition-label (default #f))
(uuid partition-uuid (default #f))
(flags partition-flags (default '()))
(initializer partition-initializer (default #f)))
;;;
;;; Image record.
;;;
(define-record-type* <image>
image make-image
image?
(format image-format) ;symbol
(size image-size ;size in bytes as integer
(default 'guess))
(operating-system image-operating-system ;<operating-system>
(default #f))
(partitions image-partitions ;list of <partition>
(default '()))
(compression? image-compression? ;boolean
(default #t))
(volatile-root? image-volatile-root? ;boolean
(default #t))
(substitutable? image-substitutable? ;boolean
(default #t)))

11
gnu/local.mk
View File

@ -62,6 +62,7 @@ GNU_SYSTEM_MODULES = \
%D%/bootloader/u-boot.scm \
%D%/bootloader/depthcharge.scm \
%D%/ci.scm \
%D%/image.scm \
%D%/packages.scm \
%D%/packages/abduco.scm \
%D%/packages/abiword.scm \
@ -260,6 +261,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/haskell-crypto.scm \
%D%/packages/haskell-web.scm \
%D%/packages/haskell-xyz.scm \
%D%/packages/heads.scm \
%D%/packages/hexedit.scm \
%D%/packages/hugs.scm \
%D%/packages/hurd.scm \
@ -471,6 +473,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/search.scm \
%D%/packages/security-token.scm \
%D%/packages/selinux.scm \
%D%/packages/sequoia.scm \
%D%/packages/serialization.scm \
%D%/packages/serveez.scm \
%D%/packages/shells.scm \
@ -605,6 +608,7 @@ GNU_SYSTEM_MODULES = \
%D%/system/accounts.scm \
%D%/system/file-systems.scm \
%D%/system/hurd.scm \
%D%/system/image.scm \
%D%/system/install.scm \
%D%/system/keyboard.scm \
%D%/system/linux-container.scm \
@ -625,6 +629,7 @@ GNU_SYSTEM_MODULES = \
%D%/build/activation.scm \
%D%/build/bootloader.scm \
%D%/build/cross-toolchain.scm \
%D%/build/image.scm \
%D%/build/file-systems.scm \
%D%/build/install.scm \
%D%/build/linux-boot.scm \
@ -824,6 +829,7 @@ dist_patch_DATA = \
%D%/packages/patches/clucene-pkgconfig.patch \
%D%/packages/patches/cmake-curl-certificates.patch \
%D%/packages/patches/coda-use-system-libs.patch \
%D%/packages/patches/collectd-5.11.0-noinstallvar.patch \
%D%/packages/patches/combinatorial-blas-awpm.patch \
%D%/packages/patches/combinatorial-blas-io-fix.patch \
%D%/packages/patches/containerd-test-with-go1.13.patch \
@ -1024,6 +1030,8 @@ dist_patch_DATA = \
%D%/packages/patches/gpsbabel-qstring.patch \
%D%/packages/patches/grantlee-merge-theme-dirs.patch \
%D%/packages/patches/grep-timing-sensitive-test.patch \
%D%/packages/patches/grocsvs-dont-use-admiral.patch \
%D%/packages/patches/gromacs-tinyxml2.patch \
%D%/packages/patches/groovy-add-exceptionutilsgenerator.patch \
%D%/packages/patches/grub-efi-fat-serial-number.patch \
%D%/packages/patches/grub-verifiers-Blocklist-fallout-cleanup.patch \
@ -1265,6 +1273,7 @@ dist_patch_DATA = \
%D%/packages/patches/mumps-shared-pord.patch \
%D%/packages/patches/mupen64plus-ui-console-notice.patch \
%D%/packages/patches/mupen64plus-video-z64-glew-correct-path.patch \
%D%/packages/patches/musl-cross-locale.patch \
%D%/packages/patches/mutt-store-references.patch \
%D%/packages/patches/m4-gnulib-libio.patch \
%D%/packages/patches/ncompress-fix-softlinks.patch \
@ -1459,6 +1468,8 @@ dist_patch_DATA = \
%D%/packages/patches/rust-1.25-accept-more-detailed-gdb-lines.patch \
%D%/packages/patches/rust-bootstrap-stage0-test.patch \
%D%/packages/patches/rust-coresimd-doctest.patch \
%D%/packages/patches/rust-nettle-disable-vendor.patch \
%D%/packages/patches/rust-nettle-sys-disable-vendor.patch \
%D%/packages/patches/rust-reproducible-builds.patch \
%D%/packages/patches/rust-openssl-sys-no-vendor.patch \
%D%/packages/patches/rxvt-unicode-escape-sequences.patch \

24
gnu/packages/algebra.scm
View File

@ -11,6 +11,7 @@
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Vincent Legoll <vincent.legoll@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -922,6 +923,29 @@ Fourier Transform} (DFT), @dfn{Discrete Cosine Transform} (DCT), @dfn{Discrete
Sine Transform} (DST) and @dfn{Discrete Hartley Transform} (DHT).")
(license license:bsd-2)))
(define-public lmfit
(package
(name "lmfit")
(version "8.2.2")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://jugit.fz-juelich.de/mlz/lmfit.git")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"00bch77a6qgnw6vzsjn2a42n8n683ih3xm0wpr454jxa15hw78vf"))))
(build-system cmake-build-system)
(native-inputs
`(("perl" ,perl))) ; for pod2man
(home-page "https://jugit.fz-juelich.de/mlz/lmfit")
(synopsis "Levenberg-Marquardt minimization and least-squares fitting")
(description "lmfit is a C library for Levenberg-Marquardt least-squares
minimization and curve fitting. It is mature code, based on decades-old
algorithms from the FORTRAN library MINPACK.")
(license license:bsd-2)))
(define-public eigen
(package
(name "eigen")

31
gnu/packages/audio.scm
View File

@ -31,6 +31,7 @@
;;; Copyright © 2020 Vincent Legoll <vincent.legoll@gmail.com>
;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2020 Jonathan Frederickson <jonathan@terracrypt.net>
;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -2320,18 +2321,20 @@ background file post-processing.")
(name "supercollider")
(version "3.10.4")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/supercollider/supercollider"
"/releases/download/Version-" version
"/SuperCollider-" version "-Source-linux.tar.bz2"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/supercollider/supercollider.git")
(commit (string-append "Version-" version))
;; for nova-simd, nova-tt, hidapi, TLSF, oscpack
(recursive? #t)))
(file-name (git-file-name name version))
(sha256
(base32
"0x11g3pfw11m6v18qfpfl5w99dbmf73g4z7wvwhrj1a4qv2dn084"))))
"0xdg1dx0y0agircnkn4bg3jpw184xc5pn28k7rrzgjh1rdnyzz24"))))
(build-system cmake-build-system)
(arguments
`(#:configure-flags '("-DSYSTEM_BOOST=on" "-DSYSTEM_YAMLCPP=on"
"-DSC_QT=off"
"-DSC_QT=off" "-DCMAKE_BUILD_TYPE=Release"
"-DSC_EL=off") ;scel is packaged individually as
;emacs-scel
#:modules ((guix build utils)
@ -2369,7 +2372,19 @@ background file post-processing.")
(("add_subdirectory\\(sclang\\)")
""))
(delete-file "testsuite/sclang/CMakeLists.txt")
#t)))))
#t))
(add-after 'disable-broken-tests 'patch-scclass-dir
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(scclass-dir
(string-append out
"/share/SuperCollider/SCClassLibrary")))
(substitute* "lang/LangSource/SC_LanguageConfig.cpp"
(((string-append
"SC_Filesystem::instance\\(\\)\\.getDirectory"
"\\(DirName::Resource\\) / CLASS_LIB_DIR_NAME"))
(string-append "Path(\"" scclass-dir "\")")))
#t))))))
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs

42
gnu/packages/bioinformatics.scm
View File

@ -79,6 +79,7 @@
#:use-module (gnu packages golang)
#:use-module (gnu packages glib)
#:use-module (gnu packages graph)
#:use-module (gnu packages graphviz)
#:use-module (gnu packages groff)
#:use-module (gnu packages gtk)
#:use-module (gnu packages guile)
@ -15854,3 +15855,44 @@ biological processes. SBML is useful for models of metabolism, cell
signaling, and more. It continues to be evolved and expanded by an
international community.")
(license license:lgpl2.1+)))
(define-public grocsvs
;; The last release is out of date and new features have been added.
(let ((commit "ecd956a65093a0b2c41849050e4512d46fecea5d")
(revision "1"))
(package
(name "grocsvs")
(version (git-version "0.2.6.1" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/grocsvs/grocsvs")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32 "14505725gr7qxc17cxxf0k6lzcwmgi64pija4mwf29aw70qn35cc"))
(patches (search-patches "grocsvs-dont-use-admiral.patch"))))
(build-system python-build-system)
(arguments
`(#:tests? #f ; No test suite.
#:python ,python-2)) ; Only python-2 supported.
(inputs
`(("python2-h5py" ,python2-h5py)
("python2-ipython-cluster-helper" ,python2-ipython-cluster-helper)
("python2-networkx" ,python2-networkx)
("python2-psutil" ,python2-psutil)
("python2-pandas" ,python2-pandas)
("python2-pybedtools" ,python2-pybedtools)
("python2-pyfaidx" ,python2-pyfaidx)
("python2-pygraphviz" ,python2-pygraphviz)
("python2-pysam" ,python2-pysam)
("python2-scipy" ,python2-scipy)))
(home-page "https://github.com/grocsvs/grocsvs")
(synopsis "Genome-wide reconstruction of complex structural variants")
(description
"@dfn{Genome-wide Reconstruction of Complex Structural Variants}
(GROC-SVs) is a software pipeline for identifying large-scale structural
variants, performing sequence assembly at the breakpoints, and reconstructing
the complex structural variants using the long-fragment information from the
10x Genomics platform.")
(license license:expat))))

25
gnu/packages/check.scm
View File

@ -32,6 +32,7 @@
;;; Copyright © 2019 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2020 Josh Marshall <joshua.r.marshall.1991@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -1458,6 +1459,30 @@ executed.")
(define-public python2-coverage
(package-with-python2 python-coverage))
(define-public python-pytest-asyncio
(package
(name "python-pytest-asyncio")
(version "0.10.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "pytest-asyncio" version))
(sha256
(base32 "1bysy4nii13bm7h345wxf8fxcjhab7l374pqdv7vwv3izl053b4z"))))
(build-system python-build-system)
(native-inputs
`(("python-coverage" ,python-coverage)
("python-async-generator" ,python-async-generator)
("python-hypothesis" ,python-hypothesis)
("python-pytest" ,python-pytest)))
(home-page "https://github.com/pytest-dev/pytest-asyncio")
(synopsis "Pytest support for asyncio")
(description "Python asyncio code is usually written in the form of
coroutines, which makes it slightly more difficult to test using normal
testing tools. @code{pytest-asyncio} provides useful fixtures and markers
to make testing async code easier.")
(license license:asl2.0)))
(define-public python-cov-core
(package
(name "python-cov-core")

126
gnu/packages/chemistry.scm
View File

@ -4,6 +4,7 @@
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;; Copyright © 2020 Vincent Legoll <vincent.legoll@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -29,15 +30,20 @@
#:use-module (gnu packages)
#:use-module (gnu packages algebra)
#:use-module (gnu packages boost)
#:use-module (gnu packages check)
#:use-module (gnu packages compression)
#:use-module (gnu packages documentation)
#:use-module (gnu packages gl)
#:use-module (gnu packages graphviz)
#:use-module (gnu packages gv)
#:use-module (gnu packages maths)
#:use-module (gnu packages mpi)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages python-xyz)
#:use-module (gnu packages qt)
#:use-module (gnu packages sphinx)
#:use-module (gnu packages xml)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
@ -300,6 +306,126 @@ is currently not actively maintained and works only with Python 2 and
NumPy < 1.9.")
(license license:cecill)))
(define-public tng
(package
(name "tng")
(version "1.8.2")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/gromacs/tng.git")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1apf2n8nb34z09xarj7k4jgriq283l769sakjmj5aalpbilvai4q"))))
(build-system cmake-build-system)
(inputs
`(("zlib" ,zlib)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'remove-bundled-zlib
(lambda _
(delete-file-recursively "external")
#t))
(replace 'check
(lambda _
(invoke "../build/bin/tests/tng_testing")
#t)))))
(home-page "https://github.com/gromacs/tng")
(synopsis "Trajectory Next Generation binary format manipulation library")
(description "TRAJNG (Trajectory next generation) is a program library for
handling molecular dynamics (MD) trajectories. It can store coordinates, and
optionally velocities and the H-matrix. Coordinates and velocities are
stored with user-specified precision.")
(license license:bsd-3)))
(define-public gromacs
(package
(name "gromacs")
(version "2020.2")
(source (origin
(method url-fetch)
(uri (string-append "http://ftp.gromacs.org/pub/gromacs/gromacs-"
version ".tar.gz"))
(sha256
(base32
"1wyjgcdl30wy4hy6jvi9lkq53bqs9fgfq6fri52dhnb3c76y8rbl"))
;; Our version of tinyxml2 is far newer than the bundled one and
;; require fixing `testutils' code. See patch header for more info
(patches (search-patches "gromacs-tinyxml2.patch"))))
(build-system cmake-build-system)
(arguments
`(#:configure-flags
(list "-DGMX_DEVELOPER_BUILD=on" ; Needed to run tests
;; Unbundling
"-DGMX_USE_LMFIT=EXTERNAL"
"-DGMX_BUILD_OWN_FFTW=off"
"-DGMX_EXTERNAL_BLAS=on"
"-DGMX_EXTERNAL_LAPACK=on"
"-DGMX_EXTERNAL_TNG=on"
"-DGMX_EXTERNAL_ZLIB=on"
"-DGMX_EXTERNAL_TINYXML2=on"
(string-append "-DTinyXML2_DIR="
(assoc-ref %build-inputs "tinyxml2"))
;; Workaround for cmake/FindSphinx.cmake version parsing that does
;; not understand the guix-wrapped `sphinx-build --version' answer
(string-append "-DSPHINX_EXECUTABLE_VERSION="
,(package-version python-sphinx)))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fixes
(lambda* (#:key inputs #:allow-other-keys)
;; Still bundled: part of gromacs, source behind registration
;; but free software anyways
;;(delete-file-recursively "src/external/vmd_molfile")
;; Still bundled: threads-based OpenMPI-compatible fallback
;; designed to be bundled like that
;;(delete-file-recursively "src/external/thread_mpi")
;; Unbundling
(delete-file-recursively "src/external/lmfit")
(delete-file-recursively "src/external/clFFT")
(delete-file-recursively "src/external/fftpack")
(delete-file-recursively "src/external/build-fftw")
(delete-file-recursively "src/external/tng_io")
(delete-file-recursively "src/external/tinyxml2")
(delete-file-recursively "src/external/googletest")
(copy-recursively (assoc-ref inputs "googletest-source")
"src/external/googletest")
;; This test warns about the build host hardware, disable
(substitute* "src/gromacs/hardware/tests/hardwaretopology.cpp"
(("TEST\\(HardwareTopologyTest, HwlocExecute\\)")
"void __guix_disabled()"))
#t)))))
(native-inputs
`(("doxygen" ,doxygen)
("googletest-source" ,(package-source googletest))
("graphviz" ,graphviz)
("pkg-config" ,pkg-config)
("python" ,python)
("python-pygments" ,python-pygments)
("python-sphinx" ,python-sphinx)))
(inputs
`(("fftwf" ,fftwf)
("hwloc" ,hwloc-2 "lib")
("lmfit" ,lmfit)
("openblas" ,openblas)
("perl" ,perl)
("tinyxml2" ,tinyxml2)
("tng" ,tng)))
(home-page "http://www.gromacs.org/")
(synopsis "Molecular dynamics software package")
(description "GROMACS is a versatile package to perform molecular dynamics,
i.e. simulate the Newtonian equations of motion for systems with hundreds to
millions of particles. It is primarily designed for biochemical molecules like
proteins, lipids and nucleic acids that have a lot of complicated bonded
interactions, but since GROMACS is extremely fast at calculating the nonbonded
interactions (that usually dominate simulations) many groups are also using it
for research on non-biological systems, e.g. polymers. GROMACS supports all the
usual algorithms you expect from a modern molecular dynamics implementation.")
(license license:lgpl2.1+)))
(define-public openbabel
(package
(name "openbabel")

2026
gnu/packages/crates-io.scm
View File

File diff suppressed because it is too large Load Diff

6
gnu/packages/databases.scm
View File

@ -3472,7 +3472,8 @@ The drivers officially supported by @code{libdbi} are:
("sqlite" ,sqlite)
("odbc" ,unixodbc)
("boost" ,boost)
("mysql" ,mysql)))
("mariadb:dev" ,mariadb "dev")
("mariadb:lib" ,mariadb "lib")))
(arguments
`(#:tests? #f ; Tests may require running database management systems.
#:phases
@ -3480,7 +3481,8 @@ The drivers officially supported by @code{libdbi} are:
(add-after 'unpack 'fix-lib-path
(lambda _
(substitute* "CMakeLists.txt"
(("set\\(SOCI_LIBDIR \"lib64\"\\)") "")))))))
(("set\\(SOCI_LIBDIR \"lib64\"\\)") ""))
#t)))))
(synopsis "C++ Database Access Library")
(description
"SOCI is an abstraction layer for several database backends, including

16
gnu/packages/emacs-xyz.scm
View File

@ -1003,13 +1003,13 @@ in certain cases. It also enables recursion for anonymous functions.")
(define-public emacs-xr
(package
(name "emacs-xr")
(version "1.18")
(version "1.19")
(source
(origin
(method url-fetch)
(uri (string-append "https://elpa.gnu.org/packages/xr-" version ".tar"))
(sha256
(base32 "1nq9pj47sxgpkw97c2xrkhgcwh3zsfd2a22qiqbl4i9zf2l9yy91"))))
(base32 "1aa3iqh0r635jw8k89zh8y4am9d4hfrqpk9mrdh2b51invjn8llq"))))
(build-system emacs-build-system)
(home-page "https://elpa.gnu.org/packages/xr.html")
(synopsis "Convert string regexp to rx notation")
@ -1107,14 +1107,14 @@ optional minor mode which can apply this command automatically on save.")
(define-public emacs-relint
(package
(name "emacs-relint")
(version "1.15")
(version "1.16")
(source
(origin
(method url-fetch)
(uri (string-append
"https://elpa.gnu.org/packages/relint-" version ".tar"))
(sha256
(base32 "0sxmdsacj8my942k8j76m2y68nzab7190acv7cwgflc5n4f07yxa"))))
(base32 "0cwk806g2kq60sql8sic2zdn63l1g2pzdiklcv0w8l2k9wssknnx"))))
(build-system emacs-build-system)
(propagated-inputs `(("emacs-xr" ,emacs-xr)))
(home-page "https://github.com/mattiase/relint")
@ -21142,14 +21142,14 @@ Emacs that integrate with major modes like Org-mode.")
(define-public emacs-modus-operandi-theme
(package
(name "emacs-modus-operandi-theme")
(version "0.8.0")
(version "0.8.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://elpa.gnu.org/packages/"
"modus-operandi-theme-" version ".el"))
(sha256
(base32 "09lw556jphrxrmwxkwzfgd4r7ylz99m8awxka4sfj5sa8fbjb3g8"))))
(base32 "0i8s6blkhx53m1jk1bblqs7fwlbn57xkxxhsp9famcj5m0xyfimb"))))
(build-system emacs-build-system)
(home-page "https://gitlab.com/protesilaos/modus-themes")
(synopsis "Accessible light theme (WCAG AAA)")
@ -21163,14 +21163,14 @@ standard. This is the highest standard of its kind.")
(define-public emacs-modus-vivendi-theme
(package
(name "emacs-modus-vivendi-theme")
(version "0.8.0")
(version "0.8.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://elpa.gnu.org/packages/"
"modus-vivendi-theme-" version ".el"))
(sha256
(base32 "0hwkzbx7a9scdr589sb7hw90lsm8yxcn3y5xr3bpyxf8rkr2zl4c"))))
(base32 "121nlr5w58j4q47rh9xjjf9wzb97yl2m1n2l6g58ck4vnarwndl1"))))
(build-system emacs-build-system)
(home-page "https://gitlab.com/protesilaos/modus-themes")
(synopsis "Accessible dark theme (WCAG AAA)")

76
gnu/packages/enlightenment.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Tomáš Čech <sleep_walker@suse.cz>
;;; Copyright © 2015 Daniel Pimentel <d4n1@member.fsf.org>
;;; Copyright © 2015, 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 ng0 <ng0@n0.is>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Timo Eisenmann <eisenmann@fn.de>
@ -69,7 +69,7 @@
(define-public efl
(package
(name "efl")
(version "1.23.3")
(version "1.24.0")
(source (origin
(method url-fetch)
(uri (string-append
@ -77,7 +77,7 @@
version ".tar.xz"))
(sha256
(base32
"00b9lp3h65254kdb1ys15fv7p3ln7qsvf15jkw4kli5ymagadkjk"))))
"1yhck2g4rwlzgnzqa4wjxw3lf6k6rd730hz4bwzajdjy7i26xfdk"))))
(build-system meson-build-system)
(native-inputs
`(("check" ,check)
@ -93,6 +93,7 @@
("libraw" ,libraw)
("librsvg" ,librsvg)
("libspectre" ,libspectre)
("libtiff" ,libtiff)
("libxau" ,libxau)
("libxcomposite" ,libxcomposite)
("libxcursor" ,libxcursor)
@ -102,18 +103,18 @@
("libxi" ,libxi)
("libxfixes" ,libxfixes)
("libxinerama" ,libxinerama)
("libxp" ,libxp)
("libxrandr" ,libxrandr)
("libxrender" ,libxrender)
("libxss" ,libxscrnsaver)
("libxtst" ,libxtst)
("libwebp" ,libwebp)
("openjpeg" ,openjpeg)
("poppler" ,poppler)
("wayland-protocols" ,wayland-protocols)))
(propagated-inputs
;; All these inputs are in package config files in section
;; Requires.private.
`(("avahi" ,avahi)
("bullet" ,bullet)
("dbus" ,dbus)
("elogind" ,elogind)
("eudev" ,eudev)
@ -122,15 +123,13 @@
("fribidi" ,fribidi)
("glib" ,glib)
("harfbuzz" ,harfbuzz)
("luajit" ,luajit)
("libinput" ,libinput-minimal)
("libjpeg" ,libjpeg-turbo)
("libpng" ,libpng)
("libsndfile" ,libsndfile)
("libtiff" ,libtiff)
("libwebp" ,libwebp)
("libpng" ,libpng)
("libx11" ,libx11)
("libxkbcommon" ,libxkbcommon)
("luajit" ,luajit)
("lz4" ,lz4)
("openssl" ,openssl)
("pulseaudio" ,pulseaudio)
@ -139,13 +138,18 @@
("zlib" ,zlib)))
(arguments
`(#:configure-flags '("-Dsystemd=false"
"-Delogind=true"
"-Dembedded-lz4=false"
"-Devas-loaders-disabler=json"
"-Dbuild-examples=false"
"-Decore-imf-loaders-disabler=scim"
"-Davahi=true"
"-Dglib=true"
"-Dmount-path=/run/setuid-programs/mount"
"-Dunmount-path=/run/setuid-programs/umount"
;(string-append "-Ddictionaries-hyphen-dir="
; (assoc-ref %build-inputs "hyphen")
; "/share/hyphen")
"-Delogind=true"
"-Dnetwork-backend=connman"
,@(match (%current-system)
("armhf-linux"
@ -153,8 +157,8 @@
(_
'("-Dopengl=full")))
;; for wayland
"-Dwl-deprecated=true" ; ecore_wayland
"-Ddrm-deprecated=true" ; ecore_drm
"-Dwl-deprecated=true" ; ecore_wayland
"-Ddrm-deprecated=true" ; ecore_drm
"-Dwl=true"
"-Ddrm=true")
#:tests? #f ; Many tests fail due to timeouts and network requests.
@ -336,8 +340,8 @@ Libraries with some extra bells and whistles.")
(substitute* "src/modules/everything/evry_plug_calc.c"
(("bc -l") (string-append bc "/bin/bc -l")))
(substitute* "data/etc/meson.build"
(("/bin/mount") (string-append utils "/bin/mount"))
(("/bin/umount") (string-append utils "/bin/umount"))
(("/bin/mount") "/run/setuid-programs/mount")
(("/bin/umount") "/run/setuid-programs/umount")
(("/usr/bin/eject") (string-append utils "/bin/eject"))
(("/usr/bin/l2ping") (string-append bluez "/bin/l2ling"))
(("/bin/rfkill") (string-append utils "/sbin/rfkill"))
@ -389,7 +393,7 @@ embedded systems.")
(define-public python-efl
(package
(name "python-efl")
(version "1.23.0")
(version "1.24.0")
(source
(origin
(method url-fetch)
@ -397,7 +401,7 @@ embedded systems.")
"python/python-efl-" version ".tar.xz"))
(sha256
(base32
"16yn6a1b9167nfmryyi44ma40m20ansfpwgrvqzfvwix7qaz9pib"))
"1vk1cdd959gia4a9qzyq56a9zw3lqf9ck66k8c9g3c631mp5cfpy"))
(modules '((guix build utils)))
;; Remove files generated by Cython
(snippet
@ -449,25 +453,32 @@ Libraries stack (eo, evas, ecore, edje, emotion, ethumb and elementary).")
(define-public edi
(package
(name "edi")
(version "0.6.0")
(version "0.8.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://download.enlightenment.org/rel/apps/edi/"
name "-" version ".tar.xz"))
(uri (string-append "https://github.com/Enlightenment/edi/releases/"
"download/v" version "/edi-" version ".tar.xz"))
(sha256
(base32
"0iqkah327ms5m7k054hcik2l9v68i4mg9yy52brprfqpd5jk7pw8"))))
(build-system gnu-build-system)
"01k8gp8r2wa6pyg3dkbm35m6hdsbss06hybghg0qjmd4mzswcd3a"))))
(build-system meson-build-system)
(arguments
'(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-clang-header
(lambda _
(substitute* "scripts/clang_include_dir.sh"
(("grep clang") "grep clang | head -n1"))
#t))
(add-after 'unpack 'set-home-directory
;; FATAL: Cannot create run dir '/homeless-shelter/.run' - errno=2
(lambda _ (setenv "HOME" "/tmp") #t)))
#:tests? #f)) ; tests require running dbus service
(native-inputs
`(("pkg-config" ,pkg-config)))
`(("check" ,check)
("gettext" ,gettext-minimal)
("pkg-config" ,pkg-config)))
(inputs
`(("clang" ,clang)
("efl" ,efl)))
@ -478,7 +489,8 @@ the EFL. It's aim is to create a new, native development environment for Linux
that tries to lower the barrier to getting involved in Enlightenment development
and in creating applications based on the Enlightenment Foundation Library suite.")
(license (list license:public-domain ; data/extra/skeleton
license:gpl2)))) ; edi
license:gpl2 ; edi
license:gpl3)))) ; data/extra/examples/images/mono-runtime.png
(define-public lekha
(package
@ -560,7 +572,7 @@ directories.
(define-public evisum
(package
(name "evisum")
(version "0.2.6")
(version "0.4.0")
(source
(origin
(method url-fetch)
@ -568,22 +580,14 @@ directories.
"evisum/evisum-" version ".tar.xz"))
(sha256
(base32
"1rg3kri6j8nmab0kdljnmcc096c8ibgwzvbhqr0b25xpmrq8bcac"))))
(build-system gnu-build-system)
"0gh3y2348pgf683sljnfry9k545h42dx75idyigcspsjsk7khisz"))))
(build-system meson-build-system)
(arguments
'(#:tests? #f ; no tests
#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))
#:phases
(modify-phases %standard-phases
(delete 'configure) ; no configure phase
(add-after 'unpack 'set-environmental-variables
(lambda _ (setenv "CC" (which "gcc")) #t)))))
'(#:tests? #f)) ; no tests
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("alsa-lib" ,alsa-lib)
("efl" ,efl)
("perl" ,perl)))
`(("efl" ,efl)))
(home-page "https://www.enlightenment.org")
(synopsis "EFL process viewer")
(description

1
gnu/packages/gnome.scm
View File

@ -6623,6 +6623,7 @@ Compatible with Cisco VPN concentrators configured to use IPsec.")
("kmod" ,kmod)
("libsecret" ,libsecret)
("libxml2" ,libxml2)
("lz4" ,lz4)
("network-manager" ,network-manager)
("openconnect" ,openconnect)))
(home-page "https://wiki.gnome.org/Projects/NetworkManager/VPN")

163
gnu/packages/heads.scm 100644
View File

@ -0,0 +1,163 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.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/>.
(define-module (gnu packages heads)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix utils)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages algebra)
#:use-module (gnu packages assembly)
#:use-module (gnu packages autotools)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages compression)
#:use-module (gnu packages flex)
#:use-module (gnu packages bison)
#:use-module (gnu packages elf)
#:use-module (gnu packages m4)
#:use-module (gnu packages curl)
#:use-module (gnu packages linux)
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages python)
#:use-module (gnu packages cpio)
#:use-module (gnu packages file)
#:use-module (gnu packages perl)
#:use-module (gnu packages version-control)
#:use-module (gnu packages virtualization)
#:use-module ((guix build utils) #:select (alist-replace)))
(define-public musl-cross
(let ((revision "3")
(commit "a8a66490dae7f23a2cf5e256f3a596d1ccfe1a03"))
(package
(name "musl-cross")
(version (git-version "0.1" revision commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/GregorR/musl-cross")
(commit commit)))
(file-name "musl-cross-checkout")
(sha256
(base32
"1xvl9y017wb2qaphy9zqh3vrhm8hklr8acvzzcjc35d1jjhyl58y"))
(patches (search-patches "musl-cross-locale.patch"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; No tests in main project.
#:modules
((guix build utils)
(guix build gnu-build-system)
(srfi srfi-1)) ; drop
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda _
(setenv "SHELL" "bash")
(setenv "CONFIG_SHELL" "bash")
#t))
(add-after 'unpack 'unpack-dependencies
(lambda* (#:key inputs outputs #:allow-other-keys)
(define (install-file* source-key destination-directory
destination-suffix)
(let* ((source-file (assoc-ref inputs source-key))
(source-basename (basename source-file))
(source-parts (string-split source-basename #\-))
(destination-file
(string-join (drop source-parts 1) "-")))
(copy-file source-file
(string-append destination-directory "/"
destination-file destination-suffix))))
(for-each (lambda (name)
(install-file* name "tarballs" ""))
'("binutils" "target-gcc-5" "linux-headers" "musl"))
(copy-file (string-append (assoc-ref inputs "config.sub")
"/share/automake-1.16/config.sub")
"tarballs/config.sub;hb=3d5db9ebe860")
(copy-file (string-append (assoc-ref inputs "config.sub")
"/share/automake-1.16/config.guess")
"tarballs/config.guess;hb=3d5db9ebe860")
(substitute* "config.sh"
(("^CC_BASE_PREFIX=.*")
(string-append "CC_BASE_PREFIX=" (assoc-ref outputs "out")
"/crossgcc\n")))
;; Note: Important: source/gcc-5.3.0/gcc/exec-tool.in
;; Note: Important: source/kernel-headers-3.12.6-5/tools/install.sh
;; Note: Important: move-if-change (twice)
;; Make sure that shebangs are patched after new extractions.
(substitute* "defs.sh"
(("touch \"[$]2/extracted\"")
(string-append "touch \"$2/extracted\"
for s in mkinstalldirs move-if-change compile depcomp callprocs configure \\
mkdep compile libtool-ldflags config.guess install-sh missing config.sub \\
config.rpath progtest.m4 lib-ld.m4 acx.m4 gen-fixed.sh mkheader.sh ylwrap \\
merge.sh godeps.sh lock-and-run.sh print-sysroot-suffix.sh mkconfig.sh \\
genmultilib exec-tool.in install.sh
do
find . -name $s -exec sed -i -e 's;!/bin/sh;!" (assoc-ref inputs "bash")
"/bin/sh;' '{}' ';'
find . -name $s -exec sed -i -e 's; /bin/sh; " (assoc-ref inputs "bash")
"/bin/sh;' '{}' ';'
done
" )))
#t))
(replace 'build
(lambda* (#:key outputs #:allow-other-keys)
(invoke "./build.sh")))
(delete 'install))))
(native-inputs
`(("config.sub" ,automake)
("bash" ,bash)
("flex" ,flex)
("gmp" ,gmp)
("mpfr" ,mpfr)
("mpc" ,mpc)
("binutils"
,(origin
(method url-fetch)
(uri "https://ftpmirror.gnu.org/gnu/binutils/binutils-2.27.tar.bz2")
(sha256
(base32 "125clslv17xh1sab74343fg6v31msavpmaa1c1394zsqa773g5rn"))))
("target-gcc-5"
,(origin
(method url-fetch)
(uri "https://ftpmirror.gnu.org/gnu/gcc/gcc-5.3.0/gcc-5.3.0.tar.bz2")
(sha256
(base32 "1ny4smkp5bzs3cp8ss7pl6lk8yss0d9m4av1mvdp72r1x695akxq"))))
("linux-headers"
,(origin
(method url-fetch)
(uri "http://ftp.barfooze.de/pub/sabotage/tarballs/linux-headers-4.19.88.tar.xz")
(sha256
(base32 "1srgi2nqw892jb6yd4kzacf2xzwfvzhsv2957xfh1nvbs7varwyk"))))
("musl"
,(origin
(method url-fetch)
(uri "http://www.musl-libc.org/releases/musl-1.1.24.tar.gz")
(sha256
(base32 "18r2a00k82hz0mqdvgm7crzc7305l36109c0j9yjmkxj2alcjw0k"))))))
(home-page "https://github.com/osresearch/heads")
(synopsis "Musl-cross gcc 5 toolchain")
(description "Musl-cross toolchain: binutils, gcc 5 and musl.")
(license license:isc))))

17
gnu/packages/image.scm
View File

@ -603,10 +603,8 @@ collection of tools for doing simple manipulations of TIFF images.")
("libjpeg" ,libjpeg-turbo)
("libpng" ,libpng)
("libtiff" ,libtiff)
("libwebp" ,libwebp)))
(propagated-inputs
;; Linking a program with leptonica also requires these.
`(("openjpeg" ,openjpeg)
("libwebp" ,libwebp)
("openjpeg" ,openjpeg)
("zlib" ,zlib)))
(arguments
'(#:phases
@ -618,7 +616,16 @@ collection of tools for doing simple manipulations of TIFF images.")
(string-append " " (which "sh") " "))
(("which gnuplot")
"true"))
#t)))))
#t))
(add-after 'install 'provide-absolute-giflib-reference
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(giflib (assoc-ref inputs "giflib")))
;; Add an absolute reference to giflib to avoid propagation.
(with-directory-excursion (string-append out "/lib")
(substitute* '("liblept.la" "pkgconfig/lept.pc")
(("-lgif") (string-append "-L" giflib "/lib -lgif"))))
#t))))))
(home-page "http://www.leptonica.com/")
(synopsis "Library and tools for image processing and analysis")
(description

44
gnu/packages/less.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020 Michael Rohleder <mike@rohleder.de>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,8 +23,11 @@
#:use-module (guix licenses)
#:use-module (gnu packages)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages perl)
#:use-module (gnu packages file)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu))
(define-public less
@ -51,3 +55,43 @@ backwards and forwards movement through the document. It also does not have
to read the entire input file before starting, so it starts faster than most
text editors.")
(license gpl3+))) ; some files are under GPLv2+
(define-public lesspipe
(package
(name "lesspipe")
(version "1.84")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/wofr06/lesspipe.git")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"124ffhzrikr88ab14rk6753n8adxijpmg7q3zx7nmqc52wpkfd8q"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ; no tests
#:phases (modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(delete-file "Makefile") ; force generating
(invoke "./configure"
(string-append "--prefix=" out)
"--yes")
#t))))))
(inputs
`(("file" ,file)
("ncurses" ,ncurses))) ; for tput
(native-inputs `(("perl" ,perl)))
(home-page "https://github.com/wofr06/lesspipe")
(synopsis "Input filter for less")
(description "To browse files, the excellent viewer @code{less} can be
used. By setting the environment variable @code{LESSOPEN}, less can be
enhanced by external filters to become more powerful. The input filter for
less described here is called @code{lesspipe.sh}. It is able to process a
wide variety of file formats. It enables users to inspect archives and
display their contents without having to unpack them before. The filter is
easily extensible for new formats.")
(license gpl2+)))

4
gnu/packages/libusb.scm
View File

@ -9,6 +9,7 @@
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Vagrant Cascadian <vagrant@debian.org>
;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2020 Christopher Howard <christopher@librehacker.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -114,7 +115,8 @@ version of libusb to run with newer libusb.")
(sha256
(base32
"0i4bacxkyr7xyqxbmb00ypkrv4swkgm0mghbzjsnw6blvvczgxip"))
(patches (search-patches "libusb-0.1-disable-tests.patch"))))))
(patches (search-patches "libusb-0.1-disable-tests.patch"))))
(arguments `(#:configure-flags (list "CFLAGS=-Wno-error")))))
(define-public libusb4java
;; There is no public release so we take the latest version from git.

69
gnu/packages/linux.scm
View File

@ -200,9 +200,9 @@ defconfig. Return the appropriate make target if applicable, otherwise return
(define deblob-scripts-5.4
(linux-libre-deblob-scripts
"5.4.28"
"5.4.37"
(base32 "0ckxn7k5zgcqk30dq943bnamr6a6zjbw2aqjl3x30f4kvh5f6k25")
(base32 "08ls4gx5vanyiq9rn0869nfq4piw4lx1dl8hh9w9xgkr4ypc1j4k")))
(base32 "10qb890is4z58vr8czh3xx69q62l3b3j38y410kgiw8nii3zx5lr")))
(define deblob-scripts-4.19
(linux-libre-deblob-scripts
@ -369,50 +369,50 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
(sha256 hash)))
(define-public linux-libre-5.6-version "5.6.8")
(define-public linux-libre-5.6-version "5.6.10")
(define-public linux-libre-5.6-pristine-source
(let ((version linux-libre-5.6-version)
(hash (base32 "1pw2q9509jzp84b6qasaais2ws25v2wrjh072q0x3j520zzl5q8r")))
(hash (base32 "1f81b0icn0r9gww95rckyxs5d4g8bwf4mmqkrmwxxf4xga19dp3v")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-5.6)))
(define-public linux-libre-5.4-version "5.4.36")
(define-public linux-libre-5.4-version "5.4.38")
(define-public linux-libre-5.4-pristine-source
(let ((version linux-libre-5.4-version)
(hash (base32 "13avfvimjyg4lhj9micgib9bb5qpx11cja5liypid0rf2acfmymr")))
(hash (base32 "03pks3jx5kk0wnhjkm92wxdbgw8qbdg93sfwchnx88m2wfj9yaz7")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-5.4)))
(define-public linux-libre-4.19-version "4.19.119")
(define-public linux-libre-4.19-version "4.19.120")
(define-public linux-libre-4.19-pristine-source
(let ((version linux-libre-4.19-version)
(hash (base32 "1klvdzz8sndg2zsr1anfy9p5fc1aapjqvc249myrbndyf55bk91b")))
(hash (base32 "03mjng5ws9y56id99619ysarz73qqyylgc3mlknga1yphbhh16qb")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-4.19)))
(define-public linux-libre-4.14-version "4.14.177")
(define-public linux-libre-4.14-version "4.14.178")
(define-public linux-libre-4.14-pristine-source
(let ((version linux-libre-4.14-version)
(hash (base32 "04hq0i06mg2yc09jj2xk0vhf5q9yigzjzm55a5bvfy2a6j43r9rk")))
(hash (base32 "1pcqxmq9ir4f963aiw5bab9w2mp4vfiwaq2bk7nksbl2bs3k6b7x")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-4.14)))
(define-public linux-libre-4.9-version "4.9.220")
(define-public linux-libre-4.9-version "4.9.221")
(define-public linux-libre-4.9-pristine-source
(let ((version linux-libre-4.9-version)
(hash (base32 "0bhbkybzbdsbmrjmb5m7hxxl8b3v6n79zhh86cbr95kzg1hcgnfs")))
(hash (base32 "1gh1x73xblxkb927igc3shrqnn49lcscwrq2fixmk9n7jb7q2hp6")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-4.9)))
(define-public linux-libre-4.4-version "4.4.220")
(define-public linux-libre-4.4-version "4.4.221")
(define-public linux-libre-4.4-pristine-source
(let ((version linux-libre-4.4-version)
(hash (base32 "1knj3qsl7x3fysdz1h0s980ddbafs3658z2y67w6sn79wp7d8blg")))
(hash (base32 "06rpjnvrdp71flz948mfmx7jv8x2vmdg54zz1xpkb2458mwh5hbq")))
(make-linux-libre-source version
(%upstream-linux-source version hash)
deblob-scripts-4.4)))
@ -4707,11 +4707,50 @@ disks and SD cards. This package provides the userland utilities.")
(append-to-file "mkfs/Makefile.am" "\nmkfs_f2fs_LDFLAGS = -all-static\n")
(append-to-file "fsck/Makefile.am" "\nfsck_f2fs_LDFLAGS = -all-static\n")
(append-to-file "tools/Makefile.am" "\nf2fscrypt_LDFLAGS = -all-static -luuid\n")
#t)))))
#t))
(add-after 'install 'remove-store-references
(lambda* (#:key outputs #:allow-other-keys)
;; Work around bug in our util-linux.
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=41019>.
(remove-store-references (string-append (assoc-ref outputs "out")
"/sbin/mkfs.f2fs"))
#t)))))
(inputs
`(("libuuid:static" ,util-linux "static")
("libuuid" ,util-linux "lib")))))) ; for include files
(define-public f2fs-fsck/static
(package
(name "f2fs-fsck-static")
(version (package-version f2fs-tools/static))
(source #f)
(build-system trivial-build-system)
(arguments
`(#:modules ((guix build utils))
#:builder
(begin
(use-modules (guix build utils)
(ice-9 ftw)
(srfi srfi-26))
(let* ((f2fs-tools (assoc-ref %build-inputs "f2fs-tools-static"))
(fsck "fsck.f2fs")
(out (assoc-ref %outputs "out"))
(sbin (string-append out "/sbin")))
(mkdir-p sbin)
(with-directory-excursion sbin
(install-file (string-append f2fs-tools "/sbin/" fsck)
".")
(remove-store-references fsck)
(chmod fsck #o555))
#t))))
(inputs
`(("f2fs-tools-static" ,f2fs-tools/static)))
(home-page (package-home-page f2fs-tools/static))
(synopsis "Statically-linked fsck.f2fs command from f2fs-tools")
(description "This package provides statically-linked fsck.f2fs command taken
from the f2fs-tools package. It is meant to be used in initrds.")
(license (package-license f2fs-tools/static))))
(define-public freefall
(package
(name "freefall")

6
gnu/packages/lisp-xyz.scm
View File

@ -3143,10 +3143,10 @@ is a library for creating graphical user interfaces.")
(sbcl-package->cl-source-package sbcl-cl-cffi-gtk))
(define-public sbcl-cl-webkit
(let ((commit "d97115ca601838dfa60ea7afbb88641d7a526dba"))
(let ((commit "f93cb9697e8813068795fe4dc39ac950d814102d"))
(package
(name "sbcl-cl-webkit")
(version (git-version "2.4" "2" commit))
(version (git-version "2.4" "3" commit))
(source
(origin
(method git-fetch)
@ -3156,7 +3156,7 @@ is a library for creating graphical user interfaces.")
(file-name (git-file-name "cl-webkit" version))
(sha256
(base32
"0sdb2l2h5xv5c1m2mfq31i9yl6zjf512fvwwzlvk9nvisyhc4xi3"))))
"1sjcw08kjpd5h83sms7zcq2nymddjygk9hm2rpgzrl524an9ziwc"))))
(build-system asdf-build-system/sbcl)
(inputs
`(("cffi" ,sbcl-cffi)

49
gnu/packages/messaging.scm
View File

@ -266,6 +266,51 @@ access to servers running the Discord protocol.")
(home-page "https://github.com/sm00th/bitlbee-discord/")
(license license:gpl2+)))
(define-public purple-mattermost
(package
(name "purple-mattermost")
(version "1.2")
(home-page "https://github.com/EionRobb/purple-mattermost")
(source (origin
(method git-fetch)
(uri (git-reference (url home-page)
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"0fm49iv58l09qpy8vkca3am642fxiwcrrh6ykimyc2mas210b5g2"))))
(build-system gnu-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
;; Adjust the makefile to install files in the right
;; place.
(let ((out (assoc-ref outputs "out")))
(substitute* "Makefile"
(("MATTERMOST_DEST = .*")
(string-append "MATTERMOST_DEST = " out
"/lib/purple-2\n")) ;XXX: hardcoded
(("MATTERMOST_ICONS_DEST = .*")
(string-append "MATTERMOST_ICONS_DEST = "
out
"/share/pixmaps/pidgin/protocols\n")))
#t))))
#:make-flags (list "CC=gcc"
,(string-append "PLUGIN_VERSION=" version))
#:tests? #f))
(inputs `(("glib" ,glib)
("json-glib" ,json-glib)
("discount" ,discount)
("pidgin" ,pidgin)))
(native-inputs `(("pkg-config" ,pkg-config)))
(synopsis "Purple plug-in to access Mattermost instant messaging")
(description
"Purple-Mattermost is a plug-in for Purple, the instant messaging library
used by Pidgin and Bitlbee, among others, to access
@uref{https://mattermost.com/, Mattermost} servers.")
(license license:gpl3+)))
(define-public hexchat
(package
(name "hexchat")
@ -505,14 +550,14 @@ compromised.")
(define-public znc
(package
(name "znc")
(version "1.7.5")
(version "1.8.0")
(source (origin
(method url-fetch)
(uri (string-append "http://znc.in/releases/archive/znc-"
version ".tar.gz"))
(sha256
(base32
"08a7yb2xs85hyyz8dpzfbsfjwj2r6kcii022lj3l4rf8hl9ix558"))))
"0m5xf60r40pgbg9lyk56dafxj2hj149pn2wf8vzsp8xgq4kv5zcl"))))
(build-system cmake-build-system)
(arguments
`(#:configure-flags

51
gnu/packages/monitoring.scm
View File

@ -6,6 +6,7 @@
;;; Copyright © 2018 Gábor Boskovits <boskovits@gmail.com>
;;; Copyright © 2018, 2019 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Alex ter Weele <alex.ter.weele@gmail.com>
;;; Copyright © 2020 Lars-Dominik Braun <ldb@leibniz-psychology.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -32,6 +33,7 @@
#:use-module (guix build-system gnu)
#:use-module (guix build-system go)
#:use-module (guix utils)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages autotools)
#:use-module (gnu packages base)
@ -48,11 +50,14 @@
#:use-module (gnu packages libevent)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz)
#:use-module (gnu packages rrdtool)
#:use-module (gnu packages time)
#:use-module (gnu packages tls))
#:use-module (gnu packages tls)
#:use-module (gnu packages web))
(define-public nagios
(package
@ -445,3 +450,47 @@ written in Go with pluggable metric collectors.")
(description "This package provides a file system monitor.")
(home-page "https://github.com/emcrisostomo/fswatch")
(license license:gpl3+)))
(define-public collectd
(package
(name "collectd")
(version "5.11.0")
(source (origin
(method url-fetch)
(uri (string-append
"https://storage.googleapis.com/collectd-tarballs/collectd-"
version
".tar.bz2"))
(sha256
(base32
"1cjxksxdqcqdccz1nbnc2fp6yy84qq361ynaq5q8bailds00mc9p"))
(patches (search-patches "collectd-5.11.0-noinstallvar.patch"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags (list "--localstatedir=/var" "--sysconfdir=/etc")
#:phases (modify-phases %standard-phases
(add-before 'configure 'autoreconf
(lambda _
;; Required because of patched sources.
(invoke "autoreconf" "-vfi"))))))
(inputs
`(("rrdtool" ,rrdtool)
("curl" ,curl)
("libyajl" ,libyajl)))
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
("libtool" ,libtool)
("pkg-config" ,pkg-config)))
(home-page "https://collectd.org/")
(synopsis "Collect system and application performance metrics periodically")
(description
"collectd gathers metrics from various sources such as the operating system,
applications, log files and external devices, and stores this information or
makes it available over the network. Those statistics can be used to monitor
systems, find performance bottlenecks (i.e., performance analysis) and predict
future system load (i.e., capacity planning).")
;; license:expat for the daemon in src/daemon/ and some plugins,
;; license:gpl2 for other plugins
(license (list license:expat license:gpl2))))

22
gnu/packages/music.scm
View File

@ -1162,6 +1162,28 @@ complete studio.")
with a selectable pattern matrix size.")
(license license:gpl3+)))
(define-public bchoppr
(package
(inherit bsequencer)
(name "bchoppr")
(version "1.4.2")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/sjaehn/BChoppr.git")
(commit version)))
(file-name (git-file-name name version))
(sha256
(base32
"1ympx0kyn3mkb23xgd44rlrf4qnngnlkmikz9syhayklgax7ijgm"))))
(synopsis "Audio stream-chopping LV2 plugin")
(description "B.Choppr cuts the audio input stream into a repeated
sequence of up to 16 chops. Each chop can be leveled up or down (gating).
B.Choppr is the successor of B.Slizr.")
(home-page "https://github.com/sjaehn/BChoppr")
(license license:gpl3+)))
(define-public solfege
(package
(name "solfege")

21
gnu/packages/patches/collectd-5.11.0-noinstallvar.patch 100644
View File

@ -0,0 +1,21 @@
Disable creation of /var and /etc
--- a/Makefile.am 2020-03-08 16:57:09.511535600 +0100
+++ b/Makefile.am 2020-04-21 11:36:49.827182272 +0200
@@ -2376,16 +2376,6 @@
endif
install-exec-hook:
- $(mkinstalldirs) $(DESTDIR)$(localstatedir)/run
- $(mkinstalldirs) $(DESTDIR)$(localstatedir)/lib/$(PACKAGE_NAME)
- $(mkinstalldirs) $(DESTDIR)$(localstatedir)/log
- $(mkinstalldirs) $(DESTDIR)$(sysconfdir)
- if test -e $(DESTDIR)$(sysconfdir)/collectd.conf; \
- then \
- $(INSTALL) -m 0640 $(builddir)/src/collectd.conf $(DESTDIR)$(sysconfdir)/collectd.conf.pkg-orig; \
- else \
- $(INSTALL) -m 0640 $(builddir)/src/collectd.conf $(DESTDIR)$(sysconfdir)/collectd.conf; \
- fi; \
$(mkinstalldirs) $(DESTDIR)$(cpkgdatadir)
$(INSTALL) -m 0644 $(srcdir)/src/types.db $(DESTDIR)$(cpkgdatadir)/types.db;
$(INSTALL) -m 0644 $(srcdir)/src/postgresql_default.conf \

69
gnu/packages/patches/grocsvs-dont-use-admiral.patch 100644
View File

@ -0,0 +1,69 @@
python-admiral doesn't have a license
https://github.com/nspies/admiral/issues/3
diff --git a/setup.py b/setup.py
index 692b6a0..568f381 100755
--- a/setup.py
+++ b/setup.py
@@ -20,7 +20,7 @@ setup(
'console_scripts' : ["grocsvs = grocsvs.main:main"]
},
- install_requires = ["admiral", "h5py", "networkx>=2.0", "pandas", "pybedtools",
+ install_requires = ["h5py", "networkx>=2.0", "pandas", "pybedtools",
"pyfaidx", "pysam>=0.10.0", "scipy", "ipython-cluster-helper",
"pygraphviz", "psutil"],
diff --git a/src/grocsvs/jobmanagers.py b/src/grocsvs/jobmanagers.py
index 6da0b58..112d7ff 100755
--- a/src/grocsvs/jobmanagers.py
+++ b/src/grocsvs/jobmanagers.py
@@ -41,34 +41,3 @@ class MultiprocessingCluster(Cluster):
pool = multiprocessing.Pool(processes=self.processes)
return pool.map_async(fn, args).get(999999)
-
-class AdmiralCluster(Cluster):
- def map(self, fn, args):
- from admiral import jobmanagers, remote
-
- cluster_options = self.cluster_settings.cluster_options.copy()
-
- scheduler = cluster_options.pop("scheduler")
-
- jobmanager_class = jobmanagers.get_jobmanager(scheduler)
- jobmanager = jobmanager_class(
- batch_dir=self.batch_dir, log_dir=self.batch_dir)
-
-
- if not "mem" in cluster_options:
- cluster_options["mem"] = "16g"
- if not "time" in cluster_options:
- cluster_options["time"] = "12h"
-
- jobs = []
- #for i, arg in enumerate(args):
-
- job_name = args[0].__class__.__name__
- args = [[arg] for arg in args]
- job = remote.run_remote(fn, jobmanager, job_name, args=args,
- array=True, overwrite=True, **cluster_options)
-
- result = jobmanagers.wait_for_jobs([job], wait=5, progress=True)
-
- if not result:
- raise Exception("Some chunks failed to complete")
diff --git a/src/grocsvs/pipeline.py b/src/grocsvs/pipeline.py
index ab1bb2d..350976f 100755
--- a/src/grocsvs/pipeline.py
+++ b/src/grocsvs/pipeline.py
@@ -8,8 +8,7 @@ from grocsvs import utilities
def make_jobmanager(jobmanager_settings, processes, batch_dir):
jobmanager_classes = {"IPCluster":jobmanagers.IPCluster,
"local": jobmanagers.LocalCluster,
- "multiprocessing": jobmanagers.MultiprocessingCluster,
- "admiral": jobmanagers.AdmiralCluster}
+ "multiprocessing": jobmanagers.MultiprocessingCluster}
cls = jobmanager_classes[jobmanager_settings.cluster_type]
return cls(processes, jobmanager_settings, batch_dir)

67
gnu/packages/patches/gromacs-tinyxml2.patch 100644
View File

@ -0,0 +1,67 @@
Unbundling tinyxml2 from gromacs and using our own, which is newer, broke gromacs
build.
This patch fixes three issues:
- cmake now errors out if using multiple target_link_libraries with mixed styles
of signatures.
- Error handling API changed, fix the testutils/refdata_xml.cpp code by using the
new API: document.ErrorStr() & tinyxml2::XML_SUCCESS.
Those fixes will be submitted for inclusion to upstream, but may not be suitable
there as long as they still keep the old version bundled.
First hunk has already been requested for merging. Third is in discussion. Second
will only be sent if third is OK'ed.
diff -ruN gromacs-2020.2/src/testutils/CMakeLists.txt gromacs-2020.2-fixed/src/testutils/CMakeLists.txt
--- gromacs-2020.2/src/testutils/CMakeLists.txt 2020-04-30 18:33:44.000000000 +0200
+++ gromacs-2020.2-fixed/src/testutils/CMakeLists.txt 2020-05-01 22:52:16.356000000 +0200
@@ -73,7 +73,7 @@
if(HAVE_TINYXML2)
include_directories(SYSTEM ${TinyXML2_INCLUDE_DIR})
- target_link_libraries(testutils ${TinyXML2_LIBRARIES})
+ target_link_libraries(testutils PRIVATE ${TinyXML2_LIBRARIES})
else()
include_directories(BEFORE SYSTEM "../external/tinyxml2")
endif()
diff -ruN gromacs-2020.2/src/testutils/refdata_xml.cpp gromacs-2020.2-fixed/src/testutils/refdata_xml.cpp
--- gromacs-2020.2/src/testutils/refdata_xml.cpp 2020-04-30 18:33:44.000000000 +0200
+++ gromacs-2020.2-fixed/src/testutils/refdata_xml.cpp 2020-05-01 23:17:09.556000000 +0200
@@ -206,21 +206,12 @@
document.LoadFile(path.c_str());
if (document.Error())
{
- const char* errorStr1 = document.GetErrorStr1();
- const char* errorStr2 = document.GetErrorStr2();
+ const char* errorStr = document.ErrorStr();
std::string errorString("Error was ");
- if (errorStr1)
- {
- errorString += errorStr1;
- }
- if (errorStr2)
- {
- errorString += errorStr2;
- }
- if (!errorStr1 && !errorStr2)
- {
+ if (errorStr)
+ errorString += errorStr;
+ else
errorString += "not specified.";
- }
GMX_THROW(TestException("Reference data not parsed successfully: " + path + "\n."
+ errorString + "\n"));
}
@@ -371,7 +362,7 @@
XMLElementPtr rootElement = createRootElement(&document);
createChildElements(rootElement, rootEntry);
- if (document.SaveFile(path.c_str()) != tinyxml2::XML_NO_ERROR)
+ if (document.SaveFile(path.c_str()) != tinyxml2::XML_SUCCESS)
{
GMX_THROW(TestException("Reference data saving failed in " + path));
}

20
gnu/packages/patches/musl-cross-locale.patch 100644
View File

@ -0,0 +1,20 @@
Disable locales other than C and POSIX because of a compilation error.
By Danny Milosavljevic <dannym@scratchpost.org>
This patch is distributed under BSD-3 license.
See https://github.com/osresearch/heads/pull/610
diff -ruN b/source/patches/gcc-5.3.0-locale.diff guix-build-musl-cross-0.1-3.a8a6649.drv-12/source/patches/gcc-5.3.0-locale.diff
--- a/patches/gcc-5.3.0-locale.diff 1970-01-01 01:00:00.000000000 +0100
+++ b/patches/gcc-5.3.0-locale.diff 2020-05-02 14:20:47.213564509 +0200
@@ -0,0 +1,12 @@
+--- gcc-5.3.0/libstdc++-v3/config/locale/gnu/ctype_members.cc.orig 2020-05-02 14:16:31.376147000 +0200
++++ gcc-5.3.0/libstdc++-v3/config/locale/gnu/ctype_members.cc 2020-05-02 14:16:56.716279576 +0200
+@@ -47,7 +47,8 @@
+ this->_S_create_c_locale(this->_M_c_locale_ctype, __s);
+ this->_M_toupper = this->_M_c_locale_ctype->__ctype_toupper;
+ this->_M_tolower = this->_M_c_locale_ctype->__ctype_tolower;
+- this->_M_table = this->_M_c_locale_ctype->__ctype_b;
++ //this->_M_table = this->_M_c_locale_ctype->__ctype_b;
++ throw 3;
+ }
+ }
+

13
gnu/packages/patches/rust-nettle-disable-vendor.patch 100644
View File

@ -0,0 +1,13 @@
Subject: nettle: clear out "vendored" feature cruft from build.rs
From: Daniel Kahn Gillmor's avatarDaniel Kahn Gillmor <dkg@fifthhorseman.net>
https://salsa.debian.org/rust-team/debcargo-conf/-/commit/b608e6beaa1d38c14fc16ad53780d94954a91900
https://sources.debian.org/src/rust-nettle/7.0.0-1/debian/patches/disable-vendor.diff/
--- a/Cargo.toml 1969-12-31 19:00:00.000000000 -0500
+++ b/Cargo.toml 2019-10-23 19:12:01.076181971 -0400
@@ -35,4 +35,4 @@
version = "1"
[features]
-vendored = ["nettle-sys/vendored"]
+vendored = []

48
gnu/packages/patches/rust-nettle-sys-disable-vendor.patch 100644
View File

@ -0,0 +1,48 @@
Subject: nettle-sys: clear out "vendored" feature cruft from build.rs
From: Daniel Kahn Gillmor's avatarDaniel Kahn Gillmor <dkg@fifthhorseman.net>
https://salsa.debian.org/rust-team/debcargo-conf/-/commit/0c71150ad26bb66a8396dcdab055181af232ddc5
https://sources.debian.org/src/rust-nettle-sys/2.0.4-3/debian/patches/disable-vendor.diff/
--- a/Cargo.toml 2019-10-23 13:08:07.000000000 -0400
+++ b/Cargo.toml 2019-10-23 14:08:46.644064014 -0400
@@ -29,12 +29,9 @@
version = "0.51.1"
default-features = false
-[build-dependencies.nettle-src]
-version = "3.5.1-0"
-optional = true
-
[build-dependencies.pkg-config]
version = "0.3"
[features]
vendored = ["nettle-src"]
+nettle-src = []
diff --git a/build.rs b/build.rs
index 44f7af3..ede4b2f 100644
--- a/build.rs
+++ b/build.rs
@@ -1,7 +1,5 @@
extern crate bindgen;
extern crate pkg_config;
-#[cfg(feature = "vendored")]
-extern crate nettle_src;
use std::env;
use std::fs;
@@ -36,14 +34,6 @@ fn main() {
println!("cargo:rerun-if-env-changed=NETTLE_STATIC");
println!("cargo:rerun-if-env-changed={}", NETTLE_PREGENERATED_BINDINGS);
- #[cfg(feature = "vendored")]
- {
- let artifacts = nettle_src::Build::new().build();
- println!("cargo:vendored=1");
- env::set_var("PKG_CONFIG_PATH",
- artifacts.lib_dir().join("pkgconfig"));
- }
-
let nettle = pkg_config::probe_library("nettle hogweed").unwrap();
let mode = match env::var_os("NETTLE_STATIC") {

7
gnu/packages/python-xyz.scm
View File

@ -13186,7 +13186,7 @@ Features:
(define-public python-dulwich
(package
(name "python-dulwich")
(version "0.18.6")
(version "0.19.16")
(source
(origin
(method url-fetch)
@ -13195,7 +13195,7 @@ Features:
(pypi-uri "dulwich" version)))
(sha256
(base32
"1aa1xfrxkc3j9s4xi0llhf5gndyi9ryprcxsqfa5fcb8ph34981q"))))
"0l589jl0lxx59yq0p6vmgw0q0hmfh48iqwyy0x6g1dmz93262igp"))))
(build-system python-build-system)
(arguments
`(#:phases
@ -13215,7 +13215,8 @@ Features:
(setenv "PYTHONHASHSEED" "random")
#t)))))
(propagated-inputs
`(("python-fastimport" ,python-fastimport)))
`(("python-fastimport" ,python-fastimport)
("python-urllib3" ,python-urllib3)))
(native-inputs
`(("python-mock" ,python-mock)
("python-geventhttpclient" ,python-geventhttpclient)

28
gnu/packages/security-token.scm
View File

@ -167,6 +167,34 @@ the low-level development kit for the Yubico YubiKey authentication device.")
(home-page "https://developers.yubico.com/yubico-c/")
(license license:bsd-2)))
(define-public softhsm
(package
(name "softhsm")
(version "2.6.1")
(source (origin
(method url-fetch)
(uri (string-append
"https://dist.opendnssec.org/source/"
"softhsm-" version ".tar.gz"))
(sha256
(base32
"1wkmyi6n3z2pak1cj5yk6v6bv9w0m24skycya48iikab0mrr8931"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--disable-gost"))) ; TODO Missing the OpenSSL
; engine for GOST
(inputs
`(("openssl" ,openssl)))
(native-inputs
`(("pkg-config" ,pkg-config)
("cppunit" ,cppunit)))
(synopsis "Software implementation of a generic cryptographic device")
(description
"SoftHSM 2 is a software implementation of a generic cryptographic device
with a PKCS #11 Cryptographic Token Interface.")
(home-page "https://www.opendnssec.org/softhsm/")
(license license:bsd-2)))
(define-public pcsc-lite
(package
(name "pcsc-lite")

162
gnu/packages/sequoia.scm 100644
View File

@ -0,0 +1,162 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel@crazy-compilers.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 (gnu packages sequoia)
#:use-module (guix build-system cargo)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (gnu packages check) ;; python-pytest
#:use-module (gnu packages crates-io)
#:use-module (gnu packages libffi) ;; python-cffi
#:use-module (gnu packages llvm)
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages nettle)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages python-xyz) ;; python-setuptools
#:use-module (gnu packages serialization)
#:use-module (gnu packages sqlite)
#:use-module (gnu packages tls))
(define-public sequoia
(package
(name "sequoia")
(version "0.16.0")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://gitlab.com/sequoia-pgp/sequoia.git")
(commit (string-append "v" version))))
(sha256
(base32 "0iwzi2ylrwz56s77cd4vcf89ig6ipy4w6kp2pfwqvd2d00x54dhk"))
(file-name (git-file-name name version))))
(build-system cargo-build-system)
(outputs '("out" "python"))
(native-inputs
`(("clang" ,clang)
("pkg-config" ,pkg-config)
("python-pytest" ,python-pytest)
("python-pytest-runner" ,python-pytest-runner)))
(inputs
`(("capnproto" ,capnproto)
("gmp" ,gmp)
("nettle" ,nettle)
("openssl" ,openssl)
("python" ,python)
("python-cffi" ,python-cffi)
("sqlite" ,sqlite)))
(arguments
`(#:tests? #f ;; building the tests requires 9.7GB total
#:cargo-inputs
(("rust-assert-cli" ,rust-assert-cli-0.6)
("rust-anyhow" ,rust-anyhow-1.0)
("rust-base64", rust-base64-0.11)
;;("rust-buffered-reader" included
("rust-bzip2", rust-bzip2-0.3)
("rust-capnp" ,rust-capnp-0.10)
("rust-capnp-rpc" ,rust-capnp-rpc-0.10)
("rust-capnpc" ,rust-capnpc-0.10)
("rust-chrono" ,rust-chrono-0.4)
("rust-clap" ,rust-clap-2)
("rust-clap" ,rust-clap-2)
("rust-colored" ,rust-colored-1.9.1)
("rust-crossterm" ,rust-crossterm-0.13)
("rust-ctor", rust-ctor-0.1)
("rust-dirs" ,rust-dirs-2.0)
;;("rust-failure" included
("rust-filetime" ,rust-filetime-0.2)
("rust-flate2", rust-flate2-1.0)
("rust-fs2" ,rust-fs2-0.4)
("rust-futures" ,rust-futures-0.1)
("rust-http" ,rust-http-0.1)
("rust-hyper" ,rust-hyper-0.12)
("rust-hyper-tls" ,rust-hyper-tls-0.3)
("rust-idna", rust-idna-0.2)
("rust-itertools" ,rust-itertools-0.8)
("rust-lalrpop-util", rust-lalrpop-util-0.17)
("rust-lazy-static", rust-lazy-static-1.3)
("rust-libc" ,rust-libc-0.2)
("rust-memsec", rust-memsec-0.5)
("rust-native-tls" ,rust-native-tls-0.2)
("rust-nettle", rust-nettle-7)
("rust-parity-tokio-ipc" ,rust-parity-tokio-ipc-0.4)
("rust-percent-encoding" ,rust-percent-encoding-2.1)
("rust-prettytable-rs" ,rust-prettytable-rs-0.8)
("rust-proc-macro2" ,rust-proc-macro2-1.0)
("rust-quickcheck", rust-quickcheck-0.9)
("rust-rand", rust-rand-0.7)
("rust-regex", rust-regex-1.3)
("rust-rusqlite" ,rust-rusqlite-0.19)
("rust-tempfile" ,rust-tempfile-3.1)
("rust-thiserror" ,rust-thiserror-1.0)
("rust-tokio" ,rust-tokio-0.1)
("rust-tokio-core" ,rust-tokio-core-0.1)
("rust-unicode-normalization", rust-unicode-normalization-0.1)
("rust-url" ,rust-url-2.1)
("rust-zbase32" ,rust-zbase32-0.1))
#:cargo-development-inputs
(("rust-bindgen" ,rust-bindgen-0.51) ;; FIXME for nettle-sys and rusqlite
("rust-lalrpop" ,rust-lalrpop-0.17)
("rust-rpassword" ,rust-rpassword-4))
#:phases
(modify-phases %standard-phases
;; Run make instead of using the rust build system, as
;; suggested by the installation instructions
(replace 'build (lambda _ (invoke "make" "build-release") #t))
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(if tests?
(invoke "make" "check")
#t)))
(replace 'install (lambda _ (invoke "make" "install") #t))
(add-after 'unpack 'adjust-prefix
(lambda* (#:key outputs #:allow-other-keys)
(setenv "PREFIX" (assoc-ref outputs "out"))
#t))
(add-after 'unpack 'fix-fo-python-output
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(pyout (assoc-ref outputs "python")))
(substitute* "ffi/lang/python/Makefile"
;; adjust prefix for python package
(("PREFIX\\s*\\??=.*")
(string-append "PREFIX = " pyout "\n"))
;; fix rpath to include the main package
(("\\WLDFLAGS=" text)
(string-append text "'-Wl,-rpath=" out "/lib '"))
;; make setuptools install into the prefix, see
;; guix/build/python-build-system.scm for explanation
(("\\ssetup.py\\s+install\\s")
" setup.py install --root=/ --single-version-externally-managed "))
#t)))
(add-after 'unpack 'set-missing-env-vars
(lambda* (#:key inputs #:allow-other-keys)
;; FIXME: why do we need to set this here?
(setenv "LIBCLANG_PATH"
(string-append (assoc-ref inputs "clang") "/lib"))
#t)))))
(home-page "https://sequoia-pgp.org")
(synopsis "New OpenPGP implementation")
(description "Sequoia is a new OpenPGP implementation. It consists of
several crates, providing both a low-level and a high-level API for dealing
with OpenPGP data.")
(license license:gpl2+)))

49
gnu/packages/spice.scm
View File

@ -21,6 +21,7 @@
(define-module (gnu packages spice)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (gnu packages cyrus-sasl)
#:use-module (gnu packages gl)
@ -31,9 +32,11 @@
#:use-module (gnu packages image)
#:use-module (gnu packages libusb)
#:use-module (gnu packages linux)
#:use-module (gnu packages nss)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages python)
#:use-module (gnu packages security-token)
#:use-module (gnu packages tls)
#:use-module (gnu packages xorg)
#:use-module (gnu packages xdisorg)
@ -219,6 +222,7 @@ which allows users to view a desktop computing environment.")
`(("cyrus-sasl" ,cyrus-sasl)
("glib" ,glib)
("libjpeg-turbo" ,libjpeg-turbo)
("libcacard" ,libcacard) ; smartcard support
("lz4" ,lz4)
("opus" ,opus)
("orc" ,orc)
@ -297,6 +301,51 @@ resolution scaling on graphical console window resize.")
(home-page "https://www.spice-space.org")
(license license:gpl3+)))
(define-public libcacard
(package
(name "libcacard")
(version "2.7.0")
(source (origin
(method url-fetch)
(uri (string-append
"https://gitlab.freedesktop.org/spice/libcacard/uploads/"
"56cb2499198e78e560a1d4c716cd8ab1"
"/libcacard-" version ".tar.xz"))
(sha256
(base32
"0vyvkk4b6xjwq1ccggql13c1x7g4y90clpkqw28257azgn2a1c8n"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ; TODO Tests require gnutls built with
; p11-kit
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'patch-tests
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "tests/setup-softhsm2.sh"
(("\\/usr\\/lib64\\/pkcs11\\/libsofthsm2\\.so")
(string-append (assoc-ref inputs "softhsm")
"/lib/softhsm/libsofthsm2.so")))
#t)))))
(propagated-inputs
`(("glib" ,glib) ; Requires: in the pkg-config file
("nss" ,nss))) ; Requires.private: in the pkg-config
; file
(native-inputs
`(("openssl" ,openssl)
("nss" ,nss "bin")
("opensc" ,opensc)
("softhsm" ,softhsm)
("gnutls" ,gnutls)
("pkg-config" ,pkg-config)
("which" ,which)))
(synopsis "Emulate and share smart cards with virtual machines")
(description
"The @acronym{CAC,Common Access Card} library can be used to emulate and
share smart cards from client system to local or remote virtual machines.")
(home-page "https://gitlab.freedesktop.org/spice/libcacard")
(license license:lgpl2.1+)))
(define-public virt-viewer
(package
(name "virt-viewer")

45
gnu/packages/statistics.scm
View File

@ -11,6 +11,7 @@
;;; Copyright © 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2018 Alex Branham <alex.branham@gmail.com>
;;; Copyright © 2020 Tim Howes <timhowes@lavabit.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -5786,42 +5787,51 @@ Java package that provides routines for various statistical distributions.")
(define-public emacs-ess
(package
(name "emacs-ess")
(version "17.11")
(version "18.10.2")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/emacs-ess/ESS/archive/v"
version ".tar.gz"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/emacs-ess/ESS")
(commit (string-append "v" version))))
(sha256
(base32
"0cbilbsiwvcyf6d5y24mymp57m3ana5dkzab3knfs83w4a3a4c5c"))
(file-name (string-append name "-" version ".tar.gz"))
"1yq41l2bicwjrc0b731iic20cpcnz6ppigri1jn621qv2qv22vy3"))
(file-name (git-file-name name version))
(modules '((guix build utils)))
(snippet
'(begin
;; Stop ESS from trying to bundle an external julia-mode.el.
(substitute* "lisp/Makefile"
(("^\tjulia-mode.elc\\\\\n") "")
(("^dist: all julia-mode.el")
"dist: all"))
;; No need to build docs in so many formats. Also, skipping
;; pdf lets us not pull in texlive.
(("^ess-julia.elc: julia-mode.elc") "")
(("^all: julia-mode.el")
"all:"))
;; Include *.el files in install target.
(substitute* "lisp/Makefile"
(("\t\\$\\(INSTALL) \\$\\(ELC\\) \\$\\(LISPDIR\\)" elc)
(string-append "\t$(INSTALL) $(ELS) ess-autoloads.el "
"$(LISPDIR)\n" elc)))
;; Only build docs in info format.
(substitute* "doc/Makefile"
(("all : info text html pdf")
(("all : info text")
"all : info")
(("install: install-info install-other-docs")
"install: install-info"))
;; Test fails upstream
;; Stop install-info from trying to update the info directory.
(substitute* "doc/Makefile"
((".*\\$\\(INFODIR\\)/dir.*") ""))
;; Fix roxygen preview test.
(substitute* "test/ess-r-tests.el"
(("ert-deftest ess-r-namespaced-eval-no-srcref-in-errors ()")
"ert-deftest ess-r-namespaced-eval-no-srcref-in-errors () :expected-result :failed"))
(("Add together two numbers.\n")
"Add together two numbers. ")
(("##' add\\(10, 1\\)") "add(10, 1)"))
#t))))
(build-system gnu-build-system)
(arguments
(let ((base-directory "/share/emacs/site-lisp"))
`(#:make-flags (list (string-append "PREFIX=" %output)
(string-append "ETCDIR=" %output "/"
(string-append "ETCDIR=" %output
,base-directory "/etc")
(string-append "LISPDIR=" %output "/"
(string-append "LISPDIR=" %output
,base-directory))
#:phases
(modify-phases %standard-phases
@ -5840,6 +5850,7 @@ Java package that provides routines for various statistical distributions.")
("r-minimal" ,r-minimal)))
(native-inputs
`(("perl" ,perl)
("r-roxygen2" ,r-roxygen2)
("texinfo" ,texinfo)))
(propagated-inputs
`(("emacs-julia-mode" ,emacs-julia-mode)))

4
gnu/packages/video.scm
View File

@ -1610,7 +1610,7 @@ To load this plugin, specify the following option when starting mpv:
(define-public youtube-dl
(package
(name "youtube-dl")
(version "2020.03.24")
(version "2020.05.03")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/ytdl-org/youtube-dl/"
@ -1618,7 +1618,7 @@ To load this plugin, specify the following option when starting mpv:
version ".tar.gz"))
(sha256
(base32
"05l4asakakxn53wrvxn6c03fd80zdizdbj6r2cj8c1ja3sj9i8s5"))))
"0qigk1bml6vkck4rs0wnmr46j5gkz04zn30jvnw1r4czjs7vnpal"))))
(build-system python-build-system)
(arguments
;; The problem here is that the directory for the man page and completion

4
gnu/packages/virtualization.scm
View File

@ -244,6 +244,7 @@ exec smbd $@")))
("gtk+" ,gtk+)
("libaio" ,libaio)
("libattr" ,attr)
("libcacard" ,libcacard) ; smartcard support
("libcap" ,libcap) ; virtfs support requires libcap & libattr
("libdrm" ,libdrm)
("libepoxy" ,libepoxy)
@ -310,7 +311,8 @@ server and embedded PowerPC, and S390 guests.")
'("gettext")))
(inputs (fold alist-delete (package-inputs qemu)
'("libusb" "mesa" "sdl2" "spice" "virglrenderer" "gtk+"
"usbredir" "libdrm" "libepoxy" "pulseaudio" "vde2")))))
"usbredir" "libdrm" "libepoxy" "pulseaudio" "vde2"
"libcacard")))))
(define-public libosinfo
(package

9
gnu/packages/vpn.scm
View File

@ -4,7 +4,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Jeff Mickey <j@codemac.net>
;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016, 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2018 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2018 Meiyo Peng <meiyo.peng@gmail.com>
@ -245,20 +245,21 @@ the user specifically asks to proxy, so the @dfn{VPN} interface no longer
(define-public openconnect
(package
(name "openconnect")
(version "8.08")
(version "8.09")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp.infradead.org/pub/openconnect/"
"openconnect-" version ".tar.gz"))
(sha256
(base32 "1s3rjdazx1n5izpcgz05p1sirm7kf4z3gh26dq2h2j5xmgmk0jxp"))))
(base32 "19p91hs6j348qp0v9c7abl3rb8d9ncc37k743qhrn29s9jz0567k"))))
(build-system gnu-build-system)
(propagated-inputs
`(("libxml2" ,libxml2)
("gnutls" ,gnutls-3.6.13)
("zlib" ,zlib)))
(inputs
`(("vpnc-scripts" ,vpnc-scripts)))
`(("lz4" ,lz4)
("vpnc-scripts" ,vpnc-scripts)))
(native-inputs
`(("gettext" ,gettext-minimal)
("pkg-config" ,pkg-config)))

32
gnu/packages/xdisorg.scm
View File

@ -36,6 +36,7 @@
;;; Copyright © 2020 Damien Cassou <damien@cassou.me>
;;; Copyright © 2020 John Soo <jsoo1@asu.edu>
;;; Copyright © 2020 Boris A. Dekshteyn <boris.dekshteyn@gmail.com>
;;; Copyright © 2020 Alex McGrath <amk@amk.ie>
;;;
;;; This file is part of GNU Guix.
;;;
@ -2326,3 +2327,34 @@ some kind of chat (in native language).
@command{kbdd} also supports D-Bus signals, which makes it possible to
create layout indicator widgets.")
(license license:bsd-2)))
(define-public j4-dmenu-desktop
(package
(name "j4-dmenu-desktop")
(version "2.17")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/enkore/j4-dmenu-desktop.git")
(commit (string-append "r" version))))
(file-name (git-file-name name version))
(sha256
(base32
"0v23fimkn83dcm5p53y2ymhklff3kwppxhf75sm8xmswrzkixpgc"))))
(build-system cmake-build-system)
(native-inputs
`(("catch2" ,catch-framework2)))
(arguments
`(#:configure-flags '("-DWITH_GIT_CATCH=off")
#:phases
(modify-phases %standard-phases
(replace 'check
(lambda _
(invoke "./j4-dmenu-tests" "exclude:SearchPath/XDG_DATA_HOME"))))))
(synopsis "Fast desktop menu")
(description
"j4-dmenu-desktop is a replacement for i3-dmenu-desktop. Its purpose
is to find @file{.desktop} files and offer you a menu to start an application
using @command{dmenu}.")
(home-page "https://github.com/enkore/j4-dmenu-desktop")
(license license:gpl3+)))

22
gnu/packages/xorg.scm
View File

@ -25,6 +25,7 @@
;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
;;; Copyright © 2020 Michael Rohleder <mike@rohleder.de>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Jean-Baptiste Note <jean-baptiste.note@m4x.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -6714,3 +6715,24 @@ Thai).")
a configuration file reusable by xcursorgen.")
(home-page "https://github.com/eworm-de/xcur2png")
(license license:gpl3+)))
(define-public gccmakedep
(package
(name "gccmakedep")
(version "1.0.3")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://xorg/individual/util/gccmakedep-"
version ".tar.bz2"))
(sha256
(base32 "1r1fpy5ni8chbgx7j5sz0008fpb6vbazpy1nifgdhgijyzqxqxdj"))))
(build-system gnu-build-system)
(synopsis "Create dependencies in makefiles using 'gcc -M'")
(description
"@command{gccmakedep} is a deprecated program which calls @code{gcc -M}
to output Makefile rules describing the dependencies of each source file, so
that Make knows which object files must be recompiled when a dependency has
changed.")
(home-page "https://gitlab.freedesktop.org/xorg/util/gccmakedep")
(license license:x11)))

2
gnu/services/base.scm
View File

@ -1379,7 +1379,7 @@ information on the configuration file syntax."
(module "pam_limits.so")
(arguments '("conf=/etc/security/limits.conf")))))
(if (member (pam-service-name pam)
'("login" "su" "slim" "gdm-password"))
'("login" "su" "slim" "gdm-password" "sddm"))
(pam-service
(inherit pam)
(session (cons pam-limits

106
gnu/services/ssh.scm
View File

@ -4,6 +4,7 @@
;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 pinoaffe <pinoaffe@airmail.cc>
;;;
;;; This file is part of GNU Guix.
;;;
@ -45,7 +46,11 @@
dropbear-configuration
dropbear-configuration?
dropbear-service-type
dropbear-service))
dropbear-service
autossh-configuration
autossh-configuration?
autossh-service-type))
;;; Commentary:
;;;
@ -628,4 +633,103 @@ daemon} with the given @var{config}, a @code{<dropbear-configuration>}
object."
(service dropbear-service-type config))
;;;
;;; AutoSSH.
;;;
(define-record-type* <autossh-configuration>
autossh-configuration make-autossh-configuration
autossh-configuration?
(user autossh-configuration-user
(default "autossh"))
(poll autossh-configuration-poll
(default 600))
(first-poll autossh-configuration-first-poll
(default #f))
(gate-time autossh-configuration-gate-time
(default 30))
(log-level autossh-configuration-log-level
(default 1))
(max-start autossh-configuration-max-start
(default #f))
(message autossh-configuration-message
(default ""))
(port autossh-configuration-port
(default "0"))
(ssh-options autossh-configuration-ssh-options
(default '())))
(define (autossh-file-name config file)
"Return a path in /var/run/autossh/ that is writable
by @code{user} from @code{config}."
(string-append "/var/run/autossh/"
(autossh-configuration-user config)
"/" file))
(define (autossh-shepherd-service config)
(shepherd-service
(documentation "Automatically set up ssh connections (and keep them alive).")
(provision '(autossh))
(start #~(make-forkexec-constructor
(list #$(file-append autossh "/bin/autossh")
#$@(autossh-configuration-ssh-options config))
#:user #$(autossh-configuration-user config)
#:group (passwd:gid (getpw #$(autossh-configuration-user config)))
#:pid-file #$(autossh-file-name config "pid")
#:log-file #$(autossh-file-name config "log")
#:environment-variables
'(#$(string-append "AUTOSSH_PIDFILE="
(autossh-file-name config "pid"))
#$(string-append "AUTOSSH_LOGFILE="
(autossh-file-name config "log"))
#$(string-append "AUTOSSH_POLL="
(number->string
(autossh-configuration-poll config)))
#$(string-append "AUTOSSH_FIRST_POLL="
(number->string
(or
(autossh-configuration-first-poll config)
(autossh-configuration-poll config))))
#$(string-append "AUTOSSH_GATETIME="
(number->string
(autossh-configuration-gate-time config)))
#$(string-append "AUTOSSH_LOGLEVEL="
(number->string
(autossh-configuration-log-level config)))
#$(string-append "AUTOSSH_MAXSTART="
(number->string
(or (autossh-configuration-max-start config)
-1)))
#$(string-append "AUTOSSH_MESSAGE="
(autossh-configuration-message config))
#$(string-append "AUTOSSH_PORT="
(autossh-configuration-port config)))))
(stop #~(make-kill-destructor))))
(define (autossh-service-activation config)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(define %user
(getpw #$(autossh-configuration-user config)))
(let* ((directory #$(autossh-file-name config ""))
(log (string-append directory "/log")))
(mkdir-p directory)
(chown directory (passwd:uid %user) (passwd:gid %user))
(call-with-output-file log (const #t))
(chown log (passwd:uid %user) (passwd:gid %user))))))
(define autossh-service-type
(service-type
(name 'autossh)
(description "Automatically set up ssh connections (and keep them alive).")
(extensions
(list (service-extension shepherd-root-service-type
(compose list autossh-shepherd-service))
(service-extension activation-service-type
autossh-service-activation)))
(default-value (autossh-configuration))))
;;; ssh.scm ends here

50
gnu/system.scm
View File

@ -120,6 +120,7 @@
operating-system-etc-directory
operating-system-locale-directory
operating-system-boot-script
operating-system-uuid
system-linux-image-file-name
operating-system-with-gc-roots
@ -984,6 +985,55 @@ we're running in the final root."
#:mapped-devices mapped-devices
#:keyboard-layout (operating-system-keyboard-layout os)))
(define* (operating-system-uuid os #:optional (type 'dce))
"Compute UUID object with a deterministic \"UUID\" for OS, of the given
TYPE (one of 'iso9660 or 'dce). Return a UUID object."
;; Note: For this to be deterministic, we must not hash things that contains
;; (directly or indirectly) procedures, for example. That rules out
;; anything that contains gexps, thunk or delayed record fields, etc.
(define service-name
(compose service-type-name service-kind))
(define (file-system-digest fs)
;; Return a hashable digest that does not contain 'dependencies' since
;; this field can contain procedures.
(let ((device (file-system-device fs)))
(list (file-system-mount-point fs)
(file-system-type fs)
(file-system-device->string device)
(file-system-options fs))))
(if (eq? type 'iso9660)
(let ((pad (compose (cut string-pad <> 2 #\0)
number->string))
(h (hash (map service-name (operating-system-services os))
3600)))
(bytevector->uuid
(string->iso9660-uuid
(string-append "1970-01-01-"
(pad (hash (operating-system-host-name os) 24)) "-"
(pad (quotient h 60)) "-"
(pad (modulo h 60)) "-"
(pad (hash (map file-system-digest
(operating-system-file-systems os))
100))))
'iso9660))
(bytevector->uuid
(uint-list->bytevector
(list (hash (map file-system-digest
(operating-system-file-systems os))
(- (expt 2 32) 1))
(hash (operating-system-host-name os)
(- (expt 2 32) 1))
(hash (map service-name (operating-system-services os))
(- (expt 2 32) 1))
(hash (map file-system-digest (operating-system-file-systems os))
(- (expt 2 32) 1)))
(endianness little)
4)
type)))
(define (locale-name->definition* name)
"Variant of 'locale-name->definition' that raises an error upon failure."
(match (locale-name->definition name)

532
gnu/system/image.scm 100644
View File

@ -0,0 +1,532 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@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 (gnu system image)
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix store)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module ((guix self) #:select (make-config.scm))
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu system)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module (gnu system vm)
#:use-module (guix packages)
#:use-module (gnu packages base)
#:use-module (gnu packages bootloaders)
#:use-module (gnu packages cdrom)
#:use-module (gnu packages disk)
#:use-module (gnu packages gawk)
#:use-module (gnu packages genimage)
#:use-module (gnu packages guile)
#:autoload (gnu packages gnupg) (guile-gcrypt)
#:use-module (gnu packages linux)
#:use-module (gnu packages mtools)
#:use-module ((srfi srfi-1) #:prefix srfi-1:)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:export (esp-partition
root-partition
efi-disk-image
iso9660-image
find-image
system-image))
;;;
;;; Images definitions.
;;;
(define esp-partition
(partition
(size (* 40 (expt 2 20)))
(label "GNU-ESP") ;cosmetic only
;; Use "vfat" here since this property is used when mounting. The actual
;; FAT-ness is based on file system size (16 in this case).
(file-system "vfat")
(flags '(esp))
(initializer (gexp initialize-efi-partition))))
(define root-partition
(partition
(size 'guess)
(label "Guix_image")
(file-system "ext4")
(flags '(boot))
(initializer (gexp initialize-root-partition))))
(define efi-disk-image
(image
(format 'disk-image)
(partitions (list esp-partition root-partition))))
(define iso9660-image
(image
(format 'iso9660)
(partitions
(list (partition
(size 'guess)
(label "GUIX_IMAGE")
(flags '(boot)))))
;; XXX: Temporarily disable compression to speed-up the tests.
(compression? #f)))
;;
;; Helpers.
;;
(define not-config?
;; Select (guix …) and (gnu …) modules, except (guix config).
(match-lambda
(('guix 'config) #f)
(('guix rest ...) #t)
(('gnu rest ...) #t)
(rest #f)))
(define (partition->gexp partition)
"Turn PARTITION, a <partition> object, into a list-valued gexp suitable for
'make-partition-image'."
#~'(#$@(list (partition-size partition))
#$(partition-file-system partition)
#$(partition-label partition)
#$(and=> (partition-uuid partition)
uuid-bytevector)))
(define gcrypt-sqlite3&co
;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs.
(srfi-1:append-map
(lambda (package)
(cons package
(match (package-transitive-propagated-inputs package)
(((labels packages) ...)
packages))))
(list guile-gcrypt guile-sqlite3)))
(define-syntax-rule (with-imported-modules* gexp* ...)
(with-extensions gcrypt-sqlite3&co
(with-imported-modules `(,@(source-module-closure
'((gnu build vm)
(gnu build image)
(guix store database))
#:select? not-config?)
((guix config) => ,(make-config.scm)))
#~(begin
(use-modules (gnu build vm)
(gnu build image)
(guix store database)
(guix build utils))
gexp* ...))))
;;
;; Disk image.
;;
(define* (system-disk-image image
#:key
(name "disk-image")
bootcfg
bootloader
register-closures?
(inputs '()))
"Return as a file-like object, the disk-image described by IMAGE. Said
image can be copied on a USB stick as is. BOOTLOADER is the bootloader that
will be installed and configured according to BOOTCFG parameter.
Raw images of the IMAGE partitions are first created. Then, genimage is used
to assemble the partition images into a disk-image without resorting to a
virtual machine.
INPUTS is a list of inputs (as for packages). When REGISTER-CLOSURES? is
true, register INPUTS in the store database of the image so that Guix can be
used in the image."
(define genimage-name "image")
(define (image->genimage-cfg image)
;; Return as a file-like object, the genimage configuration file
;; describing the given IMAGE.
(define (format->image-type format)
;; Return the genimage format corresponding to FORMAT. For now, only
;; the hdimage format (raw disk-image) is supported.
(case format
((disk-image) "hdimage")
(else
(raise (condition
(&message
(message
(format #f (G_ "Unsupported image type ~a~%.") format))))))))
(define (partition->dos-type partition)
;; Return the MBR partition type corresponding to the given PARTITION.
;; See: https://en.wikipedia.org/wiki/Partition_type.
(let ((flags (partition-flags partition)))
(cond
((member 'esp flags) "0xEF")
(else "0x83"))))
(define (partition-image partition)
;; Return as a file-like object, an image of the given PARTITION. A
;; directory, filled by calling the PARTITION initializer procedure, is
;; first created within the store. Then, an image of this directory is
;; created using tools such as 'mke2fs' or 'mkdosfs', depending on the
;; partition file-system type.
(let* ((os (image-operating-system image))
(schema (local-file (search-path %load-path
"guix/store/schema.sql")))
(graph (match inputs
(((names . _) ...)
names)))
(root-builder
(with-imported-modules*
(let* ((initializer #$(partition-initializer partition)))
(sql-schema #$schema)
;; Allow non-ASCII file names--e.g., 'nss-certs'--to be
;; decoded.
(setenv "GUIX_LOCPATH"
#+(file-append glibc-utf8-locales "/lib/locale"))
(setlocale LC_ALL "en_US.utf8")
(initializer #$output
#:references-graphs '#$graph
#:deduplicate? #f
#:system-directory #$os
#:bootloader-package
#$(bootloader-package bootloader)
#:bootcfg #$bootcfg
#:bootcfg-location
#$(bootloader-configuration-file bootloader)))))
(image-root
(computed-file "partition-image-root" root-builder
#:options `(#:references-graphs ,inputs)))
(type (partition-file-system partition))
(image-builder
(with-imported-modules*
(let ((inputs '#$(list e2fsprogs dosfstools mtools)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(make-partition-image #$(partition->gexp partition)
#$output
#$image-root)))))
(computed-file "partition.img" image-builder)))
(define (partition->config partition)
;; Return the genimage partition configuration for PARTITION.
(let ((label (partition-label partition))
(dos-type (partition->dos-type partition))
(image (partition-image partition)))
#~(format #f "~/partition ~a {
~/~/partition-type = ~a
~/~/image = \"~a\"
~/}" #$label #$dos-type #$image)))
(let* ((format (image-format image))
(image-type (format->image-type format))
(partitions (image-partitions image))
(partitions-config (map partition->config partitions))
(builder
#~(begin
(let ((format (@ (ice-9 format) format)))
(call-with-output-file #$output
(lambda (port)
(format port
"\
image ~a {
~/~a {}
~{~a~^~%~}
}~%" #$genimage-name #$image-type (list #$@partitions-config))))))))
(computed-file "genimage.cfg" builder)))
(let* ((substitutable? (image-substitutable? image))
(builder
(with-imported-modules*
(let ((inputs '#$(list genimage coreutils findutils)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(genimage #$(image->genimage-cfg image) #$output))))
(image-dir (computed-file "image-dir" builder)))
(computed-file name
#~(symlink
(string-append #$image-dir "/" #$genimage-name)
#$output)
#:options `(#:substitutable? ,substitutable?))))
;;
;; ISO9660 image.
;;
(define (has-guix-service-type? os)
"Return true if OS contains a service of the type GUIX-SERVICE-TYPE."
(not (not (srfi-1:find (lambda (service)
(eq? (service-kind service) guix-service-type))
(operating-system-services os)))))
(define* (system-iso9660-image image
#:key
(name "iso9660-image")
bootcfg
bootloader
register-closures?
(inputs '())
(grub-mkrescue-environment '()))
"Return as a file-like object a bootable, stand-alone iso9660 image.
INPUTS is a list of inputs (as for packages). When REGISTER-CLOSURES? is
true, register INPUTS in the store database of the image so that Guix can be
used in the image. "
(define root-label
(match (image-partitions image)
((partition)
(partition-label partition))))
(define root-uuid
(match (image-partitions image)
((partition)
(uuid-bytevector (partition-uuid partition)))))
(let* ((os (image-operating-system image))
(bootloader (bootloader-package bootloader))
(compression? (image-compression? image))
(substitutable? (image-substitutable? image))
(schema (local-file (search-path %load-path
"guix/store/schema.sql")))
(graph (match inputs
(((names . _) ...)
names)))
(root-builder
(with-imported-modules*
(sql-schema #$schema)
;; Allow non-ASCII file names--e.g., 'nss-certs'--to be decoded.
(setenv "GUIX_LOCPATH"
#+(file-append glibc-utf8-locales "/lib/locale"))
(setlocale LC_ALL "en_US.utf8")
(initialize-root-partition #$output
#:references-graphs '#$graph
#:deduplicate? #f
#:system-directory #$os)))
(image-root
(computed-file "image-root" root-builder
#:options `(#:references-graphs ,inputs)))
(builder
(with-imported-modules*
(let* ((inputs '#$(list parted e2fsprogs dosfstools xorriso
sed grep coreutils findutils gawk)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(make-iso9660-image #$xorriso
'#$grub-mkrescue-environment
#$bootloader
#$bootcfg
#$os
#$image-root
#$output
#:references-graphs '#$graph
#:register-closures? #$register-closures?
#:compression? #$compression?
#:volume-id #$root-label
#:volume-uuid #$root-uuid)))))
(computed-file name builder
#:options `(#:references-graphs ,inputs
#:substitutable? ,substitutable?))))
;;
;; Image creation.
;;
(define (root-partition? partition)
"Return true if PARTITION is the root partition, false otherwise."
(member 'boot (partition-flags partition)))
(define (find-root-partition image)
"Return the root partition of the given IMAGE."
(srfi-1:find root-partition? (image-partitions image)))
(define (image->root-file-system image)
"Return the IMAGE root partition file-system type."
(let ((format (image-format image)))
(if (eq? format 'iso9660)
"iso9660"
(partition-file-system (find-root-partition image)))))
(define (root-size image)
"Return the root partition size of IMAGE."
(let* ((image-size (image-size image))
(root-partition (find-root-partition image))
(root-size (partition-size root-partition)))
(cond
((and (eq? root-size 'guess) image-size)
image-size)
(else root-size))))
(define* (image-with-os base-image os)
"Return an image based on BASE-IMAGE but with the operating-system field set
to OS. Also set the UUID and the size of the root partition."
(define root-file-system
(srfi-1:find
(lambda (fs)
(string=? (file-system-mount-point fs) "/"))
(operating-system-file-systems os)))
(let*-values (((partitions) (image-partitions base-image))
((root-partition other-partitions)
(srfi-1:partition root-partition? partitions)))
(image
(inherit base-image)
(operating-system os)
(partitions
(cons (partition
(inherit (car root-partition))
(uuid (file-system-device root-file-system))
(size (root-size base-image)))
other-partitions)))))
(define (operating-system-for-image image)
"Return an operating-system based on the one specified in IMAGE, but
suitable for image creation. Assign an UUID to the root file-system, so that
it can be used for bootloading."
(define volatile-root? (image-volatile-root? image))
(define (root-uuid os)
;; UUID of the root file system, computed in a deterministic fashion.
;; This is what we use to locate the root file system so it has to be
;; different from the user's own file system UUIDs.
(let ((type (if (eq? (image-format image) 'iso9660)
'iso9660
'dce)))
(operating-system-uuid os type)))
(let* ((root-file-system-type (image->root-file-system image))
(base-os (image-operating-system image))
(file-systems-to-keep
(srfi-1:remove
(lambda (fs)
(string=? (file-system-mount-point fs) "/"))
(operating-system-file-systems base-os)))
(format (image-format image))
(os
(operating-system
(inherit base-os)
(initrd (lambda (file-systems . rest)
(apply (operating-system-initrd base-os)
file-systems
#:volatile-root? volatile-root?
rest)))
(bootloader (if (eq? format 'iso9660)
(bootloader-configuration
(inherit
(operating-system-bootloader base-os))
(bootloader grub-mkrescue-bootloader))
(operating-system-bootloader base-os)))
(file-systems (cons (file-system
(mount-point "/")
(device "/dev/placeholder")
(type root-file-system-type))
file-systems-to-keep))))
(uuid (root-uuid os)))
(operating-system
(inherit os)
(file-systems (cons (file-system
(mount-point "/")
(device uuid)
(type root-file-system-type))
file-systems-to-keep)))))
(define* (make-system-image image)
"Return the derivation of IMAGE. It can be a raw disk-image or an ISO9660
image, depending on IMAGE format."
(define substitutable? (image-substitutable? image))
(let* ((os (operating-system-for-image image))
(image* (image-with-os image os))
(register-closures? (has-guix-service-type? os))
(bootcfg (operating-system-bootcfg os))
(bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))))
(case (image-format image)
((disk-image)
(system-disk-image image*
#:bootcfg bootcfg
#:bootloader bootloader
#:register-closures? register-closures?
#:inputs `(("system" ,os)
("bootcfg" ,bootcfg))))
((iso9660)
(system-iso9660-image image*
#:bootcfg bootcfg
#:bootloader bootloader
#:register-closures? register-closures?
#:inputs `(("system" ,os)
("bootcfg" ,bootcfg))
#:grub-mkrescue-environment
'(("MKRESCUE_SED_MODE" . "mbr_hfs")))))))
(define (find-image file-system-type)
"Find and return an image that could match the given FILE-SYSTEM-TYPE. This
is useful to adapt to interfaces written before the addition of the <image>
record."
;; XXX: Add support for system and target here, or in the caller.
(match file-system-type
("iso9660" iso9660-image)
(_ efi-disk-image)))
(define (system-image image)
"Wrap 'make-system-image' call, so that it is used only if the given IMAGE
is supported. Otherwise, fallback to image creation in a VM. This is
temporary and should be removed once 'make-system-image' is able to deal with
all types of images."
(define substitutable? (image-substitutable? image))
(define volatile-root? (image-volatile-root? image))
(let* ((image-os (image-operating-system image))
(image-root-filesystem-type (image->root-file-system image))
(bootloader (bootloader-configuration-bootloader
(operating-system-bootloader image-os)))
(bootloader-name (bootloader-name bootloader))
(size (image-size image))
(format (image-format image)))
(mbegin %store-monad
(if (and (or (eq? bootloader-name 'grub)
(eq? bootloader-name 'extlinux))
(eq? format 'disk-image))
;; Fallback to image creation in a VM when it is not yet supported
;; by this module.
(system-disk-image-in-vm image-os
#:disk-image-size size
#:file-system-type image-root-filesystem-type
#:volatile? volatile-root?
#:substitutable? substitutable?)
(lower-object
(make-system-image image))))))
;;; image.scm ends here

1
gnu/system/install.scm
View File

@ -523,6 +523,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
mdadm
dosfstools ;mkfs.fat, for the UEFI boot partition
btrfs-progs
f2fs-tools
jfsutils
openssh ;we already have sshd, having ssh/scp can help
wireless-tools iw wpa-supplicant-minimal iproute

3
gnu/system/linux-initrd.scm
View File

@ -245,6 +245,9 @@ FILE-SYSTEMS."
'())
,@(if (find (file-system-type-predicate "jfs") file-systems)
(list jfs_fsck/static)
'())
,@(if (find (file-system-type-predicate "f2fs") file-systems)
(list f2fs-fsck/static)
'())))
(define-syntax vhash ;TODO: factorize

216
gnu/system/vm.scm
View File

@ -77,7 +77,7 @@
system-qemu-image/shared-store
system-qemu-image/shared-store-script
system-disk-image
system-disk-image-in-vm
system-docker-image
virtual-machine
@ -269,95 +269,6 @@ substitutable."
(eq? (service-kind service) guix-service-type))
(operating-system-services os)))))
(define* (iso9660-image #:key
(name "iso9660-image")
file-system-label
file-system-uuid
(system (%current-system))
(target (%current-target-system))
(qemu qemu-minimal)
os
bootcfg-drv
bootloader
(register-closures? (has-guix-service-type? os))
(inputs '())
(grub-mkrescue-environment '())
(substitutable? #t))
"Return a bootable, stand-alone iso9660 image.
INPUTS is a list of inputs (as for packages)."
(define schema
(and register-closures?
(local-file (search-path %load-path
"guix/store/schema.sql"))))
(expression->derivation-in-linux-vm
name
(with-extensions gcrypt-sqlite3&co
(with-imported-modules `(,@(source-module-closure '((gnu build vm)
(guix store database)
(guix build utils))
#:select? not-config?)
((guix config) => ,(make-config.scm)))
#~(begin
(use-modules (gnu build vm)
(guix store database)
(guix build utils))
(sql-schema #$schema)
;; Allow non-ASCII file names--e.g., 'nss-certs'--to be decoded.
(setenv "GUIX_LOCPATH"
#+(file-append glibc-utf8-locales "/lib/locale"))
(setlocale LC_ALL "en_US.utf8")
(let ((inputs
'#$(append (list parted e2fsprogs dosfstools xorriso)
(map canonical-package
(list sed grep coreutils findutils gawk))))
(graphs '#$(match inputs
(((names . _) ...)
names)))
;; This variable is unused but allows us to add INPUTS-TO-COPY
;; as inputs.
(to-register
'#$(map (match-lambda
((name thing) thing)
((name thing output) `(,thing ,output)))
inputs)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(make-iso9660-image #$xorriso
'#$grub-mkrescue-environment
#$(bootloader-package bootloader)
#$bootcfg-drv
#$os
"/xchg/guixsd.iso"
#:register-closures? #$register-closures?
#:closures graphs
#:volume-id #$file-system-label
#:volume-uuid #$(and=> file-system-uuid
uuid-bytevector))))))
#:system system
#:target target
;; Keep a local file system for /tmp so that we can populate it directly as
;; root and have files owned by root. See <https://bugs.gnu.org/31752>.
#:file-systems (remove (lambda (file-system)
(string=? (file-system-mount-point file-system)
"/tmp"))
%linux-vm-file-systems)
#:make-disk-image? #f
#:single-file-output? #t
#:references-graphs inputs
#:substitutable? substitutable?
;; Xorriso seems to be quite memory-hungry, so increase the VM's RAM size.
#:memory-size 512))
(define* (qemu-image #:key
(name "qemu-image")
(system (%current-system))
@ -624,62 +535,13 @@ system."
;;; VM and disk images.
;;;
(define* (operating-system-uuid os #:optional (type 'dce))
"Compute UUID object with a deterministic \"UUID\" for OS, of the given
TYPE (one of 'iso9660 or 'dce). Return a UUID object."
;; Note: For this to be deterministic, we must not hash things that contains
;; (directly or indirectly) procedures, for example. That rules out
;; anything that contains gexps, thunk or delayed record fields, etc.
(define service-name
(compose service-type-name service-kind))
(define (file-system-digest fs)
;; Return a hashable digest that does not contain 'dependencies' since
;; this field can contain procedures.
(let ((device (file-system-device fs)))
(list (file-system-mount-point fs)
(file-system-type fs)
(file-system-device->string device)
(file-system-options fs))))
(if (eq? type 'iso9660)
(let ((pad (compose (cut string-pad <> 2 #\0)
number->string))
(h (hash (map service-name (operating-system-services os))
3600)))
(bytevector->uuid
(string->iso9660-uuid
(string-append "1970-01-01-"
(pad (hash (operating-system-host-name os) 24)) "-"
(pad (quotient h 60)) "-"
(pad (modulo h 60)) "-"
(pad (hash (map file-system-digest
(operating-system-file-systems os))
100))))
'iso9660))
(bytevector->uuid
(uint-list->bytevector
(list (hash (map file-system-digest
(operating-system-file-systems os))
(- (expt 2 32) 1))
(hash (operating-system-host-name os)
(- (expt 2 32) 1))
(hash (map service-name (operating-system-services os))
(- (expt 2 32) 1))
(hash (map file-system-digest (operating-system-file-systems os))
(- (expt 2 32) 1)))
(endianness little)
4)
type)))
(define* (system-disk-image os
#:key
(name "disk-image")
(file-system-type "ext4")
(disk-image-size (* 900 (expt 2 20)))
(volatile? #t)
(substitutable? #t))
(define* (system-disk-image-in-vm os
#:key
(name "disk-image")
(file-system-type "ext4")
(disk-image-size (* 900 (expt 2 20)))
(volatile? #t)
(substitutable? #t))
"Return the derivation of a disk image of DISK-IMAGE-SIZE bytes of the
system described by OS. Said image can be copied on a USB stick as is. When
VOLATILE? is true, the root file system is made volatile; this is useful
@ -687,25 +549,14 @@ to USB sticks meant to be read-only.
SUBSTITUTABLE? determines whether the returned derivation should be marked as
substitutable."
(define normalize-label
;; ISO labels are all-caps (case-insensitive), but since
;; 'find-partition-by-label' is case-sensitive, make it all-caps here.
(if (string=? "iso9660" file-system-type)
string-upcase
identity))
(define root-label
;; Volume name of the root file system.
(normalize-label "Guix_image"))
"Guix_image")
(define (root-uuid os)
;; UUID of the root file system, computed in a deterministic fashion.
;; This is what we use to locate the root file system so it has to be
;; different from the user's own file system UUIDs.
(operating-system-uuid os
(if (string=? file-system-type "iso9660")
'iso9660
'dce)))
(operating-system-uuid os 'dce))
(define file-systems-to-keep
(remove (lambda (fs)
@ -722,11 +573,7 @@ substitutable."
#:volatile-root? volatile?
rest)))
(bootloader (if (string=? "iso9660" file-system-type)
(bootloader-configuration
(inherit (operating-system-bootloader os))
(bootloader grub-mkrescue-bootloader))
(operating-system-bootloader os)))
(bootloader (operating-system-bootloader os))
;; Force our own root file system. (We need a "/" file system
;; to call 'root-uuid'.)
@ -744,33 +591,20 @@ substitutable."
(type file-system-type))
file-systems-to-keep))))
(bootcfg (operating-system-bootcfg os)))
(if (string=? "iso9660" file-system-type)
(iso9660-image #:name name
#:file-system-label root-label
#:file-system-uuid uuid
#:os os
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))
#:inputs `(("system" ,os)
("bootcfg" ,bootcfg))
#:grub-mkrescue-environment
'(("MKRESCUE_SED_MODE" . "mbr_hfs"))
#:substitutable? substitutable?)
(qemu-image #:name name
#:os os
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))
#:disk-image-size disk-image-size
#:disk-image-format "raw"
#:file-system-type file-system-type
#:file-system-label root-label
#:file-system-uuid uuid
#:copy-inputs? #t
#:inputs `(("system" ,os)
("bootcfg" ,bootcfg))
#:substitutable? substitutable?))))
(qemu-image #:name name
#:os os
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))
#:disk-image-size disk-image-size
#:disk-image-format "raw"
#:file-system-type file-system-type
#:file-system-label root-label
#:file-system-uuid uuid
#:copy-inputs? #t
#:inputs `(("system" ,os)
("bootcfg" ,bootcfg))
#:substitutable? substitutable?)))
(define* (system-qemu-image os
#:key

97
gnu/tests/install.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -21,9 +22,11 @@
(define-module (gnu tests install)
#:use-module (gnu)
#:use-module (gnu bootloader extlinux)
#:use-module (gnu image)
#:use-module (gnu tests)
#:use-module (gnu tests base)
#:use-module (gnu system)
#:use-module (gnu system image)
#:use-module (gnu system install)
#:use-module (gnu system vm)
#:use-module ((gnu build vm) #:select (qemu-command))
@ -59,6 +62,7 @@
%test-encrypted-root-os
%test-btrfs-root-os
%test-jfs-root-os
%test-f2fs-root-os
%test-gui-installed-os
%test-gui-installed-os-encrypted
@ -229,14 +233,18 @@ packages defined in installation-os."
;; roots. This way, we know 'guix system init' will
;; succeed. Also add guile-final, which is pulled in
;; through provenance.drv and may not always be present.
(image (system-disk-image
(operating-system-with-gc-roots
os (list target guile-final))
#:disk-image-size install-size
#:file-system-type
installation-disk-image-file-system-type
;; Don't provide substitutes; too big.
#:substitutable? #f)))
(image
(system-image
(image
(inherit
(find-image
installation-disk-image-file-system-type))
(size install-size)
(operating-system
(operating-system-with-gc-roots
os (list target guile-final)))
;; Don't provide substitutes; too big.
(substitutable? #f)))))
(define install
(with-imported-modules '((guix build utils)
(gnu build marionette))
@ -928,6 +936,79 @@ build (current-guix) and then store a couple of full system images.")
(command (qemu-command/writable-image image)))
(run-basic-test %jfs-root-os command "jfs-root-os")))))
;;;
;;; F2FS root file system.
;;;
(define-os-with-source (%f2fs-root-os %f2fs-root-os-source)
;; The OS we want to install.
(use-modules (gnu) (gnu tests) (srfi srfi-1))
(operating-system
(host-name "liberigilo")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
(target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
(type "f2fs"))
%base-file-systems))
(users (cons (user-account
(name "charlie")
(group "users")
(supplementary-groups '("wheel" "audio" "video")))
%base-user-accounts))
(services (cons (service marionette-service-type
(marionette-configuration
(imported-modules '((gnu services herd)
(guix combinators)))))
%base-services))))
(define %f2fs-root-installation-script
;; Shell script of a simple installation.
"\
. /etc/profile
set -e -x
guix --version
export GUIX_BUILD_OPTIONS=--no-grafts
ls -l /run/current-system/gc-roots
parted --script /dev/vdb mklabel gpt \\
mkpart primary ext2 1M 3M \\
mkpart primary ext2 3M 2G \\
set 1 boot on \\
set 1 bios_grub on
mkfs.f2fs -l my-root -q /dev/vdb2
mount /dev/vdb2 /mnt
herd start cow-store /mnt
mkdir /mnt/etc
cp /etc/target-config.scm /mnt/etc/config.scm
guix system build /mnt/etc/config.scm
guix system init /mnt/etc/config.scm /mnt --no-substitutes
sync
reboot\n")
(define %test-f2fs-root-os
(system-test
(name "f2fs-root-os")
(description
"Test basic functionality of an OS installed like one would do by hand.
This test is expensive in terms of CPU and storage usage since we need to
build (current-guix) and then store a couple of full system images.")
(value
(mlet* %store-monad ((image (run-install %f2fs-root-os
%f2fs-root-os-source
#:script
%f2fs-root-installation-script))
(command (qemu-command/writable-image image)))
(run-basic-test %f2fs-root-os command "f2fs-root-os")))))
;;;
;;; Installation through the graphical interface.

1
guix/build/store-copy.scm
View File

@ -35,6 +35,7 @@
read-reference-graph
file-size
closure-size
populate-store))

1108
guix/openpgp.scm 100644
View File

File diff suppressed because it is too large Load Diff

13
guix/scripts/system.scm
View File

@ -54,9 +54,11 @@
#:autoload (gnu build linux-modules)
(device-module-aliases matching-modules)
#:use-module (gnu system linux-initrd)
#:use-module (gnu image)
#:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems)
#:use-module (gnu system image)
#:use-module (gnu system mapped-devices)
#:use-module (gnu system linux-container)
#:use-module (gnu system uuid)
@ -692,12 +694,11 @@ checking this by themselves in their 'check' procedure."
(* 70 (expt 2 20)))
#:mappings mappings))
((disk-image)
(system-disk-image os
#:name (match file-system-type
("iso9660" "image.iso")
(_ "disk-image"))
#:disk-image-size image-size
#:file-system-type file-system-type))
(system-image
(image
(inherit (find-image file-system-type))
(size image-size)
(operating-system os))))
((docker-image)
(system-docker-image os))))

1345
tests/civodul.key 100644
View File

File diff suppressed because it is too large Load Diff

25
tests/dsa.key 100644
View File

@ -0,0 +1,25 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
mQMuBF4SQfARCACb/C7qcwKhOdaej1z8dK02iMJlw/C868VEeAuSvXHBE5OULm1+
SlwPCgsLIhe8AIsW0F8zgWlNdOKbcmU1NdzUfo0PIRA8ASerZ3EFd7cloRjk1X3c
XbklFQ8D37thgFXYBOkkjzKwCvc+ebcQQsRSvJLhQODSRzknIQBYLoYjKh8skEwY
uK+rFs7fEHTrCwnriF7QCZnGqoScS56MrgEtHHwBDpKt8CruSekEHAfI5INMhb6R
fdVNTj7TL9gCOlYA6IPK6pfYKjghQ79IGMcGnaEPUdiEuAbc1AVQtfRi4e/IbbN6
/CDmfSQ/fCYm9hQ5sAMzUCqDreqqYrpEYmVHAQC3uXiV7qjDe2vlfz4GNSFOqvHC
xHp9UYWE6IQFzVutMwgAgldl3Ql6zxIoiU76bXRDP+W+g67uW1Fnd6ltOVYb4rxp
wIRlQpwZeNPzFeZHZ1mJA1rvdD3mORnnnIIwW9Cr5Kn/e63PBJJcYJZZ6bnWYh5O
1MDzyn0CYu4btP0tj7PNxKfxvIxDX3sqfkBFsGgquwa/AwWrdWXD99//PK0iNGN4
WewwXmC2S2SmcuHL0nB4eV6uuQZOK6u3/end1/FqAMEJAW4jC7x7UvbeFs1dwiJv
psjluTpP1QDh7ySDfBOANlxOxAM6oCfvUqZ+pifNFw7t3p1eiK3wtjB8fer7bZg3
OT4Pl4gImmCjXs0cse0+FLpUA/gzPHxYR/rUyD/nQwf8CfFRGu+bGFju3YHbZ2T0
cHF/9c3sCdQU7nVnYleySnv1OMDSYoZ7geqgC2q0pnHeezII7hcJB8tKx3BV+J7A
WYUL31K4gybK9VkFQC8h+BzPjnzjXEHgL5GY621cPSLJzOyFhY9lKrWUD/DVGXtu
xFjissXG2h6jgf+BAqDCKFVYyu/7TQuDA/FKPhx/8Hn9LX4A3CTFswnsRtABGt6t
U4yUfQWhnDqLDYWrjvXOEHbMQuBOAU3rPpTLLyQzyKVsQZlMBR5UrSXXY1lN76yl
J0NAyeOmgvDT75QAVHPxp9lidRTQJHXU1Ah+N/fzPYamKmgheCXZE8r5cPY3Mkvp
w7QbPGx1ZG8rdGVzdC1kc2FAY2hib3VpYi5vcmc+iJYEExEIAD4WIQQohKmAQiMw
pPM92X9YeRgEe+i9LAUCXhJB8AIbAwUJA8JnAAULCQgHAgYVCgkICwIEFgIDAQIe
AQIXgAAKCRBYeRgEe+i9LOyvAP0a2DIMruGZSHeWcQaNiRWb2/UEq4ClRw67rA7f
39sD5AD+PKeovYJkTSV+F00QKHibMhoGurxABnEUeqmetGITVSU=
=YZip
-----END PGP PUBLIC KEY BLOCK-----

10
tests/ed25519.key 100644
View File

@ -0,0 +1,10 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
mDMEXqNaoBYJKwYBBAHaRw8BAQdArviKtelb4g0I3zx9xyDS40Oz8i1/LRXqppG6
b23Hdim0KEVkIFR3by1GaWZ0eSA8bHVkbyt0ZXN0LWVjY0BjaGJvdWliLm9yZz6I
lgQTFggAPhYhBETTHiGvcTj5tjIoCncfScv6rgctBQJeo1qgAhsDBQkDwmcABQsJ
CAcCBhUKCQgLAgQWAgMBAh4BAheAAAoJEHcfScv6rgctq4MA/1R9G0roEwrHwmTd
DHxt211eLqupwXE0Z7xY2FH6DHk9AP4owEefBU7jQprSAzBS+c6gdS3SCCKKqAh6
ToZ4LmbKAw==
=FXMK
-----END PGP PUBLIC KEY BLOCK-----

10
tests/ed25519.sec 100644
View File

@ -0,0 +1,10 @@
-----BEGIN PGP PRIVATE KEY BLOCK-----
lFgEXqNaoBYJKwYBBAHaRw8BAQdArviKtelb4g0I3zx9xyDS40Oz8i1/LRXqppG6
b23HdikAAQDGgjcUcvqR+nGYcf5UHzy9xlO/dBZX4f9QV1ILDIGt0hAYtChFZCBU
d28tRmlmdHkgPGx1ZG8rdGVzdC1lY2NAY2hib3VpYi5vcmc+iJYEExYIAD4WIQRE
0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqNaoAIbAwUJA8JnAAULCQgHAgYVCgkICwIE
FgIDAQIeAQIXgAAKCRB3H0nL+q4HLauDAP9UfRtK6BMKx8Jk3Qx8bdtdXi6rqcFx
NGe8WNhR+gx5PQD+KMBHnwVO40Ka0gMwUvnOoHUt0ggiiqgIek6GeC5mygM=
=VjjI
-----END PGP PRIVATE KEY BLOCK-----

253
tests/openpgp.scm 100644
View File

@ -0,0 +1,253 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 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/>.
(define-module (tests-openpgp)
#:use-module (guix openpgp)
#:use-module (gcrypt base16)
#:use-module (gcrypt hash)
#:use-module (gcrypt pk-crypto)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-64)
#:use-module (srfi srfi-71))
(define %radix-64-sample
;; Example of Radix-64 encoding from Section 6.6 of RFC4880.
"\
-----BEGIN PGP MESSAGE-----
Version: OpenPrivacy 0.99
yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS
vBSFjNSiVHsuAA==
=njUN
-----END PGP MESSAGE-----\n")
(define %radix-64-sample/crc-mismatch
;; This time with a wrong CRC24 value.
"\
-----BEGIN PGP MESSAGE-----
yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS
vBSFjNSiVHsuAA==
=AAAA
-----END PGP MESSAGE-----\n")
(define %civodul-fingerprint
"3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5")
(define %civodul-key-id #x090B11993D9AEBB5) ;civodul.key
;; Test keys. They were generated in a container along these lines:
;; guix environment -CP --ad-hoc gnupg pinentry
;; then, within the container:
;; mkdir ~/.gnupg
;; echo pinentry-program ~/.guix-profile/bin/pinentry-tty > ~/.gnupg/gpg-agent.conf
;; gpg --quick-gen-key '<ludo+test-rsa@chbouib.org>' rsa
;; or similar.
(define %rsa-key-id #xAE25DA2A70DEED59) ;rsa.key
(define %dsa-key-id #x587918047BE8BD2C) ;dsa.key
(define %ed25519-key-id #x771F49CBFAAE072D) ;ed25519.key
(define %rsa-key-fingerprint
(base16-string->bytevector
(string-downcase "385F86CFC86B665A5C165E6BAE25DA2A70DEED59")))
(define %dsa-key-fingerprint
(base16-string->bytevector
(string-downcase "2884A980422330A4F33DD97F587918047BE8BD2C")))
(define %ed25519-key-fingerprint
(base16-string->bytevector
(string-downcase "44D31E21AF7138F9B632280A771F49CBFAAE072D")))
;;; The following are detached signatures created commands like:
;;; echo 'Hello!' | gpg -sba --digest-algo sha512
;;; They are detached (no PACKET-ONE-PASS-SIGNATURE) and uncompressed.
(define %hello-signature/rsa
;; Signature of the ASCII string "Hello!\n".
"\
-----BEGIN PGP SIGNATURE-----
iQEzBAABCAAdFiEEOF+Gz8hrZlpcFl5rriXaKnDe7VkFAl4SRF0ACgkQriXaKnDe
7VlIyQf/TU5rGUK42/C1ULoWvvm25Mjwh6xxoPPkuBxvos8bE6yKr/vJZePU3aSE
mjbVFcO7DioxHMqLd49j803bUtdllJVU18ex9MkKbKjapkgEGkJsuTTzqyONprgk
7xtZGBWuxkP1M6hJICJkA3Ys+sTdKalux/pzr5OWAe+gxytTF/vr/EyJzdmBxbJv
/fhd1SeVIXSw4c5gf2Wcvcgfy4N5CiLaUb7j4646KBTvDvmUMcDZ+vmKqC/XdQeQ
PrjArGKt40ErVd98fwvNHZnw7VQMx0A3nL3joL5g7/RckDOUb4mqKoqLsLd0wPHP
y32DiDUY9s3sy5OMzX4Y49em8vxvlg==
=ASEm
-----END PGP SIGNATURE-----")
(define %hello-signature/dsa
"\
-----BEGIN PGP SIGNATURE-----
iHUEABEIAB0WIQQohKmAQiMwpPM92X9YeRgEe+i9LAUCXhJFpQAKCRBYeRgEe+i9
LDAaAQC0lXPQepvZBANAUtRLMZuOwL9NQPkfhIwUXtLEBBzyFQD/So8DcybXpRBi
JKOiyAQQjMs/GJ6qMEQpRAhyyJRAock=
=iAEc
-----END PGP SIGNATURE-----")
(define %hello-signature/ed25519/sha256 ;digest-algo: sha256
"\
-----BEGIN PGP SIGNATURE-----
iHUEABYIAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRADAAKCRB3H0nL+q4H
LUImAP9/foaSjPFC/MSr52LNV5ROSL9haea4jPpUP+N6ViFGowEA+AE/xpXPIqsz
R6CdxMevURuqUpqQ7rHeiMmdUepeewU=
=tLXy
-----END PGP SIGNATURE-----")
(define %hello-signature/ed25519/sha512 ;digest-algo: sha512
"\
-----BEGIN PGP SIGNATURE-----
iHUEABYKAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRAGgAKCRB3H0nL+q4H
LTeKAP0S8LiiosJXOARlYNdhfGw9j26lHrbwJh5CORGlaqqIJAEAoMYcmtNa2b6O
inlEwB/KQM88O9RwA8xH7X5a0rodOw4=
=68r/
-----END PGP SIGNATURE-----")
(define %hello-signature/ed25519/sha1 ;digest-algo: sha1
"\
-----BEGIN PGP SIGNATURE-----
iHUEABYCAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRALQAKCRB3H0nL+q4H
LdhEAQCfkdYhIVRa43oTNw9EL/TDFGQjXSHNRFVU0ktjkWbkQwEAjIXhvj2sqy79
Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
=AE4G
-----END PGP SIGNATURE-----")
(test-begin "openpgp")
(test-equal "read-radix-64"
'(#t "PGP MESSAGE")
(let-values (((data type)
(call-with-input-string %radix-64-sample read-radix-64)))
(list (bytevector? data) type)))
(test-equal "read-radix-64, CRC mismatch"
'(#f "PGP MESSAGE")
(call-with-values
(lambda ()
(call-with-input-string %radix-64-sample/crc-mismatch
read-radix-64))
list))
(test-assert "get-openpgp-keyring"
(let* ((key (search-path %load-path "tests/civodul.key"))
(keyring (get-openpgp-keyring
(open-bytevector-input-port
(call-with-input-file key read-radix-64)))))
(let-values (((primary packets)
(lookup-key-by-id keyring %civodul-key-id)))
(let ((fingerprint (openpgp-public-key-fingerprint primary)))
(and (= (openpgp-public-key-id primary) %civodul-key-id)
(not (openpgp-public-key-subkey? primary))
(string=? (openpgp-format-fingerprint fingerprint)
%civodul-fingerprint)
(string=? (openpgp-user-id-value (find openpgp-user-id? packets))
"Ludovic Courtès <ludo@gnu.org>")
(eq? (lookup-key-by-fingerprint keyring fingerprint)
primary))))))
(test-equal "get-openpgp-detached-signature/ascii"
(list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256)
`(,%rsa-key-id ,%rsa-key-fingerprint rsa sha256)
`(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha256)
`(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha512)
`(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha1))
(map (lambda (str)
(let ((signature (get-openpgp-detached-signature/ascii
(open-input-string str))))
(list (openpgp-signature-issuer-key-id signature)
(openpgp-signature-issuer-fingerprint signature)
(openpgp-signature-public-key-algorithm signature)
(openpgp-signature-hash-algorithm signature))))
(list %hello-signature/dsa
%hello-signature/rsa
%hello-signature/ed25519/sha256
%hello-signature/ed25519/sha512
%hello-signature/ed25519/sha1)))
(test-equal "verify-openpgp-signature, missing key"
`(missing-key ,%rsa-key-fingerprint)
(let* ((keyring (get-openpgp-keyring (%make-void-port "r")))
(signature (string->openpgp-packet %hello-signature/rsa)))
(let-values (((status key)
(verify-openpgp-signature signature keyring
(open-input-string "Hello!\n"))))
(list status key))))
(test-equal "verify-openpgp-signature, good signatures"
`((good-signature ,%rsa-key-id)
(good-signature ,%dsa-key-id)
(good-signature ,%ed25519-key-id)
(good-signature ,%ed25519-key-id)
(good-signature ,%ed25519-key-id))
(map (lambda (key signature)
(let* ((key (search-path %load-path key))
(keyring (get-openpgp-keyring
(open-bytevector-input-port
(call-with-input-file key read-radix-64))))
(signature (string->openpgp-packet signature)))
(let-values (((status key)
(verify-openpgp-signature signature keyring
(open-input-string "Hello!\n"))))
(list status (openpgp-public-key-id key)))))
(list "tests/rsa.key" "tests/dsa.key"
"tests/ed25519.key" "tests/ed25519.key" "tests/ed25519.key")
(list %hello-signature/rsa %hello-signature/dsa
%hello-signature/ed25519/sha256
%hello-signature/ed25519/sha512
%hello-signature/ed25519/sha1)))
(test-equal "verify-openpgp-signature, bad signature"
`((bad-signature ,%rsa-key-id)
(bad-signature ,%dsa-key-id)
(bad-signature ,%ed25519-key-id)
(bad-signature ,%ed25519-key-id)
(bad-signature ,%ed25519-key-id))
(let ((keyring (fold (lambda (key keyring)
(let ((key (search-path %load-path key)))
(get-openpgp-keyring
(open-bytevector-input-port
(call-with-input-file key read-radix-64))
keyring)))
%empty-keyring
'("tests/rsa.key" "tests/dsa.key"
"tests/ed25519.key" "tests/ed25519.key"
"tests/ed25519.key"))))
(map (lambda (signature)
(let ((signature (string->openpgp-packet signature)))
(let-values (((status key)
(verify-openpgp-signature signature keyring
(open-input-string "What?!"))))
(list status (openpgp-public-key-id key)))))
(list %hello-signature/rsa %hello-signature/dsa
%hello-signature/ed25519/sha256
%hello-signature/ed25519/sha512
%hello-signature/ed25519/sha1))))
(test-end "openpgp")

18
tests/rsa.key 100644
View File

@ -0,0 +1,18 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
mQENBF4SRCYBCAC6eVyonmey9Lsa1QpWIcumkExZWmAsTNhNNrdhasU4rC0DGRnw
lJtey4h/5NRcGmur4cwwnHUyh9RhQOZgc4MkWfUECfgY98dhjq6+wSavSMwYJyKM
7yGuJgKQBBhdkfjYONP4eHbucifGNhsNRSURUREVCarOYa1AhmH4cmTPe7cUA8mH
EfQ2SOsmAUBNjn/Ba2Us8ydiZWGpJXYdzsXQ3HZl1vV2UtPEepPjAkJZa/7hm06z
9WrlOUxoro/R2R7COMWpzuhmY1Ak2VB4H6OMqPAEOk+/H5Pda1yCI9oRROawC24h
4yZYTpcRKV0EQ4cd4Z/DKA4gJdjufyRrmk0fABEBAAG0GzxsdWRvK3Rlc3QtcnNh
QGNoYm91aWIub3JnPokBVAQTAQgAPhYhBDhfhs/Ia2ZaXBZea64l2ipw3u1ZBQJe
EkQmAhsDBQkDwmcABQsJCAcCBhUKCQgLAgQWAgMBAh4BAheAAAoJEK4l2ipw3u1Z
c70IAI+eBLJzXGXNlugNE5rl5YplrLQem9otL7OKIpR+ye3Wg/DRZvN9x+lvUftq
rG0+wqxo/WQTy6ZLDUI83OY13zLXDKjRgPdqPYBAYxCY8CMayjDUv8axZVEfC7IX
IYgqzZg0E0dfF3m9S+6WUfOYCS5qR2go7TxbrnDyhDiswd5r3TRX5U+asHm0iXTy
Pmb0WY301mm1UPToOHSpweMuCw/n5as15o9CWeUJa/I0J6puM66ZRqGt8+7BSCu6
ata0BYLBCUD8aqhgNQpcMAkTRUSr8LNgfgdxr2Ozr+FF39NXGfLihL18AQEvh3SI
K/5YAnXV2oMRhOQttDJROOXByoY=
=N6XF
-----END PGP PUBLIC KEY BLOCK-----