Commit | Line | Data |
---|---|---|
77d3cf08 LC |
1 | ;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- |
2 | ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of Guix. | |
5 | ;;; | |
6 | ;;; Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix derivations) | |
20 | #:use-module (srfi srfi-1) | |
21 | #:use-module (srfi srfi-9) | |
22 | #:use-module (srfi srfi-26) | |
23 | #:use-module (rnrs io ports) | |
24 | #:use-module (rnrs bytevectors) | |
25 | #:use-module (ice-9 match) | |
26 | #:use-module (ice-9 rdelim) | |
69f90f5c | 27 | #:use-module (guix store) |
77d3cf08 LC |
28 | #:export (derivation? |
29 | derivation-outputs | |
30 | derivation-inputs | |
31 | derivation-sources | |
32 | derivation-system | |
33 | derivation-builder-arguments | |
34 | derivation-builder-environment-vars | |
35 | ||
36 | derivation-output? | |
37 | derivation-output-path | |
38 | derivation-output-hash-algo | |
39 | derivation-output-hash | |
40 | ||
41 | derivation-input? | |
42 | derivation-input-path | |
43 | derivation-input-sub-derivations | |
44 | ||
45 | fixed-output-derivation? | |
341c6fdd LC |
46 | derivation-hash |
47 | ||
48 | read-derivation | |
49 | write-derivation)) | |
77d3cf08 LC |
50 | |
51 | ;;; | |
52 | ;;; Nix derivations, as implemented in Nix's `derivations.cc'. | |
53 | ;;; | |
54 | ||
55 | (define-record-type <derivation> | |
56 | (make-derivation outputs inputs sources system builder args env-vars) | |
57 | derivation? | |
58 | (outputs derivation-outputs) ; list of name/<derivation-output> pairs | |
59 | (inputs derivation-inputs) ; list of <derivation-input> | |
60 | (sources derivation-sources) ; list of store paths | |
61 | (system derivation-system) ; string | |
62 | (builder derivation-builder) ; store path | |
63 | (args derivation-builder-arguments) ; list of strings | |
64 | (env-vars derivation-builder-environment-vars)) ; list of name/value pairs | |
65 | ||
66 | (define-record-type <derivation-output> | |
67 | (make-derivation-output path hash-algo hash) | |
68 | derivation-output? | |
69 | (path derivation-output-path) ; store path | |
70 | (hash-algo derivation-output-hash-algo) ; symbol | #f | |
71 | (hash derivation-output-hash)) ; symbol | #f | |
72 | ||
73 | (define-record-type <derivation-input> | |
74 | (make-derivation-input path sub-derivations) | |
75 | derivation-input? | |
76 | (path derivation-input-path) ; store path | |
77 | (sub-derivations derivation-input-sub-derivations)) ; list of strings | |
78 | ||
79 | (define (fixed-output-derivation? drv) | |
80 | "Return #t if DRV is a fixed-output derivation, such as the result of a | |
81 | download with a fixed hash (aka. `fetchurl')." | |
82 | (match drv | |
83 | (($ <derivation> | |
84 | (($ <derivation-output> _ (? symbol?) (? string?)))) | |
85 | #t) | |
86 | (_ #f))) | |
87 | ||
88 | (define (read-derivation drv-port) | |
89 | "Read the derivation from DRV-PORT and return the corresponding | |
90 | <derivation> object." | |
91 | ||
92 | (define comma (string->symbol ",")) | |
93 | ||
94 | (define (ununquote x) | |
95 | (match x | |
96 | (('unquote x) (ununquote x)) | |
97 | ((x ...) (map ununquote x)) | |
98 | (_ x))) | |
99 | ||
100 | (define (outputs->alist x) | |
101 | (fold-right (lambda (output result) | |
102 | (match output | |
103 | ((name path "" "") | |
104 | (alist-cons name | |
105 | (make-derivation-output path #f #f) | |
106 | result)) | |
107 | ((name path hash-algo hash) | |
108 | ;; fixed-output | |
109 | (let ((algo (string->symbol hash-algo))) | |
110 | (alist-cons name | |
111 | (make-derivation-output path algo hash) | |
112 | result))))) | |
113 | '() | |
114 | x)) | |
115 | ||
116 | (define (make-input-drvs x) | |
117 | (fold-right (lambda (input result) | |
118 | (match input | |
119 | ((path (sub-drvs ...)) | |
120 | (cons (make-derivation-input path sub-drvs) | |
121 | result)))) | |
122 | '() | |
123 | x)) | |
124 | ||
125 | (let loop ((exp (read drv-port)) | |
126 | (result '())) | |
127 | (match exp | |
128 | ((? eof-object?) | |
129 | (let ((result (reverse result))) | |
130 | (match result | |
131 | (('Derive ((outputs ...) (input-drvs ...) | |
132 | (input-srcs ...) | |
133 | (? string? system) | |
134 | (? string? builder) | |
135 | ((? string? args) ...) | |
136 | ((var value) ...))) | |
137 | (make-derivation (outputs->alist outputs) | |
138 | (make-input-drvs input-drvs) | |
139 | input-srcs | |
140 | system builder args | |
141 | (fold-right alist-cons '() var value))) | |
142 | (_ | |
143 | (error "failed to parse derivation" drv-port result))))) | |
144 | ((? (cut eq? <> comma)) | |
145 | (loop (read drv-port) result)) | |
146 | (_ | |
147 | (loop (read drv-port) | |
148 | (cons (ununquote exp) result)))))) | |
149 | ||
150 | (define (write-derivation drv port) | |
151 | "Write the ATerm-like serialization of DRV to PORT. See Section 2.4 of | |
152 | Eelco Dolstra's PhD dissertation for an overview of a previous version of | |
153 | that form." | |
154 | (define (list->string lst) | |
155 | (string-append "[" (string-join lst ",") "]")) | |
156 | ||
157 | (define (write-list lst) | |
158 | (display (list->string lst) port)) | |
159 | ||
160 | (match drv | |
161 | (($ <derivation> outputs inputs sources | |
162 | system builder args env-vars) | |
163 | (display "Derive(" port) | |
164 | (write-list (map (match-lambda | |
165 | ((name . ($ <derivation-output> path hash-algo hash)) | |
166 | (format #f "(~s,~s,~s,~s)" | |
167 | name path (or hash-algo "") | |
168 | (or hash "")))) | |
169 | outputs)) | |
170 | (display "," port) | |
171 | (write-list (map (match-lambda | |
172 | (($ <derivation-input> path sub-drvs) | |
173 | (format #f "(~s,~a)" path | |
174 | (list->string (map object->string sub-drvs))))) | |
175 | inputs)) | |
176 | (display "," port) | |
177 | (write-list sources) | |
178 | (format port ",~s,~s," system builder) | |
179 | (write-list (map object->string args)) | |
180 | (display "," port) | |
181 | (write-list (map (match-lambda | |
182 | ((name . value) | |
183 | (format #f "(~s,~s)" name value))) | |
184 | env-vars)) | |
185 | (display ")" port)))) | |
186 | ||
77d3cf08 LC |
187 | |
188 | (define (derivation-hash drv) ; `hashDerivationModulo' in derivations.cc | |
69f90f5c | 189 | "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector." |
77d3cf08 LC |
190 | (match drv |
191 | (($ <derivation> ((_ . ($ <derivation-output> path | |
192 | (? symbol? hash-algo) (? string? hash))))) | |
193 | ;; A fixed-output derivation. | |
194 | (sha256 | |
195 | (string->utf8 | |
196 | (string-append "fixed:out:" hash-algo ":" hash ":" path)))) | |
197 | (($ <derivation> outputs inputs sources | |
198 | system builder args env-vars) | |
199 | ;; A regular derivation: replace that path of each input with that | |
200 | ;; inputs hash; return the hash of serialization of the resulting | |
201 | ;; derivation. | |
202 | (let* ((inputs (map (match-lambda | |
203 | (($ <derivation-input> path sub-drvs) | |
204 | (let ((hash (call-with-input-file path | |
205 | (compose derivation-hash | |
206 | read-derivation)))) | |
207 | (make-derivation-input hash sub-drvs)))) | |
208 | inputs)) | |
209 | (drv (make-derivation outputs inputs sources | |
210 | system builder args env-vars))) | |
211 | (sha256 | |
212 | (string->utf8 (call-with-output-string | |
213 | (cut write-derivation drv <>)))))))) | |
214 | ||
215 | (define (instantiate server derivation) | |
216 | #f | |
217 | ) |