guix/store.scm

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