You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

768 lines
28 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU 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. ;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (guix store)
  19. #:use-module (guix nar)
  20. #:use-module (guix utils)
  21. #:use-module (guix config)
  22. #:use-module (guix serialization)
  23. #:use-module (rnrs bytevectors)
  24. #:use-module (rnrs io ports)
  25. #:use-module (srfi srfi-1)
  26. #:use-module (srfi srfi-9)
  27. #:use-module (srfi srfi-9 gnu)
  28. #:use-module (srfi srfi-26)
  29. #:use-module (srfi srfi-34)
  30. #:use-module (srfi srfi-35)
  31. #:use-module (srfi srfi-39)
  32. #:use-module (ice-9 match)
  33. #:use-module (ice-9 regex)
  34. #:use-module (ice-9 vlist)
  35. #:export (%daemon-socket-file
  36. nix-server?
  37. nix-server-major-version
  38. nix-server-minor-version
  39. nix-server-socket
  40. &nix-error nix-error?
  41. &nix-connection-error nix-connection-error?
  42. nix-connection-error-file
  43. nix-connection-error-code
  44. &nix-protocol-error nix-protocol-error?
  45. nix-protocol-error-message
  46. nix-protocol-error-status
  47. hash-algo
  48. open-connection
  49. close-connection
  50. set-build-options
  51. valid-path?
  52. query-path-hash
  53. add-text-to-store
  54. add-to-store
  55. build-derivations
  56. add-temp-root
  57. add-indirect-root
  58. substitutable?
  59. substitutable-path
  60. substitutable-deriver
  61. substitutable-references
  62. substitutable-download-size
  63. substitutable-nar-size
  64. has-substitutes?
  65. substitutable-paths
  66. substitutable-path-info
  67. references
  68. requisites
  69. referrers
  70. valid-derivers
  71. query-derivation-outputs
  72. live-paths
  73. dead-paths
  74. collect-garbage
  75. delete-paths
  76. import-paths
  77. export-paths
  78. current-build-output-port
  79. %store-prefix
  80. store-path?
  81. direct-store-path?
  82. derivation-path?
  83. store-path-package-name
  84. store-path-hash-part
  85. log-file))
  86. (define %protocol-version #x10c)
  87. (define %worker-magic-1 #x6e697863)
  88. (define %worker-magic-2 #x6478696f)
  89. (define (protocol-major magic)
  90. (logand magic #xff00))
  91. (define (protocol-minor magic)
  92. (logand magic #x00ff))
  93. (define-syntax define-enumerate-type
  94. (syntax-rules ()
  95. ((_ name->int (name id) ...)
  96. (define-syntax name->int
  97. (syntax-rules (name ...)
  98. ((_ name) id) ...)))))
  99. (define-enumerate-type operation-id
  100. ;; operation numbers from worker-protocol.hh
  101. (quit 0)
  102. (valid-path? 1)
  103. (has-substitutes? 3)
  104. (query-path-hash 4)
  105. (query-references 5)
  106. (query-referrers 6)
  107. (add-to-store 7)
  108. (add-text-to-store 8)
  109. (build-derivations 9)
  110. (ensure-path 10)
  111. (add-temp-root 11)
  112. (add-indirect-root 12)
  113. (sync-with-gc 13)
  114. (find-roots 14)
  115. (export-path 16)
  116. (query-deriver 18)
  117. (set-options 19)
  118. (collect-garbage 20)
  119. ;;(query-substitutable-path-info 21) ; obsolete as of #x10c
  120. (query-derivation-outputs 22)
  121. (query-all-valid-paths 23)
  122. (query-failed-paths 24)
  123. (clear-failed-paths 25)
  124. (query-path-info 26)
  125. (import-paths 27)
  126. (query-derivation-output-names 28)
  127. (query-path-from-hash-part 29)
  128. (query-substitutable-path-infos 30)
  129. (query-valid-paths 31)
  130. (query-substitutable-paths 32)
  131. (query-valid-derivers 33))
  132. (define-enumerate-type hash-algo
  133. ;; hash.hh
  134. (md5 1)
  135. (sha1 2)
  136. (sha256 3))
  137. (define-enumerate-type gc-action
  138. ;; store-api.hh
  139. (return-live 0)
  140. (return-dead 1)
  141. (delete-dead 2)
  142. (delete-specific 3))
  143. (define %default-socket-path
  144. (string-append (or (getenv "NIX_STATE_DIR") %state-directory)
  145. "/daemon-socket/socket"))
  146. (define %daemon-socket-file
  147. ;; File name of the socket the daemon listens too.
  148. (make-parameter (or (getenv "GUIX_DAEMON_SOCKET")
  149. %default-socket-path)))
  150. ;; Information about a substitutable store path.
  151. (define-record-type <substitutable>
  152. (substitutable path deriver refs dl-size nar-size)
  153. substitutable?
  154. (path substitutable-path)
  155. (deriver substitutable-deriver)
  156. (refs substitutable-references)
  157. (dl-size substitutable-download-size)
  158. (nar-size substitutable-nar-size))
  159. (define (read-substitutable-path-list p)
  160. (let loop ((len (read-int p))
  161. (result '()))
  162. (if (zero? len)
  163. (reverse result)
  164. (let ((path (read-store-path p))
  165. (deriver (read-store-path p))
  166. (refs (read-store-path-list p))
  167. (dl-size (read-long-long p))
  168. (nar-size (read-long-long p)))
  169. (loop (- len 1)
  170. (cons (substitutable path deriver refs dl-size nar-size)
  171. result))))))
  172. (define-syntax write-arg
  173. (syntax-rules (integer boolean file string string-list
  174. store-path store-path-list base16)
  175. ((_ integer arg p)
  176. (write-int arg p))
  177. ((_ boolean arg p)
  178. (write-int (if arg 1 0) p))
  179. ((_ file arg p)
  180. (write-file arg p))
  181. ((_ string arg p)
  182. (write-string arg p))
  183. ((_ string-list arg p)
  184. (write-string-list arg p))
  185. ((_ store-path arg p)
  186. (write-store-path arg p))
  187. ((_ store-path-list arg p)
  188. (write-store-path-list arg p))
  189. ((_ base16 arg p)
  190. (write-string (bytevector->base16-string arg) p))))
  191. (define-syntax read-arg
  192. (syntax-rules (integer boolean string store-path store-path-list
  193. substitutable-path-list base16)
  194. ((_ integer p)
  195. (read-int p))
  196. ((_ boolean p)
  197. (not (zero? (read-int p))))
  198. ((_ string p)
  199. (read-string p))
  200. ((_ store-path p)
  201. (read-store-path p))
  202. ((_ store-path-list p)
  203. (read-store-path-list p))
  204. ((_ substitutable-path-list p)
  205. (read-substitutable-path-list p))
  206. ((_ base16 p)
  207. (base16-string->bytevector (read-string p)))))
  208. ;; remote-store.cc
  209. (define-record-type <nix-server>
  210. (%make-nix-server socket major minor
  211. ats-cache atts-cache)
  212. nix-server?
  213. (socket nix-server-socket)
  214. (major nix-server-major-version)
  215. (minor nix-server-minor-version)
  216. ;; Caches. We keep them per-connection, because store paths build
  217. ;; during the session are temporary GC roots kept for the duration of
  218. ;; the session.
  219. (ats-cache nix-server-add-to-store-cache)
  220. (atts-cache nix-server-add-text-to-store-cache))
  221. (set-record-type-printer! <nix-server>
  222. (lambda (obj port)
  223. (format port "#<build-daemon ~a.~a ~a>"
  224. (nix-server-major-version obj)
  225. (nix-server-minor-version obj)
  226. (number->string (object-address obj)
  227. 16))))
  228. (define-condition-type &nix-error &error
  229. nix-error?)
  230. (define-condition-type &nix-connection-error &nix-error
  231. nix-connection-error?
  232. (file nix-connection-error-file)
  233. (errno nix-connection-error-code))
  234. (define-condition-type &nix-protocol-error &nix-error
  235. nix-protocol-error?
  236. (message nix-protocol-error-message)
  237. (status nix-protocol-error-status))
  238. (define* (open-connection #:optional (file (%daemon-socket-file))
  239. #:key (reserve-space? #t))
  240. "Connect to the daemon over the Unix-domain socket at FILE. When
  241. RESERVE-SPACE? is true, instruct it to reserve a little bit of extra
  242. space on the file system so that the garbage collector can still
  243. operate, should the disk become full. Return a server object."
  244. (let ((s (with-fluids ((%default-port-encoding #f))
  245. ;; This trick allows use of the `scm_c_read' optimization.
  246. (socket PF_UNIX SOCK_STREAM 0)))
  247. (a (make-socket-address PF_UNIX file)))
  248. (catch 'system-error
  249. (lambda ()
  250. ;; Enlarge the receive buffer.
  251. (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024)))
  252. (lambda args
  253. ;; On the Hurd, the pflocal server's implementation of `socket_setopt'
  254. ;; always returns ENOPROTOOPT. Ignore it.
  255. (unless (= (system-error-errno args) ENOPROTOOPT)
  256. (apply throw args))))
  257. (catch 'system-error
  258. (cut connect s a)
  259. (lambda args
  260. ;; Translate the error to something user-friendly.
  261. (let ((errno (system-error-errno args)))
  262. (raise (condition (&nix-connection-error
  263. (file file)
  264. (errno errno)))))))
  265. (write-int %worker-magic-1 s)
  266. (let ((r (read-int s)))
  267. (and (eqv? r %worker-magic-2)
  268. (let ((v (read-int s)))
  269. (and (eqv? (protocol-major %protocol-version)
  270. (protocol-major v))
  271. (begin
  272. (write-int %protocol-version s)
  273. (if (>= (protocol-minor v) 11)
  274. (write-int (if reserve-space? 1 0) s))
  275. (let ((s (%make-nix-server s
  276. (protocol-major v)
  277. (protocol-minor v)
  278. (make-hash-table 100)
  279. (make-hash-table 100))))
  280. (let loop ((done? (process-stderr s)))
  281. (or done? (process-stderr s)))
  282. s))))))))
  283. (define (close-connection server)
  284. "Close the connection to SERVER."
  285. (close (nix-server-socket server)))
  286. (define current-build-output-port
  287. ;; The port where build output is sent.
  288. (make-parameter (current-error-port)))
  289. (define* (dump-port in out
  290. #:optional len
  291. #:key (buffer-size 16384))
  292. "Read LEN bytes from IN (or as much as possible if LEN is #f) and write it
  293. to OUT, using chunks of BUFFER-SIZE bytes."
  294. (define buffer
  295. (make-bytevector buffer-size))
  296. (let loop ((total 0)
  297. (bytes (get-bytevector-n! in buffer 0
  298. (if len
  299. (min len buffer-size)
  300. buffer-size))))
  301. (or (eof-object? bytes)
  302. (and len (= total len))
  303. (let ((total (+ total bytes)))
  304. (put-bytevector out buffer 0 bytes)
  305. (loop total
  306. (get-bytevector-n! in buffer 0
  307. (if len
  308. (min (- len total) buffer-size)
  309. buffer-size)))))))
  310. (define* (process-stderr server #:optional user-port)
  311. "Read standard output and standard error from SERVER, writing it to
  312. CURRENT-BUILD-OUTPUT-PORT. Return #t when SERVER is done sending data, and
  313. #f otherwise; in the latter case, the caller should call `process-stderr'
  314. again until #t is returned or an error is raised.
  315. Since the build process's output cannot be assumed to be UTF-8, we
  316. conservatively consider it to be Latin-1, thereby avoiding possible
  317. encoding conversion errors."
  318. (define p
  319. (nix-server-socket server))
  320. ;; magic cookies from worker-protocol.hh
  321. (define %stderr-next #x6f6c6d67)
  322. (define %stderr-read #x64617461) ; data needed from source
  323. (define %stderr-write #x64617416) ; data for sink
  324. (define %stderr-last #x616c7473)
  325. (define %stderr-error #x63787470)
  326. (let ((k (read-int p)))
  327. (cond ((= k %stderr-write)
  328. ;; Write a byte stream to USER-PORT.
  329. (let* ((len (read-int p))
  330. (m (modulo len 8)))
  331. (dump-port p user-port len)
  332. (unless (zero? m)
  333. ;; Consume padding, as for strings.
  334. (get-bytevector-n p (- 8 m))))
  335. #f)
  336. ((= k %stderr-read)
  337. ;; Read a byte stream from USER-PORT.
  338. (let* ((max-len (read-int p))
  339. (data (get-bytevector-n user-port max-len))
  340. (len (bytevector-length data)))
  341. (write-int len p)
  342. (put-bytevector p data)
  343. (write-padding len p)
  344. #f))
  345. ((= k %stderr-next)
  346. ;; Log a string.
  347. (let ((s (read-latin1-string p)))
  348. (display s (current-build-output-port))
  349. #f))
  350. ((= k %stderr-error)
  351. ;; Report an error.
  352. (let ((error (read-latin1-string p))
  353. ;; Currently the daemon fails to send a status code for early
  354. ;; errors like DB schema version mismatches, so check for EOF.
  355. (status (if (and (>= (nix-server-minor-version server) 8)
  356. (not (eof-object? (lookahead-u8 p))))
  357. (read-int p)
  358. 1)))
  359. (raise (condition (&nix-protocol-error
  360. (message error)
  361. (status status))))))
  362. ((= k %stderr-last)
  363. ;; The daemon is done (see `stopWork' in `nix-worker.cc'.)
  364. #t)
  365. (else
  366. (raise (condition (&nix-protocol-error
  367. (message "invalid error code")
  368. (status k))))))))
  369. (define* (set-build-options server
  370. #:key keep-failed? keep-going? fallback?
  371. (verbosity 0)
  372. (max-build-jobs (current-processor-count))
  373. (max-silent-time 3600)
  374. (use-build-hook? #t)
  375. (build-verbosity 0)
  376. (log-type 0)
  377. (print-build-trace #t)
  378. (build-cores 1)
  379. (use-substitutes? #t)
  380. (binary-caches '())) ; client "untrusted" cache URLs
  381. ;; Must be called after `open-connection'.
  382. (define socket
  383. (nix-server-socket server))
  384. (let-syntax ((send (syntax-rules ()
  385. ((_ (type option) ...)
  386. (begin
  387. (write-arg type option socket)
  388. ...)))))
  389. (write-int (operation-id set-options) socket)
  390. (send (boolean keep-failed?) (boolean keep-going?)
  391. (boolean fallback?) (integer verbosity)
  392. (integer max-build-jobs) (integer max-silent-time))
  393. (if (>= (nix-server-minor-version server) 2)
  394. (send (boolean use-build-hook?)))
  395. (if (>= (nix-server-minor-version server) 4)
  396. (send (integer build-verbosity) (integer log-type)
  397. (boolean print-build-trace)))
  398. (if (>= (nix-server-minor-version server) 6)
  399. (send (integer build-cores)))
  400. (if (>= (nix-server-minor-version server) 10)
  401. (send (boolean use-substitutes?)))
  402. (if (>= (nix-server-minor-version server) 12)
  403. (send (string-list (fold-right (lambda (pair result)
  404. (match pair
  405. ((h . t)
  406. (cons* h t result))))
  407. '()
  408. binary-caches))))
  409. (let loop ((done? (process-stderr server)))
  410. (or done? (process-stderr server)))))
  411. (define-syntax operation
  412. (syntax-rules ()
  413. "Define a client-side RPC stub for the given operation."
  414. ((_ (name (type arg) ...) docstring return ...)
  415. (lambda (server arg ...)
  416. docstring
  417. (let ((s (nix-server-socket server)))
  418. (write-int (operation-id name) s)
  419. (write-arg type arg s)
  420. ...
  421. ;; Loop until the server is done sending error output.
  422. (let loop ((done? (process-stderr server)))
  423. (or done? (loop (process-stderr server))))
  424. (values (read-arg return s) ...))))))
  425. (define-syntax-rule (define-operation (name args ...)
  426. docstring return ...)
  427. (define name
  428. (operation (name args ...) docstring return ...)))
  429. (define-operation (valid-path? (string path))
  430. "Return #t when PATH is a valid store path."
  431. boolean)
  432. (define-operation (query-path-hash (store-path path))
  433. "Return the SHA256 hash of PATH as a bytevector."
  434. base16)
  435. (define add-text-to-store
  436. ;; A memoizing version of `add-to-store', to avoid repeated RPCs with
  437. ;; the very same arguments during a given session.
  438. (let ((add-text-to-store
  439. (operation (add-text-to-store (string name) (string text)
  440. (string-list references))
  441. #f
  442. store-path)))
  443. (lambda* (server name text #:optional (references '()))
  444. "Add TEXT under file NAME in the store, and return its store path.
  445. REFERENCES is the list of store paths referred to by the resulting store
  446. path."
  447. (let ((args `(,text ,name ,references))
  448. (cache (nix-server-add-text-to-store-cache server)))
  449. (or (hash-ref cache args)
  450. (let ((path (add-text-to-store server name text references)))
  451. (hash-set! cache args path)
  452. path))))))
  453. (define add-to-store
  454. ;; A memoizing version of `add-to-store'. This is important because
  455. ;; `add-to-store' leads to huge data transfers to the server, and
  456. ;; because it's often called many times with the very same argument.
  457. (let ((add-to-store (operation (add-to-store (string basename)
  458. (boolean fixed?) ; obsolete, must be #t
  459. (boolean recursive?)
  460. (string hash-algo)
  461. (file file-name))
  462. #f
  463. store-path)))
  464. (lambda (server basename recursive? hash-algo file-name)
  465. "Add the contents of FILE-NAME under BASENAME to the store. When
  466. RECURSIVE? is true and FILE-NAME designates a directory, the contents of
  467. FILE-NAME are added recursively; if FILE-NAME designates a flat file and
  468. RECURSIVE? is true, its contents are added, and its permission bits are
  469. kept. HASH-ALGO must be a string such as \"sha256\"."
  470. (let* ((st (stat file-name #f))
  471. (args `(,st ,basename ,recursive? ,hash-algo))
  472. (cache (nix-server-add-to-store-cache server)))
  473. (or (and st (hash-ref cache args))
  474. (let ((path (add-to-store server basename #t recursive?
  475. hash-algo file-name)))
  476. (hash-set! cache args path)
  477. path))))))
  478. (define-operation (build-derivations (string-list derivations))
  479. "Build DERIVATIONS, and return when the worker is done building them.
  480. Return #t on success."
  481. boolean)
  482. (define-operation (add-temp-root (store-path path))
  483. "Make PATH a temporary root for the duration of the current session.
  484. Return #t."
  485. boolean)
  486. (define-operation (add-indirect-root (string file-name))
  487. "Make FILE-NAME an indirect root for the garbage collector; FILE-NAME
  488. can be anywhere on the file system, but it must be an absolute file
  489. name--it is the caller's responsibility to ensure that it is an absolute
  490. file name. Return #t on success."
  491. boolean)
  492. (define references
  493. (operation (query-references (store-path path))
  494. "Return the list of references of PATH."
  495. store-path-list))
  496. (define* (fold-path store proc seed path
  497. #:optional (relatives (cut references store <>)))
  498. "Call PROC for each of the RELATIVES of PATH, exactly once, and return the
  499. result formed from the successive calls to PROC, the first of which is passed
  500. SEED."
  501. (let loop ((paths (list path))
  502. (result seed)
  503. (seen vlist-null))
  504. (match paths
  505. ((path rest ...)
  506. (if (vhash-assoc path seen)
  507. (loop rest result seen)
  508. (let ((seen (vhash-cons path #t seen))
  509. (rest (append rest (relatives path)))
  510. (result (proc path result)))
  511. (loop rest result seen))))
  512. (()
  513. result))))
  514. (define (requisites store path)
  515. "Return the requisites of PATH, including PATH---i.e., its closure (all its
  516. references, recursively)."
  517. (fold-path store cons '() path))
  518. (define referrers
  519. (operation (query-referrers (store-path path))
  520. "Return the list of path that refer to PATH."
  521. store-path-list))
  522. (define valid-derivers
  523. (operation (query-valid-derivers (store-path path))
  524. "Return the list of valid \"derivers\" of PATH---i.e., all the
  525. .drv present in the store that have PATH among their outputs."
  526. store-path-list))
  527. (define query-derivation-outputs ; avoid name clash with `derivation-outputs'
  528. (operation (query-derivation-outputs (store-path path))
  529. "Return the list of outputs of PATH, a .drv file."
  530. store-path-list))
  531. (define-operation (has-substitutes? (store-path path))
  532. "Return #t if binary substitutes are available for PATH, and #f otherwise."
  533. boolean)
  534. (define substitutable-paths
  535. (operation (query-substitutable-paths (store-path-list paths))
  536. "Return the subset of PATHS that is substitutable."
  537. store-path-list))
  538. (define substitutable-path-info
  539. (operation (query-substitutable-path-infos (store-path-list paths))
  540. "Return information about the subset of PATHS that is
  541. substitutable. For each substitutable path, a `substitutable?' object is
  542. returned."
  543. substitutable-path-list))
  544. (define (run-gc server action to-delete min-freed)
  545. "Perform the garbage-collector operation ACTION, one of the
  546. `gc-action' values. When ACTION is `delete-specific', the TO-DELETE is
  547. the list of store paths to delete. IGNORE-LIVENESS? should always be
  548. #f. MIN-FREED is the minimum amount of disk space to be freed, in
  549. bytes, before the GC can stop. Return the list of store paths delete,
  550. and the number of bytes freed."
  551. (let ((s (nix-server-socket server)))
  552. (write-int (operation-id collect-garbage) s)
  553. (write-int action s)
  554. (write-store-path-list to-delete s)
  555. (write-arg boolean #f s) ; ignore-liveness?
  556. (write-long-long min-freed s)
  557. (write-int 0 s) ; obsolete
  558. (when (>= (nix-server-minor-version server) 5)
  559. ;; Obsolete `use-atime' and `max-atime' parameters.
  560. (write-int 0 s)
  561. (write-int 0 s))
  562. ;; Loop until the server is done sending error output.
  563. (let loop ((done? (process-stderr server)))
  564. (or done? (loop (process-stderr server))))
  565. (let ((paths (read-store-path-list s))
  566. (freed (read-long-long s))
  567. (obsolete (read-long-long s)))
  568. (values paths freed))))
  569. (define-syntax-rule (%long-long-max)
  570. ;; Maximum unsigned 64-bit integer.
  571. (- (expt 2 64) 1))
  572. (define (live-paths server)
  573. "Return the list of live store paths---i.e., store paths still
  574. referenced, and thus not subject to being garbage-collected."
  575. (run-gc server (gc-action return-live) '() (%long-long-max)))
  576. (define (dead-paths server)
  577. "Return the list of dead store paths---i.e., store paths no longer
  578. referenced, and thus subject to being garbage-collected."
  579. (run-gc server (gc-action return-dead) '() (%long-long-max)))
  580. (define* (collect-garbage server #:optional (min-freed (%long-long-max)))
  581. "Collect garbage from the store at SERVER. If MIN-FREED is non-zero,
  582. then collect at least MIN-FREED bytes. Return the paths that were
  583. collected, and the number of bytes freed."
  584. (run-gc server (gc-action delete-dead) '() min-freed))
  585. (define* (delete-paths server paths #:optional (min-freed (%long-long-max)))
  586. "Delete PATHS from the store at SERVER, if they are no longer
  587. referenced. If MIN-FREED is non-zero, then stop after at least
  588. MIN-FREED bytes have been collected. Return the paths that were
  589. collected, and the number of bytes freed."
  590. (run-gc server (gc-action delete-specific) paths min-freed))
  591. (define (import-paths server port)
  592. "Import the set of store paths read from PORT into SERVER's store. An error
  593. is raised if the set of paths read from PORT is not signed (as per
  594. 'export-path #:sign? #t'.) Return the list of store paths imported."
  595. (let ((s (nix-server-socket server)))
  596. (write-int (operation-id import-paths) s)
  597. (let loop ((done? (process-stderr server port)))
  598. (or done? (loop (process-stderr server port))))
  599. (read-store-path-list s)))
  600. (define* (export-path server path port #:key (sign? #t))
  601. "Export PATH to PORT. When SIGN? is true, sign it."
  602. (let ((s (nix-server-socket server)))
  603. (write-int (operation-id export-path) s)
  604. (write-store-path path s)
  605. (write-arg boolean sign? s)
  606. (let loop ((done? (process-stderr server port)))
  607. (or done? (loop (process-stderr server port))))
  608. (= 1 (read-int s))))
  609. (define* (export-paths server paths port #:key (sign? #t))
  610. "Export the store paths listed in PATHS to PORT, signing them if SIGN?
  611. is true."
  612. (let ((s (nix-server-socket server)))
  613. (let loop ((paths paths))
  614. (match paths
  615. (()
  616. (write-int 0 port))
  617. ((head tail ...)
  618. (write-int 1 port)
  619. (and (export-path server head port #:sign? sign?)
  620. (loop tail)))))))
  621. ;;;
  622. ;;; Store paths.
  623. ;;;
  624. (define %store-prefix
  625. ;; Absolute path to the Nix store.
  626. (make-parameter (or (and=> (getenv "NIX_STORE_DIR") canonicalize-path)
  627. %store-directory)))
  628. (define (store-path? path)
  629. "Return #t if PATH is a store path."
  630. ;; This is a lightweight check, compared to using a regexp, but this has to
  631. ;; be fast as it's called often in `derivation', for instance.
  632. ;; `isStorePath' in Nix does something similar.
  633. (string-prefix? (%store-prefix) path))
  634. (define (direct-store-path? path)
  635. "Return #t if PATH is a store path, and not a sub-directory of a store path.
  636. This predicate is sometimes needed because files *under* a store path are not
  637. valid inputs."
  638. (and (store-path? path)
  639. (let ((len (+ 1 (string-length (%store-prefix)))))
  640. (not (string-index (substring path len) #\/)))))
  641. (define (derivation-path? path)
  642. "Return #t if PATH is a derivation path."
  643. (and (store-path? path) (string-suffix? ".drv" path)))
  644. (define store-regexp*
  645. ;; The substituter makes repeated calls to 'store-path-hash-part', hence
  646. ;; this optimization.
  647. (memoize
  648. (lambda (store)
  649. "Return a regexp matching a file in STORE."
  650. (make-regexp (string-append "^" (regexp-quote store)
  651. "/([0-9a-df-np-sv-z]{32})-([^/]+)$")))))
  652. (define (store-path-package-name path)
  653. "Return the package name part of PATH, a file name in the store."
  654. (let ((path-rx (store-regexp* (%store-prefix))))
  655. (and=> (regexp-exec path-rx path)
  656. (cut match:substring <> 2))))
  657. (define (store-path-hash-part path)
  658. "Return the hash part of PATH as a base32 string, or #f if PATH is not a
  659. syntactically valid store path."
  660. (let ((path-rx (store-regexp* (%store-prefix))))
  661. (and=> (regexp-exec path-rx path)
  662. (cut match:substring <> 1))))
  663. (define (log-file store file)
  664. "Return the build log file for FILE, or #f if none could be found. FILE
  665. must be an absolute store file name, or a derivation file name."
  666. (define state-dir ; XXX: factorize
  667. (or (getenv "NIX_STATE_DIR") %state-directory))
  668. (cond ((derivation-path? file)
  669. (let* ((base (basename file))
  670. (log (string-append (dirname state-dir) ; XXX: ditto
  671. "/log/nix/drvs/"
  672. (string-take base 2) "/"
  673. (string-drop base 2) ".bz2")))
  674. (and (file-exists? log) log)))
  675. (else
  676. (match (valid-derivers store file)
  677. ((derivers ...)
  678. ;; Return the first that works.
  679. (any (cut log-file store <>) derivers))
  680. (_ #f)))))