diff options
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/go-build-system.scm | 7 | ||||
-rw-r--r-- | guix/docker.scm | 2 | ||||
-rw-r--r-- | guix/import/github.scm | 57 | ||||
-rw-r--r-- | guix/scripts/system.scm | 18 |
4 files changed, 56 insertions, 28 deletions
diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index 022d4fe16b..4b026eebd6 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -130,7 +130,8 @@ unset. When SOURCE is a directory, copy it instead of unpacking." (define* (install-source #:key install-source? outputs #:allow-other-keys) "Install the source code to the output directory." - (let* ((out (assoc-ref outputs "out")) + (let* ((out (or (assoc-ref outputs "lib") + (assoc-ref outputs "out"))) (source "src") (dest (string-append out "/" source))) (when install-source? @@ -208,7 +209,9 @@ on $GOBIN in the build phase." ;; https://lists.gnu.org/archive/html/guix-devel/2018-11/msg00208.html). ;; Remove it? (when (file-exists? "pkg") - (copy-recursively "pkg" (string-append (assoc-ref outputs "out") "/pkg"))) + (copy-recursively "pkg" (string-append (or (assoc-ref outputs "lib") + (assoc-ref outputs "out")) + "/pkg"))) #t) (define* (remove-store-reference file file-name diff --git a/guix/docker.scm b/guix/docker.scm index c6e9c6fee5..0f917f08bc 100644 --- a/guix/docker.scm +++ b/guix/docker.scm @@ -197,9 +197,11 @@ SRFI-19 time-utc object, as the creation time in metadata." ;; Initialize /var/guix, assuming PREFIX points to a profile. (install-database-and-gc-roots "." database prefix)) + (mkdir-p "gnu/store") (apply invoke "tar" "-cf" "layer.tar" `(,@transformation-options ,@%tar-determinism-options + "gnu" ,@paths ,@(if database '("var") '()) ,@(map symlink-source symlinks))) diff --git a/guix/import/github.scm b/guix/import/github.scm index af9f56e1dc..ef3b21ad6c 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -163,7 +163,19 @@ empty list." "Return a string of the newest released version name given a string URL like 'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of the package e.g. 'bedtools2'. Return #f if there is no releases" - (let* ((json (fetch-releases-or-tags url))) + (let* ((token (%github-token)) + (releases-api-url (string-append + "https://api.github.com/repos/" + (github-user-slash-repository url) + "/releases")) + (tags-api-url (string-append + "https://api.github.com/repos/" + (github-user-slash-repository url) + "/tags")) + (json (json-fetch + (if token + (string-append tags-api-url "?access_token=" token) + tags-api-url)))) (if (eq? json #f) (if (%github-token) (error "Error downloading release information through the GitHub @@ -172,21 +184,26 @@ API when using a GitHub token") API. This may be fixed by using an access token and setting the environment variable GUIX_GITHUB_TOKEN, for instance one procured from https://github.com/settings/tokens")) - (let loop ((releases - (filter - (lambda (x) - ;; example pre-release: - ;; https://github.com/wwood/OrfM/releases/tag/v0.5.1 - ;; or an all-prerelease set - ;; https://github.com/powertab/powertabeditor/releases - (not (hash-ref x "prerelease"))) - json))) - (match releases - (() ;empty release list + + (let ((proper-releases + (filter + (lambda (x) + ;; example pre-release: + ;; https://github.com/wwood/OrfM/releases/tag/v0.5.1 + ;; or an all-prerelease set + ;; https://github.com/powertab/powertabeditor/releases + (and (not (hash-ref x "prerelease")) + (string-prefix? "release_" + (or (hash-ref x "tag_name") + (hash-ref x "name"))))) + json))) + (match proper-releases + (() ;empty release list #f) - ((release . rest) ;one or more releases - (let ((tag (or (hash-ref release "tag_name") ;a "release" - (hash-ref release "name"))) ;a tag + + ((release . rest) ;one or more releases + (let ((tag (or (hash-ref release "tag_name") + (hash-ref release "name"))) (name-length (string-length package-name))) ;; some tags include the name of the package e.g. "fdupes-1.51" ;; so remove these @@ -197,15 +214,7 @@ https://github.com/settings/tokens")) ;; some tags start with a "v" e.g. "v0.25.0" ;; where some are just the version number (if (string-prefix? "v" tag) - (substring tag 1) - - ;; Finally, reject tags that don't start with a digit: - ;; they may not represent a release. - (if (and (not (string-null? tag)) - (char-set-contains? char-set:digit - (string-ref tag 0))) - tag - (loop rest))))))))))) + (substring tag 1) tag))))))))) (define (latest-release pkg) "Return an <upstream-source> for the latest release of PKG." diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6cda3ccbd6..2256bd6946 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -753,13 +753,15 @@ checking this by themselves in their 'check' procedure." (define* (system-derivation-for-action os action #:key image-size file-system-type - full-boot? mappings) + full-boot? mappings + container-shared-network?) "Return as a monadic value the derivation for OS according to ACTION." (case action ((build init reconfigure) (operating-system-derivation os)) ((container) - (container-script os #:mappings mappings)) + (container-script os #:mappings mappings + #:container-shared-network? container-shared-network?)) ((vm-image) (system-qemu-image os #:disk-image-size image-size)) ((vm) @@ -814,6 +816,7 @@ and TARGET arguments." dry-run? derivations-only? use-substitutes? bootloader-target target image-size file-system-type full-boot? + container-shared-network? (mappings '()) (gc-root #f)) "Perform ACTION for OS. INSTALL-BOOTLOADER? specifies whether to install @@ -822,6 +825,8 @@ target root directory; IMAGE-SIZE is the size of the image to be built, for the 'vm-image' and 'disk-image' actions. The root file system is created as a FILE-SYSTEM-TYPE file system. FULL-BOOT? is used for the 'vm' action; it determines whether to boot directly to the kernel or to the bootloader. +CONTAINER-SHARED_NETWORK? determines if the container will use a use a +separate network namespace. When DERIVATIONS-ONLY? is true, print the derivation file name(s) without building anything. @@ -871,6 +876,7 @@ static checks." #:file-system-type file-system-type #:image-size image-size #:full-boot? full-boot? + #:container-shared-network? container-shared-network? #:mappings mappings)) ;; For 'init' and 'reconfigure', always build BOOTCFG, even if @@ -1006,6 +1012,8 @@ Some ACTIONS support additional ARGS.\n")) (display (G_ " --share=SPEC for 'vm', share host file system according to SPEC")) (display (G_ " + -N, --network for 'container', allow containers to access the network")) + (display (G_ " -r, --root=FILE for 'vm', 'vm-image', 'disk-image', 'container', and 'build', make FILE a symlink to the result, and register it as a garbage collector root")) @@ -1050,6 +1058,9 @@ Some ACTIONS support additional ARGS.\n")) (lambda (opt name arg result) (alist-cons 'image-size (size->number arg) result))) + (option '(#\N "network") #f #f + (lambda (opt name arg result) + (alist-cons 'container-shared-network? #t result))) (option '("no-bootloader" "no-grub") #f #f (lambda (opt name arg result) (alist-cons 'install-bootloader? #f result))) @@ -1160,6 +1171,9 @@ resulting from command-line parsing." #:file-system-type (assoc-ref opts 'file-system-type) #:image-size (assoc-ref opts 'image-size) #:full-boot? (assoc-ref opts 'full-boot?) + #:container-shared-network? (assoc-ref + opts + 'container-shared-network?) #:mappings (filter-map (match-lambda (('file-system-mapping . m) m) |