ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Add #:allowed-references parameter to 'gexp->derivation'.

Browse source 
* guix/gexp.scm (lower-references): New procedure.
  (gexp->derivation): Add #:allowed-references and honor it.
* tests/gexp.scm ("gexp->derivation #:allowed-references",
  "gexp->derivation #:allowed-references, disallowed"): New tests.
* doc/guix.texi (G-Expressions): Update 'gexp->derivation' doc.
This commit is contained in:
Ludovic Courtès 2015-02-11 22:10:14 +01:00
parent aee6180c10
commit c8351d9a40
3 changed files with 64 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
doc/guix.texi
View file

@ -2583,8 +2583,8 @@ information about monads.)
[#:hash #f] [#:hash-algo #f] @
[#:recursive? #f] [#:env-vars '()] [#:modules '()] @
[#:module-path @var{%load-path}] @
[#:references-graphs #f] [#:local-build? #f] @
[#:guile-for-build #f]
[#:references-graphs #f] [#:allowed-references #f] @
[#:local-build? #f] [#:guile-for-build #f]
Return a derivation @var{name} that runs @var{exp} (a gexp) with
@var{guile-for-build} (a derivation) on @var{system}. When @var{target}
is true, it is used as the cross-compilation target triplet for packages
@ -2612,6 +2612,10 @@ an input of the build process of @var{exp}. In the build environment, each
@var{file-name} contains the reference graph of the corresponding item, in a simple
text format.
@var{allowed-references} must be either @code{#f} or a list of output names and packages.
In the latter case, the list denotes store items that the result is allowed to
refer to. Any reference to another store item will lead to a build error.
The other arguments are as for @code{derivation} (@pxref{Derivations}).
@end deffn

35
guix/gexp.scm
View file

@ -118,6 +118,29 @@ (define* (lower-reference-graphs graphs #:key system target)
#:target target)))
(return (map cons file-names inputs))))))
(define* (lower-references lst #:key system target)
"Based on LST, a list of output names and packages, return a list of output
names and file names suitable for the #:allowed-references argument to
'derivation'."
;; XXX: Currently outputs other than "out" are not supported, and things
;; other than packages aren't either.
(with-monad %store-monad
(define lower
(match-lambda
((? string? output)
(return output))
((? package? package)
(mlet %store-monad ((drv
(if target
(package->cross-derivation package target
#:system system
#:graft? #f)
(package->derivation package system
#:graft? #f))))
(return (derivation->output-path drv))))))
(sequence %store-monad (map lower lst))))
(define* (gexp->derivation name exp
#:key
system (target 'current)
@ -127,6 +150,7 @@ (define* (gexp->derivation name exp
(module-path %load-path)
(guile-for-build (%guile-for-build))
references-graphs
allowed-references
local-build?)
"Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
derivation) on SYSTEM. When TARGET is true, it is used as the
@ -151,8 +175,9 @@ (define* (gexp->derivation name exp
FILE-NAME contains the reference graph of the corresponding item, in a simple
text format.
In that case, the reference graph of each store path is exported in
the build environment in the corresponding file, in a simple text format.
ALLOWED-REFERENCES must be either #f or a list of output names and packages.
In the latter case, the list denotes store items that the result is allowed to
refer to. Any reference to another store item will lead to a build error.
The other arguments are as for 'derivation'."
(define %modules modules)
@ -207,6 +232,11 @@ (define (graphs-file-names graphs)
#:system system
#:target target)
(return #f)))
(allowed (if allowed-references
(lower-references allowed-references
#:system system
#:target target)
(return #f)))
(guile (if guile-for-build
(return guile-for-build)
(package->derivation (default-guile)
@ -233,6 +263,7 @@ (define (graphs-file-names graphs)
(_ '())))
#:hash hash #:hash-algo hash-algo #:recursive? recursive?
#:references-graphs (and=> graphs graphs-file-names)
#:allowed-references allowed
#:local-build? local-build?)))
(define* (gexp-inputs exp #:optional (references gexp-references))

25
tests/gexp.scm
View file

@ -27,6 +27,7 @@ (define-module (test-gexp)
#:use-module (gnu packages base)
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
@ -396,6 +397,30 @@ (define (match-input thing)
(equal? (call-with-input-file g-guile read)
(list (derivation->output-path guile-drv)))))))
(test-assertm "gexp->derivation #:allowed-references"
(mlet %store-monad ((drv (gexp->derivation "allowed-refs"
#~(begin
(mkdir #$output)
(chdir #$output)
(symlink #$output "self")
(symlink #$%bootstrap-guile
"guile"))
#:allowed-references
(list "out" %bootstrap-guile))))
(built-derivations (list drv))))
(test-assert "gexp->derivation #:allowed-references, disallowed"
(let ((drv (run-with-store %store
(gexp->derivation "allowed-refs"
#~(begin
(mkdir #$output)
(chdir #$output)
(symlink #$%bootstrap-guile "guile"))
#:allowed-references '()))))
(guard (c ((nix-protocol-error? c) #t))
(build-derivations %store (list drv))
#f)))
(define shebang
(string-append "#!" (derivation->output-path (%guile-for-build))
"/bin/guile --no-auto-compile"))