diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build/graft.scm | 22 | ||||
| -rw-r--r-- | guix/graph.scm | 16 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 42 |
3 files changed, 39 insertions, 41 deletions
diff --git a/guix/build/graft.scm b/guix/build/graft.scm index 16df169ec7..3dce486adf 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -164,15 +164,19 @@ bytevectors to the same value." ;; not to unget bytes that have already been written, because ;; that would cause them to be written again from the next ;; buffer. In practice, this case occurs when a replacement is - ;; made near the end of the buffer. - (let* ((unwritten (- end written)) - (unget-size (if (= end request-size) - (min hash-length unwritten) - 0)) - (write-size (- unwritten unget-size))) - (put-bytevector output buffer written write-size) - (unget-bytevector input buffer (+ written write-size) - unget-size) + ;; made near or beyond the end of the buffer. When REPLACEMENT + ;; went beyond END, we consume the extra bytes from INPUT. + (begin + (if (> written end) + (get-bytevector-n! input buffer 0 (- written end)) + (let* ((unwritten (- end written)) + (unget-size (if (= end request-size) + (min hash-length unwritten) + 0)) + (write-size (- unwritten unget-size))) + (put-bytevector output buffer written write-size) + (unget-bytevector input buffer (+ written write-size) + unget-size))) (loop))))))))) (define (rename-matching-files directory mapping) diff --git a/guix/graph.scm b/guix/graph.scm index 5b650f5448..d7fd5f3e4b 100644 --- a/guix/graph.scm +++ b/guix/graph.scm @@ -1,7 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> -;;; Copyright © 2017 Roel Janssen <roel@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,7 +22,6 @@ #:use-module (guix monads) #:use-module (guix records) #:use-module (guix sets) - #:use-module (guix packages) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -172,9 +170,9 @@ typically returned by 'node-edges' or 'node-back-edges'." name)) (define (emit-epilogue port) (display "\n}\n" port)) -(define (emit-node id node port) +(define (emit-node id label port) (format port " \"~a\" [label = \"~a\", shape = box, fontname = Helvetica];~%" - id (package-full-name node))) + id label)) (define (emit-edge id1 id2 port) (format port " \"~a\" -> \"~a\" [color = ~a];~%" id1 id2 (pop-color id1))) @@ -215,11 +213,11 @@ var nodes = {}, (format port "</script><script type=\"text/javascript\" src=\"~a\"></script></body></html>" (search-path %load-path "graph.js"))) -(define (emit-d3js-node id node port) +(define (emit-d3js-node id label port) (format port "\ nodes[\"~a\"] = {\"id\": \"~a\", \"label\": \"~a\", \"index\": nodeArray.length}; nodeArray.push(nodes[\"~a\"]);~%" - id id (package-full-name node) id)) + id id label id)) (define (emit-d3js-edge id1 id2 port) (format port "links.push({\"source\": \"~a\", \"target\": \"~a\"});~%" @@ -243,9 +241,9 @@ nodeArray.push(nodes[\"~a\"]);~%" (define (emit-cypher-epilogue port) (format port "")) -(define (emit-cypher-node id node port) +(define (emit-cypher-node id label port) (format port "MERGE (p:Package { id: ~s }) SET p.name = ~s;~%" - id (package-name node))) + id label )) (define (emit-cypher-edge id1 id2 port) (format port "MERGE (a:Package { id: ~s });~%" id1) @@ -298,7 +296,7 @@ true, draw reverse arrows." (ids (mapm %store-monad node-identifier dependencies))) - (emit-node id head port) + (emit-node id (node-label head) port) (for-each (lambda (dependency dependency-id) (if reverse-edges? (emit-edge dependency-id id port) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 5a2811e75b..8793c40925 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -150,7 +150,7 @@ TARGET, and register them." (define* (install-bootloader installer-drv #:key bootcfg bootcfg-file - device target) + target) "Call INSTALLER-DRV with error handling, in %STORE-MONAD." (with-monad %store-monad (let* ((gc-root (string-append target %gc-roots-directory @@ -169,7 +169,7 @@ TARGET, and register them." (when install (save-load-path-excursion (primitive-load install))))) (delete-file temp-gc-root) - (leave (G_ "failed to install bootloader on device ~a '~a'~%") install device)) + (leave (G_ "failed to install bootloader ~a~%") install)) ;; Register bootloader config file as a GC root so that its dependencies ;; (background image, font, etc.) are not reclaimed. @@ -179,13 +179,12 @@ TARGET, and register them." (define* (install os-drv target #:key (log-port (current-output-port)) bootloader-installer install-bootloader? - bootcfg bootcfg-file - device) + bootcfg bootcfg-file) "Copy the closure of BOOTCFG, which includes the output of OS-DRV, to directory TARGET. TARGET must be an absolute directory name since that's what 'guix-register' expects. -When INSTALL-BOOTLOADER? is true, install bootloader on DEVICE, using BOOTCFG." +When INSTALL-BOOTLOADER? is true, install bootloader using BOOTCFG." (define (maybe-copy to-copy) (with-monad %store-monad (if (string=? target "/") @@ -227,7 +226,6 @@ the ownership of '~a' may be incorrect!~%") (install-bootloader bootloader-installer #:bootcfg bootcfg #:bootcfg-file bootcfg-file - #:device device #:target target))))) @@ -457,12 +455,11 @@ STORE is an open connection to the store." (mbegin %store-monad (show-what-to-build* drvs) (built-derivations drvs) - ;; Only install bootloader configuration file. Thus, no installer - ;; nor device is provided here. + ;; Only install bootloader configuration file. Thus, no installer is + ;; provided here. (install-bootloader #f #:bootcfg bootcfg #:bootcfg-file bootcfg-file - #:device #f #:target target)))))) @@ -615,17 +612,16 @@ and TARGET arguments." (define* (perform-action action os #:key install-bootloader? dry-run? derivations-only? - use-substitutes? device target + use-substitutes? bootloader-target target image-size file-system-type full-boot? (mappings '()) (gc-root #f)) "Perform ACTION for OS. INSTALL-BOOTLOADER? specifies whether to install -bootloader; DEVICE is the target devices for bootloader; TARGET is the target -root directory; IMAGE-SIZE is the size of the image to be built, for the -'vm-image' and 'disk-image' actions. -The root filesystem is created as a FILE-SYSTEM-TYPE filesystem. -FULL-BOOT? is used for the 'vm' action; -it determines whether to boot directly to the kernel or to the bootloader. +bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the +target root directory; IMAGE-SIZE is the size of the image to be built, for +the 'vm-image' and 'disk-image' actions. The root filesystem is created as a +FILE-SYSTEM-TYPE filesystem. FULL-BOOT? is used for the 'vm' action; it +determines whether to boot directly to the kernel or to the bootloader. When DERIVATIONS-ONLY? is true, print the derivation file name(s) without building anything. @@ -665,7 +661,7 @@ output when building a system derivation, such as a disk image." (target (or target "/"))) (bootloader-installer-derivation installer bootloader-package - device target))) + bootloader-target target))) ;; For 'init' and 'reconfigure', always build BOOTCFG, even if ;; --no-bootloader is passed, because we then use it as a GC root. @@ -697,7 +693,6 @@ output when building a system derivation, such as a disk image." (install-bootloader bootloader-installer #:bootcfg bootcfg #:bootcfg-file bootcfg-file - #:device device #:target "/")))) ((init) (newline) @@ -707,8 +702,7 @@ output when building a system derivation, such as a disk image." #:install-bootloader? install-bootloader? #:bootcfg bootcfg #:bootcfg-file bootcfg-file - #:bootloader-installer bootloader-installer - #:device device)) + #:bootloader-installer bootloader-installer)) (else ;; All we had to do was to build SYS and maybe register an ;; indirect GC root. @@ -900,8 +894,9 @@ resulting from command-line parsing." (target (match args ((first second) second) (_ #f))) - (device (and bootloader? - (bootloader-configuration-device + (bootloader-target + (and bootloader? + (bootloader-configuration-target (operating-system-bootloader os))))) (with-store store @@ -934,7 +929,8 @@ resulting from command-line parsing." (_ #f)) opts) #:install-bootloader? bootloader? - #:target target #:device device + #:target target + #:bootloader-target bootloader-target #:gc-root (assoc-ref opts 'gc-root))))) #:system system)))) |