diff options
author | Marius Bakke <marius@gnu.org> | 2020-11-22 23:36:09 +0100 |
---|---|---|
committer | Marius Bakke <marius@gnu.org> | 2020-11-22 23:36:09 +0100 |
commit | a485a98ca8296d760251e9d870583117ac50979e (patch) | |
tree | 792df6983c0e52403a6c3b82c804f295369a9b1d /guix | |
parent | 84d1b500f078b619daba35864c703890bd91e5c2 (diff) | |
parent | 1ca0c348674dd4dec2ccb5a2d79b4cfd03a631ef (diff) | |
download | guix-a485a98ca8296d760251e9d870583117ac50979e.tar guix-a485a98ca8296d760251e9d870583117ac50979e.tar.gz |
Merge branch 'master' into staging
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/cargo-build-system.scm | 7 | ||||
-rw-r--r-- | guix/cpio.scm | 33 | ||||
-rw-r--r-- | guix/import/hackage.scm | 14 | ||||
-rw-r--r-- | guix/import/stackage.scm | 8 | ||||
-rw-r--r-- | guix/lint.scm | 83 | ||||
-rw-r--r-- | guix/scripts/build.scm | 13 | ||||
-rw-r--r-- | guix/scripts/environment.scm | 2 | ||||
-rw-r--r-- | guix/scripts/graph.scm | 5 | ||||
-rw-r--r-- | guix/scripts/install.scm | 2 | ||||
-rw-r--r-- | guix/scripts/lint.scm | 15 | ||||
-rw-r--r-- | guix/scripts/pack.scm | 2 | ||||
-rw-r--r-- | guix/scripts/package.scm | 2 | ||||
-rw-r--r-- | guix/scripts/publish.scm | 6 | ||||
-rw-r--r-- | guix/scripts/upgrade.scm | 2 | ||||
-rw-r--r-- | guix/store.scm | 6 | ||||
-rw-r--r-- | guix/transformations.scm | 16 |
16 files changed, 185 insertions, 31 deletions
diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index 73493af551..c7beffc6e4 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -123,6 +123,13 @@ directory = '" port) (setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc")) (setenv "LIBGIT2_SYS_USE_PKG_CONFIG" "1") (setenv "LIBSSH2_SYS_USE_PKG_CONFIG" "1") + (when (assoc-ref inputs "openssl") + (setenv "OPENSSL_DIR" (assoc-ref inputs "openssl"))) + (when (assoc-ref inputs "gettext") + (setenv "GETTEXT_SYSTEM" (assoc-ref inputs "gettext"))) + (when (assoc-ref inputs "clang") + (setenv "LIBCLANG_PATH" + (string-append (assoc-ref inputs "clang") "/lib"))) ;; We don't use the Cargo.lock file to determine the package versions we use ;; during building, and in any case if one is not present it is created diff --git a/guix/cpio.scm b/guix/cpio.scm index e4692e2e9c..c9932f5bf9 100644 --- a/guix/cpio.scm +++ b/guix/cpio.scm @@ -27,6 +27,7 @@ make-cpio-header file->cpio-header file->cpio-header* + special-file->cpio-header* write-cpio-header read-cpio-header @@ -132,9 +133,10 @@ (%make-cpio-header MAGIC inode mode uid gid nlink mtime - (if (= C_ISDIR (logand mode C_FMT)) - 0 - size) + (if (or (= C_ISLNK (logand mode C_FMT)) + (= C_ISREG (logand mode C_FMT))) + size + 0) major minor rmajor rminor (+ name-size 1) ;include trailing zero 0))) ;checksum @@ -146,6 +148,8 @@ denotes, similar to 'stat:type'." (cond ((= C_ISREG fmt) 'regular) ((= C_ISDIR fmt) 'directory) ((= C_ISLNK fmt) 'symlink) + ((= C_ISBLK fmt) 'block-special) + ((= C_ISCHR fmt) 'char-special) (else (error "unsupported file type" mode))))) @@ -187,6 +191,25 @@ produced in a deterministic fashion." #:size (stat:size st) #:name-size (string-length file-name)))) +(define* (special-file->cpio-header* file + device-type + device-major + device-minor + permission-bits + #:optional (file-name file)) + "Create a character or block device header. + +DEVICE-TYPE is either 'char-special or 'block-special. + +The number of hard links is assumed to be 1." + (make-cpio-header #:mode (logior (match device-type + ('block-special C_ISBLK) + ('char-special C_ISCHR)) + permission-bits) + #:nlink 1 + #:rdev (device-number device-major device-minor) + #:name-size (string-length file-name))) + (define %trailer "TRAILER!!!") @@ -233,6 +256,10 @@ produces with the '-H newc' option." (put-string port target))) ((directory) #t) + ((block-special) + #t) + ((char-special) + #t) (else (error "file type not supported"))) diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 35c67cad8d..6ca4f65cb0 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -40,7 +40,8 @@ #:use-module (guix upstream) #:use-module (guix packages) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) - #:export (hackage->guix-package + #:export (%hackage-url + hackage->guix-package hackage-recursive-import %hackage-updater @@ -92,20 +93,23 @@ (define package-name-prefix "ghc-") +(define %hackage-url + (make-parameter "https://hackage.haskell.org")) + (define (hackage-source-url name version) "Given a Hackage package NAME and VERSION, return a url to the source tarball." - (string-append "https://hackage.haskell.org/package/" name - "/" name "-" version ".tar.gz")) + (string-append (%hackage-url) "/package/" + name "/" name "-" version ".tar.gz")) (define* (hackage-cabal-url name #:optional version) "Given a Hackage package NAME and VERSION, return a url to the corresponding .cabal file on Hackage. If VERSION is #f or missing, the url for the latest version is returned." (if version - (string-append "https://hackage.haskell.org/package/" + (string-append (%hackage-url) "/package/" name "-" version "/" name ".cabal") - (string-append "https://hackage.haskell.org/package/" + (string-append (%hackage-url) "/package/" name "/" name ".cabal"))) (define (hackage-name->package-name name) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index 93cf214127..77cc6350cb 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -30,7 +30,8 @@ #:use-module (guix memoization) #:use-module (guix packages) #:use-module (guix upstream) - #:export (stackage->guix-package + #:export (%stackage-url + stackage->guix-package stackage-recursive-import %stackage-updater)) @@ -39,7 +40,8 @@ ;;; Stackage info fetcher and access functions ;;; -(define %stackage-url "https://www.stackage.org") +(define %stackage-url + (make-parameter "https://www.stackage.org")) ;; Latest LTS version compatible with GHC 8.6.5. (define %default-lts-version "14.27") @@ -55,7 +57,7 @@ ;; "Retrieve the information about the LTS Stackage release VERSION." (memoize (lambda* (#:optional (version "")) - (let* ((url (string-append %stackage-url + (let* ((url (string-append (%stackage-url) "/lts-" (if (string-null? version) %default-lts-version version))) diff --git a/guix/lint.scm b/guix/lint.scm index 91dbc806dc..be6bb4eb01 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -10,6 +10,7 @@ ;;; Copyright © 2017, 2018, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2020 Chris Marusich <cmmarusich@gmail.com> +;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,6 +36,8 @@ #:use-module (guix http-client) #:use-module (guix packages) #:use-module (guix i18n) + #:use-module ((guix gexp) + #:select (local-file? local-file-absolute-file-name)) #:use-module (guix licenses) #:use-module (guix records) #:use-module (guix grafts) @@ -50,6 +53,7 @@ #:use-module ((guix swh) #:hide (origin?)) #:autoload (guix git-download) (git-reference? git-reference-url git-reference-commit) + #:use-module (guix import stackage) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 format) @@ -73,6 +77,7 @@ check-inputs-should-be-native check-inputs-should-not-be-an-input-at-all check-patch-file-names + check-patch-headers check-synopsis-style check-derivation check-home-page @@ -87,6 +92,7 @@ check-formatting check-archival check-profile-collisions + check-haskell-stackage lint-warning lint-warning? @@ -712,6 +718,54 @@ patch could not be found." (_ #f)) patches))))) +(define (check-patch-headers package) + "Check that PACKAGE's patches start with a comment. Return a list of +warnings." + (define (blank? str) + (string-every char-set:blank str)) + + (define (patch-header-warnings patch) + (call-with-input-file patch + (lambda (port) + ;; Read from PORT until a non-blank line is found or EOF is reached. + (let loop () + (let ((line (read-line port))) + (cond ((eof-object? line) + (list (make-warning package + (G_ "~a: empty patch") + (list (basename patch)) + #:field 'source))) + ((blank? line) + (loop)) + ((or (string-prefix? "--- " line) + (string-prefix? "+++ " line)) + (list (make-warning package + (G_ "~a: patch lacks comment and \ +upstream status") + (list (basename patch)) + #:field 'source))) + (else + '()))))))) + + (guard (c ((formatted-message? c) ;raised by 'search-patch' + (list (%make-warning package + (formatted-message-string c) + (formatted-message-arguments c) + #:field 'source)))) + (let ((patches (if (origin? (package-source package)) + (origin-patches (package-source package)) + '()))) + (append-map (lambda (patch) + ;; Dismiss PATCH if it's an origin or similar. + (cond ((string? patch) + (patch-header-warnings patch)) + ((local-file? patch) + (patch-header-warnings + (local-file-absolute-file-name patch))) + (else + '()))) + patches)))) + (define (escape-quotes str) "Replace any quote character in STR by an escaped quote character." (list->string @@ -1234,6 +1288,25 @@ Heritage") '() (apply throw key args)))))))) +(define (check-haskell-stackage package) + "Check whether PACKAGE is a Haskell package ahead of the current +Stackage LTS version." + (match (with-networking-fail-safe + (format #f (G_ "while retrieving upstream info for '~a'") + (package-name package)) + #f + (package-latest-release package (list %stackage-updater))) + ((? upstream-source? source) + (if (version>? (package-version package) + (upstream-source-version source)) + (list + (make-warning package + (G_ "ahead of Stackage LTS version ~a") + (list (upstream-source-version source)) + #:field 'version)) + '())) + (#f '()))) + ;;; ;;; Source code formatting. @@ -1418,6 +1491,10 @@ or a list thereof") (description "Validate file names and availability of patches") (check check-patch-file-names)) (lint-checker + (name 'patch-headers) + (description "Validate patch headers") + (check check-patch-headers)) + (lint-checker (name 'formatting) (description "Look for formatting issues in the source") (check check-formatting)))) @@ -1456,7 +1533,11 @@ or a list thereof") (lint-checker (name 'archival) (description "Ensure source code archival on Software Heritage") - (check check-archival)))) + (check check-archival)) + (lint-checker + (name 'haskell-stackage) + (description "Ensure Haskell packages use Stackage LTS versions") + (check check-haskell-stackage)))) (define %all-checkers (append %local-checkers diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index cc020632af..a959cb827d 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -182,8 +182,6 @@ options handled by 'set-build-options-from-command-line', and listed in (display (G_ " -M, --max-jobs=N allow at most N build jobs")) (display (G_ " - --help-transform list package transformation options not shown here")) - (display (G_ " --debug=LEVEL produce debugging output at LEVEL"))) (define (set-build-options-from-command-line store opts) @@ -319,14 +317,7 @@ use '--no-offload' instead~%"))) (if c (apply values (alist-cons 'max-jobs c result) rest) (leave (G_ "not a number: '~a' option argument: ~a~%") - name arg))))) - (option '("help-transform") #f #f - (lambda _ - (format #t - (G_ "Available package transformation options:~%")) - (show-transformation-options-help) - (newline) - (exit 0))))) + name arg))))))) ;;; @@ -383,6 +374,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (newline) (show-build-options-help) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 2328df98b8..e435bf0ce4 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -180,6 +180,8 @@ COMMAND or an interactive shell in that environment.\n")) (newline) (show-build-options-help) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 6874904deb..ddfc6ba497 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -35,7 +35,8 @@ #:use-module ((guix diagnostics) #:select (location-file formatted-message)) #:use-module ((guix transformations) - #:select (options->transformation + #:select (show-transformation-options-help + options->transformation %transformation-options)) #:use-module ((guix scripts build) #:select (%standard-build-options)) @@ -546,6 +547,8 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (display (G_ " -L, --load-path=DIR prepend DIR to the package module search path")) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " diff --git a/guix/scripts/install.scm b/guix/scripts/install.scm index 82f5875dd1..63e625f266 100644 --- a/guix/scripts/install.scm +++ b/guix/scripts/install.scm @@ -39,6 +39,8 @@ This is an alias for 'guix package -i'.\n")) (newline) (show-build-options-help) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 18cd167537..c72dc3caad 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -10,6 +10,7 @@ ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2019, 2020 Simon Tournier <zimon.toutoune@gmail.com> +;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> ;;; ;;; This file is part of GNU Guix. ;;; @@ -47,11 +48,15 @@ ;; provided MESSAGE. (for-each (lambda (lint-warning) - (let ((package (lint-warning-package lint-warning)) - (loc (lint-warning-location lint-warning))) - (info loc (G_ "~a@~a: ~a~%") - (package-name package) (package-version package) - (lint-warning-message lint-warning)))) + (let* ((package (lint-warning-package lint-warning)) + (name (package-name package)) + (version (package-version package)) + (loc (lint-warning-location lint-warning)) + (message (lint-warning-message lint-warning))) + (parameterize + ((guix-warning-port (current-output-port))) + (info loc (G_ "~a@~a: ~a~%") + name version message)))) warnings)) (define* (run-checkers package checkers #:key store) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 0b29997200..ba9a6dc1b2 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -1067,6 +1067,8 @@ last resort for relocation." Create a bundle of PACKAGE.\n")) (show-build-options-help) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -f, --format=FORMAT build a pack in the given FORMAT")) (display (G_ " diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index eb2e67a0de..6faf2adb7a 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -398,6 +398,8 @@ Install, remove, or upgrade packages in a single transaction.\n")) (newline) (show-build-options-help) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index f1a9970a7f..2a2185e2b9 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -63,10 +63,14 @@ #:use-module ((guix build utils) #:select (dump-port mkdir-p find-files)) #:use-module ((guix build syscalls) #:select (set-thread-name)) - #:export (%public-key + #:export (%default-gzip-compression + + %public-key %private-key signed-string + open-server-socket + run-publish-server guix-publish)) (define (show-help) diff --git a/guix/scripts/upgrade.scm b/guix/scripts/upgrade.scm index 1ee8937acf..dcbcb2ab09 100644 --- a/guix/scripts/upgrade.scm +++ b/guix/scripts/upgrade.scm @@ -42,6 +42,8 @@ This is an alias for 'guix package -u'.\n")) (newline) (show-build-options-help) (newline) + (show-transformation-options-help) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " diff --git a/guix/store.scm b/guix/store.scm index d859ea33ed..11e2dae579 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -113,6 +113,7 @@ build query-failed-paths clear-failed-paths + ensure-path add-temp-root add-indirect-root add-permanent-root @@ -1397,6 +1398,11 @@ When a handler is installed with 'with-build-handler', it is called any time (message "unsupported build mode") (status 1)))))))))))) +(define-operation (ensure-path (store-path path)) + "Make PATH a temporary root for the duration of the current session. +Return #t." + boolean) + (define-operation (add-temp-root (store-path path)) "Make PATH a temporary root for the duration of the current session. Return #t." diff --git a/guix/transformations.scm b/guix/transformations.scm index 30142dd059..d49041cf59 100644 --- a/guix/transformations.scm +++ b/guix/transformations.scm @@ -508,9 +508,17 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field." (option '("with-debug-info") #t #f (parser 'with-debug-info)) (option '("without-tests") #t #f - (parser 'without-tests))))) + (parser 'without-tests)) -(define (show-transformation-options-help) + (option '("help-transform") #f #f + (lambda _ + (format #t + (G_ "Available package transformation options:~%")) + (show-transformation-options-help/detailed) + (newline) + (exit 0)))))) + +(define (show-transformation-options-help/detailed) (display (G_ " --with-source=[PACKAGE=]SOURCE use SOURCE when building the corresponding package")) @@ -539,6 +547,10 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field." --without-tests=PACKAGE build PACKAGE without running its tests"))) +(define (show-transformation-options-help) + "Show basic help for package transformation options." + (display (G_ " + --help-transform list package transformation options not shown here"))) (define (options->transformation opts) "Return a procedure that, when passed an object to build (package, |