Grafts

Grafts

[Ludovic Courtès]

[-- Attachment #1.1: Type: text/plain, Size: 938 bytes --]

Hello,

I pushed ‘wip-grafts’, a branch that implements “grafts.”

Normally security updates deep in the DAG, such as an update of Bash or
libc, cause a rebuild of everything, which can some time, as we’ve seen
lately.

The idea of grafts is to graft the fixed package on any packages users
may want to install.  So, suppose there’s a libc fix; when installing
IceCat, you’ll just be starting from the (pre-built) IceCat, and an
additional derivation will patch the files in it to replace references
to the old libc with references to the fixed libc (in practice this only
works if the file name of the old and fixed libc have the same length.)

‘wip-grafts’ adds a ‘graft’ field to package records.  In the example
above, we’d just add a ‘graft’ field to glibc, pointing to the fixed
glibc, and the graft would just be automagically applied.  The branch
has an example of that with Bash:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: Type: text/x-patch, Size: 910 bytes --]

--- a/gnu/packages/bash.scm
+++ b/gnu/packages/bash.scm
@@ -185,7 +185,13 @@ allows command-line editing, unlimited command history, shell functions and
 aliases, and job control while still allowing most sh scripts to be run
 without modification.")
      (license gpl3+)
-     (home-page "http://www.gnu.org/software/bash/"))))
+     (home-page "http://www.gnu.org/software/bash/")
+     (graft bash-fixed))))
+
+(define bash-fixed                                ;FIXME: Use something real.
+  (package (inherit bash)
+    (version "4.3.42")
+    (graft #f)))
 
 (define-public bash-light
   ;; A stripped-down Bash for non-interactive use.
@@ -210,4 +216,5 @@ without modification.")
 
                  ,@(if (%current-target-system)
                        '("bash_cv_job_control_missing=no")
-                       '()))))))))
+                       '()))))))
+    (graft #f)))

[-- Attachment #1.3: Type: text/plain, Size: 523 bytes --]


The implementation looks for ‘graft’ fields in all the transitive inputs
of the package being built.

Currently it works but needs more testing and documentation.  There are
also performance issues that need to be worked out.

Comments welcome!

The general idea was implemented by Shea Levy in Nixpkgs¹, and also
suggested by Mark Weaver on IRC, who helped refine how things should
work in Guix–thanks!

Ludo’.

¹ https://github.com/NixOS/nixpkgs/commit/d1662d715514e6ef9d3dc29f132f1b3d8e608a18

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 818 bytes --]

Re: Grafts

[Mark H Weaver]

ludo@gnu.org (Ludovic Courtès) writes:

> I pushed ‘wip-grafts’, a branch that implements “grafts.”
>
> Normally security updates deep in the DAG, such as an update of Bash or
> libc, cause a rebuild of everything, which can some time, as we’ve seen
> lately.
>
> The idea of grafts is to graft the fixed package on any packages users
> may want to install.  So, suppose there’s a libc fix; when installing
> IceCat, you’ll just be starting from the (pre-built) IceCat, and an
> additional derivation will patch the files in it to replace references
> to the old libc with references to the fixed libc (in practice this only
> works if the file name of the old and fixed libc have the same length.)

Thanks for working on this!  I think it will be quite important.

> ‘wip-grafts’ adds a ‘graft’ field to package records.  In the example
> above, we’d just add a ‘graft’ field to glibc, pointing to the fixed
> glibc, and the graft would just be automagically applied.  The branch
> has an example of that with Bash:
>
> --- a/gnu/packages/bash.scm
> +++ b/gnu/packages/bash.scm
> @@ -185,7 +185,13 @@ allows command-line editing, unlimited command history, shell functions and
>  aliases, and job control while still allowing most sh scripts to be run
>  without modification.")
>       (license gpl3+)
> -     (home-page "http://www.gnu.org/software/bash/"))))
> +     (home-page "http://www.gnu.org/software/bash/")
> +     (graft bash-fixed))))
> +
> +(define bash-fixed                                ;FIXME: Use something real.
> +  (package (inherit bash)
> +    (version "4.3.42")
> +    (graft #f)))

If you want a real example, upstream bash is at 4.3.30, whereas we only
have 4.3.27.

    Thanks!
      Mark

Re: Grafts

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> If you want a real example, upstream bash is at 4.3.30, whereas we only
> have 4.3.27.

Yes, I have it in my working tree, and will push shortly.  :-)

Ludo’.

Re: Grafts

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 794 bytes --]

The current status of ‘wip-grafts’ is that it works, there’s no
performance issue, etc.

However, the ‘graft-derivation’ procedure is not recursive: it grafts
the derivation you give it, but doesn’t graft its dependencies.  Thus,
only direct references are grafted, which isn’t so great:

  $ guix gc -R $(guix build glib) | grep bash
  /gnu/store/8fmgslrivicy54azysmaab3z1srid773-bash-4.3.27  <--+--- the ungrafted bash
  /gnu/store/3yiqz9wmwx6b7hpbapg5q39sjx33kh0j-bash-4.3.27  <--’
  /gnu/store/yl1rp2b8i2qwgxja3d09xc24ffk9sjmr-bash-4.3.27  <------ the grafted bash

Changing ‘graft-derivation’ to work recursively and perform well is a
bit challenging.

I’m posting the naive patch I have here, in case someone can look at it
before me.

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 5631 bytes --]

	Modified   guix/derivations.scm
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 17c83e9..632bf8e 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1007,40 +1009,51 @@ applied."
                      target))))
          grafts))
 
-  (define outputs
-    (match (derivation-outputs drv)
-      (((names . outputs) ...)
-       (map derivation-output-path outputs))))
-
-  (define output-names
-    (match (derivation-outputs drv)
-      (((names . outputs) ...)
-       names)))
-
-  (define build
-    `(begin
-       (use-modules (guix build graft)
-                    (guix build utils)
-                    (ice-9 match))
-
-       (let ((mapping ',mapping))
-         (for-each (lambda (input output)
-                     (format #t "rewriting '~a' to '~a'...~%" input output)
-                     (rewrite-directory input output
-                                        `((,input . ,output)
-                                          ,@mapping)))
-                   ',outputs
-                   (match %outputs
-                     (((names . files) ...)
-                      files))))))
+  (define input-mapping
+    (match-lambda
+     (($ <derivation-input> path sub-drv)
+      (let ((orig (call-with-input-file path read-derivation)))
+        (cons orig
+              (graft-derivation store (derivation-name orig) orig grafts
+                                #:guile guile
+                                #:system system))))))
 
   (define add-label
     (cut cons "x" <>))
 
   (match grafts
     ((($ <graft> sources source-outputs targets target-outputs) ...)
-     (let ((sources (zip sources source-outputs))
-           (targets (zip targets target-outputs)))
+     (let* ((sources (zip sources source-outputs))
+            (targets (zip targets target-outputs))
+            (inputs  (map input-mapping (derivation-inputs drv)))
+            (drv     (pk 'm (map-derivation store drv inputs))))
+       (define outputs
+         (match (derivation-outputs drv)
+           (((names . outputs) ...)
+            (map derivation-output-path outputs))))
+
+       (define output-names
+         (match (derivation-outputs drv)
+           (((names . outputs) ...)
+            names)))
+
+       (define build
+         `(begin
+            (use-modules (guix build graft)
+                         (guix build utils)
+                         (ice-9 match))
+
+            (let ((mapping ',mapping))
+              (for-each (lambda (input output)
+                          (format #t "rewriting '~a' to '~a'...~%" input output)
+                          (rewrite-directory input output
+                                             `((,input . ,output)
+                                               ,@mapping)))
+                        ',outputs
+                        (match %outputs
+                          (((names . files) ...)
+                           files))))))
+
        (build-expression->derivation store name build
                                      #:system system
                                      #:guile-for-build guile
	Modified   tests/derivations.scm
diff --git a/tests/derivations.scm b/tests/derivations.scm
index a69114a..608a7f6 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -851,6 +851,42 @@ Deriver: ~a~%"
                 (string=? (readlink (string-append graft "/sh")) one)
                 (string=? (readlink (string-append graft "/self")) graft))))))
 
+(test-assert "graft-derivation, recursive"
+  (let* ((build `(begin
+                   (mkdir %output)
+                   (chdir %output)
+                   (call-with-output-file "text"
+                     (lambda (output)
+                       (format output "foo/~a/bar" ,%mkdir)))
+                   (symlink ,%bash "sh")))
+         (dep   (build-expression->derivation %store "dep" build
+                                              #:inputs `(("a" ,%bash)
+                                                         ("b" ,%mkdir))))
+         (orig  (build-expression->derivation %store "graft"
+                                              `(symlink
+                                                (assoc-ref %build-inputs "dep")
+                                                %output)
+                                              #:inputs `(("dep" ,dep))))
+         (one   (add-text-to-store %store "bash" "fake bash"))
+         (two   (build-expression->derivation %store "mkdir"
+                                              '(call-with-output-file %output
+                                                 (lambda (port)
+                                                   (display "fake mkdir" port)))))
+         (graft (graft-derivation %store "graft" orig
+                                  (list (graft
+                                          (origin %bash)
+                                          (replacement one))
+                                        (graft
+                                          (origin %mkdir)
+                                          (replacement two))))))
+    (and (build-derivations %store (list graft))
+         (let ((two   (derivation->output-path two))
+               (graft (derivation->output-path graft)))
+           (and (string=? (format #f "foo/~a/bar" two)
+                          (call-with-input-file (string-append graft "/text")
+                            get-string-all))
+                (string=? (readlink (string-append graft "/sh")) one))))))
+
 (test-equal "map-derivation"
   "hello"
   (let* ((joke (package-derivation %store guile-1.8))

Re: Grafts

[Ludovic Courtès]

I went ahead and merged the guts of ‘wip-grafts’.  This changes the ABI,
so make sure to run:

  make clean-go && make

> However, the ‘graft-derivation’ procedure is not recursive: it grafts
> the derivation you give it, but doesn’t graft its dependencies.

This problem is not addressed yet, but I decided to postpone it,
probably until after 0.8 (I have the beginnings of a fix, but nothing
baked yet), so we can move forward.

To summarize, we can already use grafts, via the ‘replacement’ field of
a package, but there are some cases where it will not do exactly what we
want.  Please send a message if you want to use it and are unsure.

Ludo’.