Re: Graft hooks

[Timothy Sample <samplet@ngyro.com>]

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

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

> Hello Timothy,
>
> Timothy Sample <samplet@ngyro.com> skribis:
>
>> The basic idea would be to add a field (or use a property) to the
>> package record.  Let’s call it “graft-hook”.  It would be Scheme code
>> that gets run after grafting takes place, giving us a chance to patch
>> special things like checksums.  The hook would be passed the list of
>> files that were been modified during grafting.  Then, in the Racket
>> package for example, I could write a graft-hook that updates the SHA-1
>> hash of each of the modified source files.
>>
>> Since grafting is done at the derivation level, the hook code would have
>> to be propagated down from the package level.  I haven’t looked at all
>> the details yet, because maybe this is a bad idea and I shouldn’t waste
>> my time!  :)  My first impression is that it is not too tricky.
>>
>> Are these problems too specialized to deserve a general mechanism like
>> this?  Let me know what you think!
>
> I agree that this would be the right thing to do!  (I’d really like to
> do it for GDB as discussed in <https://bugs.gnu.org/19973>.)
>
> Package properties would be the right way to make it extensible, but
> there are complications (notably we’d need to use gexps, but build
> systems don’t use gexps yet.)

But soon, right?  ;)

> So as a first step, would like to try and implement the checksum update
> for Racket directly in (guix build grafts)?  The implementation would
> need to be clearly separate from the generic grafting code (like profile
> hooks in (guix profiles)) such that we can easily add similar hooks and
> move them to a separate file later.
>
> WDYT?

I just looked at (guix profiles) and it was a good jumping-off point.
Thanks for the hint!

Here’s a draft patch (it’s mercifully small).  I have a few questions
about it, but if it looks like the right approach, I will clean it up
and submit it.

Basically, it checks if we are grafting Racket, and then adds some code
to the build expression to run the hook.

This approach works well for Racket, and it has the benefit of not
changing the graft build expression except when necessary, which
prevents spurious rebuilds.  I don’t know how well it generalizes,
though.  For GDB, we might be able use a heuristic like whether there is
a “debug” output.  For Go, it gets tricky because we would have to check
if Go was used to build part of the output (I guess we could check the
dependency graph, but that sounds like it could be slow).  Similarly, if
we ever have a “racket-build-system”, we will need the same thing for
Racket.  Maybe these are problems for the future, since they are much
easier to solve if we can have graft hooks at the package or
build-system level.

Also, is there a preference for patching the files using Guile or using
an external tool?  This patch uses Racket’s “raco setup” command to
recompile the files and fix the checksums.  Unfortunately, it also
updates timestamps.  I’m pretty sure our Racket package is not
reproducible at the moment, so I didn’t worry about it too much.  The
timestamps could be patched out, though.  The reason I shied away from
writing my own code is that Racket also hashes all the dependencies for
a bytecode file.  This means that the custom code would have to traverse
the Racket dependency graph to get the checksums right.  It is not too
hard to do so, but it would be a couple hundred lines of code (compared
to the five or so it took to invoke “raco setup”).


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

diff --git a/guix/grafts.scm b/guix/grafts.scm
index d6b0e93e8..88a99312d 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -75,6 +75,36 @@
     (($ <graft> (? string? item))
      item)))
 
+(define (fix-racket-checksums store drv system)
+  (define racket-drv
+    (let ((package-derivation (module-ref (resolve-interface '(guix packages))
+                                          'package-derivation))
+          (racket (module-ref (resolve-interface '(gnu packages scheme))
+                              'racket)))
+      (package-derivation store racket system #:graft? #f)))
+
+  (define hook-exp
+    `(lambda (input output mapping)
+       (let ((raco (string-append output "/bin/raco")))
+         ;; Setting PLT_COMPILED_FILE_CHECK to "exists" tells Racket to
+         ;; ignore timestamps when checking if a compiled file is valid.
+         ;; Without it, Racket attempts a complete rebuild of
+         ;; everything.
+         (setenv "PLT_COMPILED_FILE_CHECK" "exists")
+         ;; All of the --no-* flags below keep Racket from making
+         ;; unecessary and unhelpful changes (like rewriting scripts and
+         ;; reverting their shebangs in the process).
+         (invoke raco "setup" "--no-launcher" "--no-install"
+                 "--no-post-install" "--no-info-domain" "--no-docs"))))
+
+  (if (string=? (derivation-file-name drv)
+                (derivation-file-name racket-drv))
+      hook-exp
+      #f))
+
+(define %graft-hooks
+  (list fix-racket-checksums))
+
 (define* (graft-derivation/shallow store drv grafts
                                    #:key
                                    (name (derivation-name drv))
@@ -104,6 +134,11 @@ are not recursively applied to dependencies of DRV."
                   (assoc-ref (derivation-outputs drv) output))))
          outputs))
 
+  (define hook-exps
+    (filter-map (lambda (hook)
+                  (hook store drv system))
+                %graft-hooks))
+
   (define build
     `(begin
        (use-modules (guix build graft)
@@ -120,7 +155,10 @@ are not recursively applied to dependencies of DRV."
          (for-each (lambda (input output)
                      (format #t "grafting '~a' -> '~a'...~%" input output)
                      (force-output)
-                     (rewrite-directory input output mapping))
+                     (rewrite-directory input output mapping)
+                     ,@(map (lambda (exp)
+                              `(,exp input output mapping))
+                            hook-exps))
                    (match old-outputs
                      (((names . files) ...)
                       files))

[-- Attachment #3: Type: text/plain, Size: 27 bytes --]



> Thanks,
> Ludo’.