bug#50597: different fixed-output when using ’--with-source’ transformation

[zimoun <zimon.toutoune@gmail.com>]

Hi,

On Wed, 22 Sep 2021 at 12:25, Ludovic Courtès <ludo@gnu.org> wrote:

> However it’s not enough to get the same derivation: we’d also need
> <downloaded-file> to return a fixed-output derivation rather than a
> plain store file name.  (See also
> <https://issues.guix.gnu.org/49696>.)

Thanks for the explanations and the pointer.  Indeed, to be continued…


> diff --git a/guix/transformations.scm b/guix/transformations.scm
> index 5ae1977cb2..e0f5579c28 100644
> --- a/guix/transformations.scm
> +++ b/guix/transformations.scm
> @@ -46,6 +46,7 @@
>    #:use-module (srfi srfi-37)
>    #:use-module (ice-9 match)
>    #:use-module (ice-9 vlist)
> +  #:autoload   (web uri) (string->uri uri-scheme uri-path)
>    #:export (options->transformation
>              manifest-entry-with-transformations
>  
> @@ -106,15 +107,25 @@ extensions."
>  (define* (package-with-source p uri #:optional version)
>    "Return a package based on P but with its source taken from URI.  Extract
>  the new package's version number from URI."
> -  (let ((base (tarball-base-name (basename uri))))
> +  (let ((base (tarball-base-name (basename uri)))
> +        (file (match (string->uri uri)
> +                (#f uri)
> +                (uri (and (eq? 'file (uri-scheme uri))
> +                          (uri-path uri))))))
>      (let-values (((_ version*)
>                    (hyphen-package-name->name+version base)))
>        (package (inherit p)
>                 (version (or version version*
>                              (package-version p)))
>  
> -               ;; Use #:recursive? #t to allow for directories.
> -               (source (downloaded-file uri #t))))))
> +               ;; Default to #:recursive? #f to match what 'url-fetch' does,
> +               ;; but use #t when URI denotes a directory.
> +               (source (let ((recursive?
> +                              (and file
> +                                   (match (stat file #f)
> +                                     (#f #t)
> +                                     (st (eq? 'directory (stat:type st)))))))
> +                         (downloaded-file uri recursive?)))))))

LGTM!

Cheers,
simon