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.
 
 
 
 
 
 

278 lines
10 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
  3. ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
  4. ;;;
  5. ;;; This file is part of GNU Guix.
  6. ;;;
  7. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  8. ;;; under the terms of the GNU General Public License as published by
  9. ;;; the Free Software Foundation; either version 3 of the License, or (at
  10. ;;; your option) any later version.
  11. ;;;
  12. ;;; GNU Guix is distributed in the hope that it will be useful, but
  13. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;;; GNU General Public License for more details.
  16. ;;;
  17. ;;; You should have received a copy of the GNU General Public License
  18. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  19. (define-module (guix nar)
  20. #:use-module (guix serialization)
  21. #:use-module (guix build syscalls)
  22. #:use-module ((guix build utils)
  23. #:select (delete-file-recursively with-directory-excursion))
  24. #:use-module (guix store)
  25. #:use-module (guix store database)
  26. #:use-module (guix ui) ; for '_'
  27. #:use-module (gcrypt hash)
  28. #:use-module (guix pki)
  29. #:use-module (gcrypt pk-crypto)
  30. #:use-module (srfi srfi-1)
  31. #:use-module (srfi srfi-11)
  32. #:use-module (srfi srfi-26)
  33. #:use-module (srfi srfi-34)
  34. #:use-module (srfi srfi-35)
  35. #:export (nar-invalid-hash-error?
  36. nar-invalid-hash-error-expected
  37. nar-invalid-hash-error-actual
  38. nar-signature-error?
  39. nar-signature-error-signature
  40. restore-file-set))
  41. ;;; Comment:
  42. ;;;
  43. ;;; Read and write Nix archives, aka. ‘nar’.
  44. ;;;
  45. ;;; Code:
  46. (define-condition-type &nar-signature-error &nar-error
  47. nar-signature-error?
  48. (signature nar-signature-error-signature)) ; faulty signature or #f
  49. (define-condition-type &nar-invalid-hash-error &nar-signature-error
  50. nar-invalid-hash-error?
  51. (expected nar-invalid-hash-error-expected) ; expected hash (a bytevector)
  52. (actual nar-invalid-hash-error-actual)) ; actual hash
  53. ;;;
  54. ;;; Restoring a file set into the store.
  55. ;;;
  56. ;; The code below accesses the store directly and is meant to be run from
  57. ;; "build hooks", which cannot invoke the daemon's 'import-paths' RPC since
  58. ;; (1) the locks on the files to be restored as already held, and (2) the
  59. ;; $NIX_HELD_LOCKS hackish environment variable cannot be set.
  60. ;;
  61. ;; So we're really duplicating that functionality of the daemon (well, until
  62. ;; most of the daemon is in Scheme :-)). But note that we do use a couple of
  63. ;; RPCs for functionality not available otherwise, like 'valid-path?'.
  64. (define (lock-store-file file)
  65. "Acquire exclusive access to FILE, a store file."
  66. (call-with-output-file (string-append file ".lock")
  67. (cut fcntl-flock <> 'write-lock)))
  68. (define (unlock-store-file file)
  69. "Release access to FILE."
  70. (call-with-input-file (string-append file ".lock")
  71. (cut fcntl-flock <> 'unlock)))
  72. (define* (finalize-store-file source target
  73. #:key (references '()) deriver (lock? #t))
  74. "Rename SOURCE to TARGET and register TARGET as a valid store item, with
  75. REFERENCES and DERIVER. When LOCK? is true, acquire exclusive locks on TARGET
  76. before attempting to register it; otherwise, assume TARGET's locks are already
  77. held."
  78. ;; XXX: Currently we have to call out to the daemon to check whether TARGET
  79. ;; is valid.
  80. (with-store store
  81. (unless (valid-path? store target)
  82. (when lock?
  83. (lock-store-file target))
  84. (unless (valid-path? store target)
  85. ;; If FILE already exists, delete it (it's invalid anyway.)
  86. (when (file-exists? target)
  87. (delete-file-recursively target))
  88. ;; Install the new TARGET.
  89. (rename-file source target)
  90. ;; Register TARGET. As a side effect, it resets the timestamps of all
  91. ;; its files, recursively, and runs a deduplication pass.
  92. (register-path target
  93. #:references references
  94. #:deriver deriver))
  95. (when lock?
  96. (unlock-store-file target)))))
  97. (define (temporary-store-file)
  98. "Return the file name of a temporary file created in the store."
  99. (let* ((template (string-append (%store-prefix) "/guix-XXXXXX"))
  100. (port (mkstemp! template)))
  101. (close-port port)
  102. template))
  103. (define-syntax-rule (with-temporary-store-file name body ...)
  104. "Evaluate BODY with NAME bound to the file name of a temporary store item
  105. protected from GC."
  106. (let loop ((name (temporary-store-file)))
  107. (with-store store
  108. ;; Add NAME to the current process' roots. (Opening this connection to
  109. ;; the daemon allows us to reuse its code that deals with the
  110. ;; per-process roots file.)
  111. (add-temp-root store name)
  112. ;; There's a window during which GC could delete NAME. Try again when
  113. ;; that happens.
  114. (if (file-exists? name)
  115. (begin
  116. (delete-file name)
  117. body ...)
  118. (loop (temporary-store-file))))))
  119. (define* (restore-one-item port
  120. #:key acl (verify-signature? #t) (lock? #t)
  121. (log-port (current-error-port)))
  122. "Restore one store item from PORT; return its file name on success."
  123. (define (assert-valid-signature signature hash file)
  124. ;; Bail out if SIGNATURE, which must be a string as produced by
  125. ;; 'canonical-sexp->string', doesn't match HASH, a bytevector containing
  126. ;; the expected hash for FILE.
  127. (let ((signature (catch 'gcry-error
  128. (lambda ()
  129. (string->canonical-sexp signature))
  130. (lambda (key proc err)
  131. (raise (condition
  132. (&message
  133. (message "signature is not a valid \
  134. s-expression"))
  135. (&nar-signature-error
  136. (file file)
  137. (signature signature) (port port))))))))
  138. (signature-case (signature hash (current-acl))
  139. (valid-signature #t)
  140. (invalid-signature
  141. (raise (condition
  142. (&message (message "invalid signature"))
  143. (&nar-signature-error
  144. (file file) (signature signature) (port port)))))
  145. (hash-mismatch
  146. (raise (condition (&message (message "invalid hash"))
  147. (&nar-invalid-hash-error
  148. (port port) (file file)
  149. (signature signature)
  150. (expected (hash-data->bytevector
  151. (signature-signed-data signature)))
  152. (actual hash)))))
  153. (unauthorized-key
  154. (raise (condition (&message (message "unauthorized public key"))
  155. (&nar-signature-error
  156. (signature signature) (file file) (port port)))))
  157. (corrupt-signature
  158. (raise (condition
  159. (&message (message "corrupt signature data"))
  160. (&nar-signature-error
  161. (signature signature) (file file) (port port))))))))
  162. (define %export-magic
  163. ;; Number used to identify genuine file set archives.
  164. #x4558494e)
  165. (define port*
  166. ;; Keep that one around, for error conditions.
  167. port)
  168. (let-values (((port get-hash)
  169. (open-sha256-input-port port)))
  170. (with-temporary-store-file temp
  171. (restore-file port temp)
  172. (let ((magic (read-int port)))
  173. (unless (= magic %export-magic)
  174. (raise (condition
  175. (&message (message "corrupt file set archive"))
  176. (&nar-read-error
  177. (port port*) (file #f) (token #f))))))
  178. (let ((file (read-store-path port))
  179. (refs (read-store-path-list port))
  180. (deriver (read-string port))
  181. (hash (get-hash))
  182. (has-sig? (= 1 (read-int port))))
  183. (format log-port
  184. (G_ "importing file or directory '~a'...~%")
  185. file)
  186. ;; The signature may contain characters that are meant to be
  187. ;; interpreted as bytes in a 'char *', so read them as a ISO-8859-1.
  188. (let ((sig (and has-sig? (read-latin1-string port))))
  189. (when verify-signature?
  190. (if sig
  191. (begin
  192. (assert-valid-signature sig hash file)
  193. (format log-port
  194. (G_ "found valid signature for '~a'~%")
  195. file)
  196. (finalize-store-file temp file
  197. #:references refs
  198. #:deriver deriver
  199. #:lock? lock?))
  200. (raise (condition
  201. (&message (message "imported file lacks \
  202. a signature"))
  203. (&nar-signature-error
  204. (port port*) (file file) (signature #f))))))
  205. file)))))
  206. (define* (restore-file-set port
  207. #:key (verify-signature? #t) (lock? #t)
  208. (log-port (current-error-port)))
  209. "Restore the file set read from PORT to the store. The format of the data
  210. on PORT must be as created by 'export-paths'---i.e., a series of Nar-formatted
  211. archives with interspersed meta-data joining them together, possibly with a
  212. digital signature at the end. Log progress to LOG-PORT. Return the list of
  213. files restored.
  214. When LOCK? is #f, assume locks for the files to be restored are already held.
  215. This is the case when the daemon calls a build hook.
  216. Note that this procedure accesses the store directly, so it's only meant to be
  217. used by the daemon's build hooks since they cannot call back to the daemon
  218. while the locks are held."
  219. (define acl
  220. (current-acl))
  221. (let loop ((n (read-long-long port))
  222. (files '()))
  223. (case n
  224. ((0)
  225. (reverse files))
  226. ((1)
  227. (let ((file
  228. (restore-one-item port
  229. #:acl acl #:verify-signature? verify-signature?
  230. #:lock? lock? #:log-port log-port)))
  231. (loop (read-long-long port)
  232. (cons file files))))
  233. (else
  234. ;; Neither 0 nor 1.
  235. (raise (condition
  236. (&message (message "invalid inter-file archive mark"))
  237. (&nar-read-error
  238. (port port) (file #f) (token #f))))))))
  239. ;;; Local Variables:
  240. ;;; eval: (put 'with-temporary-store-file 'scheme-indent-function 1)
  241. ;;; End:
  242. ;;; nar.scm ends here