Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
1a43e4dc | 2 | ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> |
24e262f0 | 3 | ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> |
dc5669cd | 4 | ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> |
0afdc485 | 5 | ;;; |
233e7676 | 6 | ;;; This file is part of GNU Guix. |
0afdc485 | 7 | ;;; |
233e7676 | 8 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
0afdc485 LC |
9 | ;;; under the terms of the GNU General Public License as published by |
10 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
11 | ;;; your option) any later version. | |
12 | ;;; | |
233e7676 | 13 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
0afdc485 LC |
14 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;;; GNU General Public License for more details. | |
17 | ;;; | |
18 | ;;; You should have received a copy of the GNU General Public License | |
233e7676 | 19 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
0afdc485 | 20 | |
e49951eb | 21 | (define-module (guix scripts package) |
cdd5d6f9 | 22 | #:use-module (guix ui) |
0afdc485 LC |
23 | #:use-module (guix store) |
24 | #:use-module (guix derivations) | |
25 | #:use-module (guix packages) | |
cc4ecc2d | 26 | #:use-module (guix profiles) |
0afdc485 | 27 | #:use-module (guix utils) |
a020d2a9 | 28 | #:use-module (guix config) |
dd67b429 | 29 | #:use-module (guix scripts build) |
0ec1af59 | 30 | #:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) |
e3ccdf9e | 31 | #:use-module ((guix ftp-client) #:select (ftp-open)) |
0afdc485 LC |
32 | #:use-module (ice-9 format) |
33 | #:use-module (ice-9 match) | |
34 | #:use-module (ice-9 regex) | |
dc5669cd | 35 | #:use-module (ice-9 vlist) |
0afdc485 LC |
36 | #:use-module (srfi srfi-1) |
37 | #:use-module (srfi srfi-11) | |
2cd09108 | 38 | #:use-module (srfi srfi-19) |
0afdc485 | 39 | #:use-module (srfi srfi-26) |
0afdc485 | 40 | #:use-module (srfi srfi-37) |
59a43334 | 41 | #:use-module (gnu packages) |
1ffa7090 LC |
42 | #:use-module ((gnu packages base) #:select (guile-final)) |
43 | #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) | |
ef010c0f | 44 | #:use-module (guix gnu-maintenance) |
760c60d6 LC |
45 | #:export (specification->package+output |
46 | guix-package)) | |
0afdc485 | 47 | |
0afdc485 | 48 | (define %store |
c4d64534 | 49 | (make-parameter #f)) |
0afdc485 LC |
50 | |
51 | \f | |
52 | ;;; | |
cc4ecc2d | 53 | ;;; Profiles. |
0afdc485 LC |
54 | ;;; |
55 | ||
d595e456 | 56 | (define %user-profile-directory |
0afdc485 LC |
57 | (and=> (getenv "HOME") |
58 | (cut string-append <> "/.guix-profile"))) | |
59 | ||
60 | (define %profile-directory | |
80d0447c | 61 | (string-append %state-directory "/profiles/" |
6879fe23 TUBK |
62 | (or (and=> (or (getenv "USER") |
63 | (getenv "LOGNAME")) | |
0afdc485 LC |
64 | (cut string-append "per-user/" <>)) |
65 | "default"))) | |
66 | ||
67 | (define %current-profile | |
4aa52039 LC |
68 | ;; Call it `guix-profile', not `profile', to allow Guix profiles to |
69 | ;; coexist with Nix profiles. | |
70 | (string-append %profile-directory "/guix-profile")) | |
0afdc485 | 71 | |
88371f0d LC |
72 | (define (canonicalize-profile profile) |
73 | "If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE. Otherwise | |
74 | return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if | |
75 | '-p' was omitted." ; see <http://bugs.gnu.org/17939> | |
76 | (if (and %user-profile-directory | |
77 | (string=? (canonicalize-path (dirname profile)) | |
78 | (dirname %user-profile-directory)) | |
79 | (string=? (basename profile) (basename %user-profile-directory))) | |
80 | %current-profile | |
81 | profile)) | |
82 | ||
64d2e973 NK |
83 | (define (link-to-empty-profile generation) |
84 | "Link GENERATION, a string, to the empty profile." | |
f067fc3e | 85 | (let* ((drv (profile-derivation (%store) (manifest '()))) |
64d2e973 NK |
86 | (prof (derivation->output-path drv "out"))) |
87 | (when (not (build-derivations (%store) (list drv))) | |
88 | (leave (_ "failed to build the empty profile~%"))) | |
89 | ||
90 | (switch-symlinks generation prof))) | |
91 | ||
b7884ca3 NK |
92 | (define (switch-to-previous-generation profile) |
93 | "Atomically switch PROFILE to the previous generation." | |
94 | (let* ((number (generation-number profile)) | |
95 | (previous-number (previous-generation-number profile number)) | |
477d30d0 | 96 | (previous-generation (generation-file-name profile previous-number))) |
b7884ca3 NK |
97 | (format #t (_ "switching from generation ~a to ~a~%") |
98 | number previous-number) | |
99 | (switch-symlinks profile previous-generation))) | |
100 | ||
24e262f0 LC |
101 | (define (roll-back profile) |
102 | "Roll back to the previous generation of PROFILE." | |
1b0a8212 NK |
103 | (let* ((number (generation-number profile)) |
104 | (previous-number (previous-generation-number profile number)) | |
477d30d0 | 105 | (previous-generation (generation-file-name profile previous-number)) |
1b0a8212 | 106 | (manifest (string-append previous-generation "/manifest"))) |
b7884ca3 NK |
107 | (cond ((not (file-exists? profile)) ; invalid profile |
108 | (leave (_ "profile '~a' does not exist~%") | |
a2011be5 | 109 | profile)) |
b7884ca3 | 110 | ((zero? number) ; empty profile |
c31d1a78 LC |
111 | (format (current-error-port) |
112 | (_ "nothing to do: already at the empty profile~%"))) | |
b7884ca3 | 113 | ((or (zero? previous-number) ; going to emptiness |
1b0a8212 | 114 | (not (file-exists? previous-generation))) |
64d2e973 | 115 | (link-to-empty-profile previous-generation) |
b7884ca3 NK |
116 | (switch-to-previous-generation profile)) |
117 | (else | |
118 | (switch-to-previous-generation profile))))) ; anything else | |
24e262f0 | 119 | |
d7ddb257 LC |
120 | (define* (matching-generations str #:optional (profile %current-profile) |
121 | #:key (duration-relation <=)) | |
2cd09108 | 122 | "Return the list of available generations matching a pattern in STR. See |
d7ddb257 LC |
123 | 'string->generations' and 'string->duration' for the list of valid patterns. |
124 | When STR is a duration pattern, return all the generations whose ctime has | |
125 | DURATION-RELATION with the current time." | |
2cd09108 NK |
126 | (define (valid-generations lst) |
127 | (define (valid-generation? n) | |
128 | (any (cut = n <>) (generation-numbers profile))) | |
129 | ||
130 | (fold-right (lambda (x acc) | |
131 | (if (valid-generation? x) | |
132 | (cons x acc) | |
133 | acc)) | |
134 | '() | |
135 | lst)) | |
136 | ||
137 | (define (filter-generations generations) | |
138 | (match generations | |
139 | (() '()) | |
140 | (('>= n) | |
141 | (drop-while (cut > n <>) | |
142 | (generation-numbers profile))) | |
143 | (('<= n) | |
144 | (valid-generations (iota n 1))) | |
145 | ((lst ..1) | |
146 | (valid-generations lst)) | |
147 | (_ #f))) | |
148 | ||
149 | (define (filter-by-duration duration) | |
150 | (define (time-at-midnight time) | |
151 | ;; Return TIME at midnight by setting nanoseconds, seconds, minutes, and | |
152 | ;; hours to zeros. | |
153 | (let ((d (time-utc->date time))) | |
154 | (date->time-utc | |
155 | (make-date 0 0 0 0 | |
156 | (date-day d) (date-month d) | |
157 | (date-year d) (date-zone-offset d))))) | |
158 | ||
159 | (define generation-ctime-alist | |
160 | (map (lambda (number) | |
161 | (cons number | |
162 | (time-second | |
163 | (time-at-midnight | |
164 | (generation-time profile number))))) | |
165 | (generation-numbers profile))) | |
166 | ||
167 | (match duration | |
168 | (#f #f) | |
169 | (res | |
170 | (let ((s (time-second | |
171 | (subtract-duration (time-at-midnight (current-time)) | |
172 | duration)))) | |
173 | (delete #f (map (lambda (x) | |
d7ddb257 | 174 | (and (duration-relation s (cdr x)) |
2cd09108 NK |
175 | (first x))) |
176 | generation-ctime-alist)))))) | |
177 | ||
178 | (cond ((string->generations str) | |
179 | => | |
180 | filter-generations) | |
181 | ((string->duration str) | |
182 | => | |
183 | filter-by-duration) | |
184 | (else #f))) | |
185 | ||
cc4ecc2d LC |
186 | (define (show-what-to-remove/install remove install dry-run?) |
187 | "Given the manifest entries listed in REMOVE and INSTALL, display the | |
188 | packages that will/would be installed and removed." | |
189 | ;; TODO: Report upgrades more clearly. | |
190 | (match remove | |
45b418d6 | 191 | ((($ <manifest-entry> name version output path _) ..1) |
cc4ecc2d | 192 | (let ((len (length name)) |
512314d7 | 193 | (remove (map (cut format #f " ~a-~a\t~a\t~a" <> <> <> <>) |
45b418d6 | 194 | name version output path))) |
cc4ecc2d LC |
195 | (if dry-run? |
196 | (format (current-error-port) | |
1b5ba6b1 LC |
197 | (N_ "The following package would be removed:~%~{~a~%~}~%" |
198 | "The following packages would be removed:~%~{~a~%~}~%" | |
cc4ecc2d LC |
199 | len) |
200 | remove) | |
201 | (format (current-error-port) | |
1b5ba6b1 LC |
202 | (N_ "The following package will be removed:~%~{~a~%~}~%" |
203 | "The following packages will be removed:~%~{~a~%~}~%" | |
cc4ecc2d LC |
204 | len) |
205 | remove)))) | |
206 | (_ #f)) | |
207 | (match install | |
208 | ((($ <manifest-entry> name version output path _) ..1) | |
209 | (let ((len (length name)) | |
210 | (install (map (cut format #f " ~a-~a\t~a\t~a" <> <> <> <>) | |
211 | name version output path))) | |
212 | (if dry-run? | |
213 | (format (current-error-port) | |
214 | (N_ "The following package would be installed:~%~{~a~%~}~%" | |
215 | "The following packages would be installed:~%~{~a~%~}~%" | |
216 | len) | |
217 | install) | |
218 | (format (current-error-port) | |
219 | (N_ "The following package will be installed:~%~{~a~%~}~%" | |
220 | "The following packages will be installed:~%~{~a~%~}~%" | |
221 | len) | |
222 | install)))) | |
223 | (_ #f))) | |
224 | ||
225 | \f | |
226 | ;;; | |
227 | ;;; Package specifications. | |
228 | ;;; | |
229 | ||
acc08466 | 230 | (define (find-packages-by-description rx) |
b2ba65c8 LC |
231 | "Return the list of packages whose name, synopsis, or description matches |
232 | RX." | |
acc08466 NK |
233 | (define (same-location? p1 p2) |
234 | ;; Compare locations of two packages. | |
235 | (equal? (package-location p1) (package-location p2))) | |
236 | ||
237 | (delete-duplicates | |
238 | (sort | |
239 | (fold-packages (lambda (package result) | |
240 | (define matches? | |
241 | (cut regexp-exec rx <>)) | |
242 | ||
ee764179 | 243 | (if (or (matches? (package-name package)) |
b2ba65c8 | 244 | (and=> (package-synopsis package) |
ee764179 | 245 | (compose matches? P_)) |
acc08466 | 246 | (and=> (package-description package) |
ee764179 | 247 | (compose matches? P_))) |
acc08466 NK |
248 | (cons package result) |
249 | result)) | |
250 | '()) | |
251 | (lambda (p1 p2) | |
252 | (string<? (package-name p1) | |
253 | (package-name p2)))) | |
254 | same-location?)) | |
255 | ||
4dede022 LC |
256 | (define (input->name+path input) |
257 | "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple." | |
258 | (let loop ((input input)) | |
259 | (match input | |
94a4b3b9 | 260 | ((name (? package? package)) |
4dede022 | 261 | (loop `(,name ,package "out"))) |
94a4b3b9 LC |
262 | ((name (? package? package) sub-drv) |
263 | `(,name ,(package-output (%store) package sub-drv))) | |
264 | (_ | |
265 | input)))) | |
4dede022 | 266 | |
b52cb20d LC |
267 | (define %sigint-prompt |
268 | ;; The prompt to jump to upon SIGINT. | |
269 | (make-prompt-tag "interruptible")) | |
270 | ||
271 | (define (call-with-sigint-handler thunk handler) | |
272 | "Call THUNK and return its value. Upon SIGINT, call HANDLER with the signal | |
273 | number in the context of the continuation of the call to this function, and | |
274 | return its return value." | |
275 | (call-with-prompt %sigint-prompt | |
276 | (lambda () | |
277 | (sigaction SIGINT | |
278 | (lambda (signum) | |
279 | (sigaction SIGINT SIG_DFL) | |
280 | (abort-to-prompt %sigint-prompt signum))) | |
90a1e4b3 LC |
281 | (dynamic-wind |
282 | (const #t) | |
283 | thunk | |
284 | (cut sigaction SIGINT SIG_DFL))) | |
b52cb20d LC |
285 | (lambda (k signum) |
286 | (handler signum)))) | |
287 | ||
ef010c0f LC |
288 | (define-syntax-rule (waiting exp fmt rest ...) |
289 | "Display the given message while EXP is being evaluated." | |
290 | (let* ((message (format #f fmt rest ...)) | |
291 | (blank (make-string (string-length message) #\space))) | |
292 | (display message (current-error-port)) | |
293 | (force-output (current-error-port)) | |
b52cb20d LC |
294 | (call-with-sigint-handler |
295 | (lambda () | |
91fe0e20 LC |
296 | (dynamic-wind |
297 | (const #f) | |
298 | (lambda () exp) | |
299 | (lambda () | |
300 | ;; Clear the line. | |
301 | (display #\cr (current-error-port)) | |
302 | (display blank (current-error-port)) | |
303 | (display #\cr (current-error-port)) | |
304 | (force-output (current-error-port))))) | |
b52cb20d LC |
305 | (lambda (signum) |
306 | (format (current-error-port) " interrupted by signal ~a~%" SIGINT) | |
307 | #f)))) | |
ef010c0f | 308 | |
1a43e4dc LC |
309 | (define-syntax-rule (leave-on-EPIPE exp ...) |
310 | "Run EXP... in a context when EPIPE errors are caught and lead to 'exit' | |
311 | with successful exit code. This is useful when writing to the standard output | |
312 | may lead to EPIPE, because the standard output is piped through 'head' or | |
313 | similar." | |
314 | (catch 'system-error | |
315 | (lambda () | |
316 | exp ...) | |
317 | (lambda args | |
318 | ;; We really have to exit this brutally, otherwise Guile eventually | |
319 | ;; attempts to flush all the ports, leading to an uncaught EPIPE down | |
320 | ;; the path. | |
321 | (if (= EPIPE (system-error-errno args)) | |
322 | (primitive-_exit 0) | |
323 | (apply throw args))))) | |
324 | ||
edac8846 | 325 | (define* (specification->package+output spec #:optional (output "out")) |
760c60d6 | 326 | "Return the package and output specified by SPEC, or #f and #f; SPEC may |
edac8846 | 327 | optionally contain a version number and an output name, as in these examples: |
d46d8794 | 328 | |
edac8846 LC |
329 | guile |
330 | guile-2.0.9 | |
331 | guile:debug | |
332 | guile-2.0.9:debug | |
333 | ||
334 | If SPEC does not specify a version number, return the preferred newest | |
335 | version; if SPEC does not specify an output, return OUTPUT." | |
d46d8794 LC |
336 | (define (ensure-output p sub-drv) |
337 | (if (member sub-drv (package-outputs p)) | |
edac8846 | 338 | sub-drv |
d46d8794 LC |
339 | (leave (_ "package `~a' lacks output `~a'~%") |
340 | (package-full-name p) | |
341 | sub-drv))) | |
342 | ||
2876b989 | 343 | (let-values (((name version sub-drv) |
b874f305 | 344 | (package-specification->name+version+output spec output))) |
d46d8794 LC |
345 | (match (find-best-packages-by-name name version) |
346 | ((p) | |
edac8846 | 347 | (values p (ensure-output p sub-drv))) |
d46d8794 LC |
348 | ((p p* ...) |
349 | (warning (_ "ambiguous package specification `~a'~%") | |
edac8846 | 350 | spec) |
d46d8794 LC |
351 | (warning (_ "choosing ~a from ~a~%") |
352 | (package-full-name p) | |
353 | (location->string (package-location p))) | |
edac8846 | 354 | (values p (ensure-output p sub-drv))) |
d46d8794 | 355 | (() |
edac8846 | 356 | (leave (_ "~a: package not found~%") spec))))) |
d46d8794 LC |
357 | |
358 | (define (upgradeable? name current-version current-path) | |
359 | "Return #t if there's a version of package NAME newer than CURRENT-VERSION, | |
360 | or if the newest available version is equal to CURRENT-VERSION but would have | |
361 | an output path different than CURRENT-PATH." | |
3f26bfc1 | 362 | (match (vhash-assoc name (find-newest-available-packages)) |
d46d8794 LC |
363 | ((_ candidate-version pkg . rest) |
364 | (case (version-compare candidate-version current-version) | |
365 | ((>) #t) | |
366 | ((<) #f) | |
367 | ((=) (let ((candidate-path (derivation->output-path | |
368 | (package-derivation (%store) pkg)))) | |
369 | (not (string=? current-path candidate-path)))))) | |
370 | (#f #f))) | |
371 | ||
e3ccdf9e LC |
372 | (define ftp-open* |
373 | ;; Memoizing version of `ftp-open'. The goal is to avoid initiating a new | |
374 | ;; FTP connection for each package, esp. since most of them are to the same | |
375 | ;; server. This has a noticeable impact when doing "guix upgrade -u". | |
376 | (memoize ftp-open)) | |
377 | ||
ef010c0f LC |
378 | (define (check-package-freshness package) |
379 | "Check whether PACKAGE has a newer version available upstream, and report | |
380 | it." | |
381 | ;; TODO: Automatically inject the upstream version when desired. | |
19777ae6 LC |
382 | |
383 | (catch #t | |
384 | (lambda () | |
993fb66d | 385 | (when (false-if-exception (gnu-package? package)) |
19777ae6 LC |
386 | (let ((name (package-name package)) |
387 | (full-name (package-full-name package))) | |
e3ccdf9e LC |
388 | (match (waiting (latest-release name |
389 | #:ftp-open ftp-open* | |
390 | #:ftp-close (const #f)) | |
19777ae6 LC |
391 | (_ "looking for the latest release of GNU ~a...") name) |
392 | ((latest-version . _) | |
393 | (when (version>? latest-version full-name) | |
394 | (format (current-error-port) | |
395 | (_ "~a: note: using ~a \ | |
ef010c0f | 396 | but ~a is available upstream~%") |
19777ae6 LC |
397 | (location->string (package-location package)) |
398 | full-name latest-version))) | |
399 | (_ #t))))) | |
400 | (lambda (key . args) | |
401 | ;; Silently ignore networking errors rather than preventing | |
402 | ;; installation. | |
403 | (case key | |
404 | ((getaddrinfo-error ftp-error) #f) | |
405 | (else (apply throw key args)))))) | |
ef010c0f | 406 | |
d46d8794 LC |
407 | \f |
408 | ;;; | |
409 | ;;; Search paths. | |
410 | ;;; | |
411 | ||
f067fc3e | 412 | (define* (search-path-environment-variables entries profile |
5924080d LC |
413 | #:optional (getenv getenv)) |
414 | "Return environment variable definitions that may be needed for the use of | |
f067fc3e LC |
415 | ENTRIES, a list of manifest entries, in PROFILE. Use GETENV to determine the |
416 | current settings and report only settings not already effective." | |
5924080d | 417 | |
a81bc531 | 418 | ;; Prefer ~/.guix-profile to the real profile directory name. |
d595e456 | 419 | (let ((profile (if (and %user-profile-directory |
a81bc531 | 420 | (false-if-exception |
d595e456 | 421 | (string=? (readlink %user-profile-directory) |
a81bc531 | 422 | profile))) |
d595e456 | 423 | %user-profile-directory |
a81bc531 LC |
424 | profile))) |
425 | ||
426 | ;; The search path info is not stored in the manifest. Thus, we infer the | |
427 | ;; search paths from same-named packages found in the distro. | |
428 | ||
f067fc3e | 429 | (define manifest-entry->package |
a81bc531 | 430 | (match-lambda |
f067fc3e | 431 | (($ <manifest-entry> name version) |
27c68457 LC |
432 | ;; Use 'find-best-packages-by-name' and not 'find-packages-by-name'; |
433 | ;; the former traverses the module tree only once and then allows for | |
434 | ;; efficient access via a vhash. | |
435 | (match (or (find-best-packages-by-name name version) | |
436 | (find-best-packages-by-name name #f)) | |
a81bc531 LC |
437 | ((p _ ...) p) |
438 | (_ #f))))) | |
439 | ||
440 | (define search-path-definition | |
441 | (match-lambda | |
442 | (($ <search-path-specification> variable directories separator) | |
443 | (let ((values (or (and=> (getenv variable) | |
444 | (cut string-tokenize* <> separator)) | |
445 | '())) | |
446 | (directories (filter file-exists? | |
447 | (map (cut string-append profile | |
448 | "/" <>) | |
449 | directories)))) | |
450 | (if (every (cut member <> values) directories) | |
451 | #f | |
452 | (format #f "export ~a=\"~a\"" | |
453 | variable | |
454 | (string-join directories separator))))))) | |
455 | ||
f067fc3e | 456 | (let* ((packages (filter-map manifest-entry->package entries)) |
a81bc531 LC |
457 | (search-paths (delete-duplicates |
458 | (append-map package-native-search-paths | |
459 | packages)))) | |
460 | (filter-map search-path-definition search-paths)))) | |
5924080d | 461 | |
f067fc3e | 462 | (define (display-search-paths entries profile) |
5924080d | 463 | "Display the search path environment variables that may need to be set for |
f067fc3e LC |
464 | ENTRIES, a list of manifest entries, in the context of PROFILE." |
465 | (let ((settings (search-path-environment-variables entries profile))) | |
5924080d LC |
466 | (unless (null? settings) |
467 | (format #t (_ "The following environment variable definitions may be needed:~%")) | |
a81bc531 | 468 | (format #t "~{ ~a~%~}" settings)))) |
5924080d | 469 | |
0afdc485 LC |
470 | \f |
471 | ;;; | |
472 | ;;; Command-line options. | |
473 | ;;; | |
474 | ||
475 | (define %default-options | |
476 | ;; Alist of default option values. | |
3b824605 | 477 | `((profile . ,%current-profile) |
969e678e | 478 | (max-silent-time . 3600) |
dd67b429 | 479 | (verbosity . 0) |
3b824605 | 480 | (substitutes? . #t))) |
0afdc485 | 481 | |
0afdc485 | 482 | (define (show-help) |
e49951eb | 483 | (display (_ "Usage: guix package [OPTION]... PACKAGES... |
0afdc485 LC |
484 | Install, remove, or upgrade PACKAGES in a single transaction.\n")) |
485 | (display (_ " | |
486 | -i, --install=PACKAGE install PACKAGE")) | |
487 | (display (_ " | |
5d4b411f LC |
488 | -e, --install-from-expression=EXP |
489 | install the package EXP evaluates to")) | |
490 | (display (_ " | |
0afdc485 LC |
491 | -r, --remove=PACKAGE remove PACKAGE")) |
492 | (display (_ " | |
acb6ba25 | 493 | -u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP")) |
24e262f0 LC |
494 | (display (_ " |
495 | --roll-back roll back to the previous generation")) | |
5924080d LC |
496 | (display (_ " |
497 | --search-paths display needed environment variable definitions")) | |
2cd09108 NK |
498 | (display (_ " |
499 | -l, --list-generations[=PATTERN] | |
500 | list generations matching PATTERN")) | |
b7884ca3 NK |
501 | (display (_ " |
502 | -d, --delete-generations[=PATTERN] | |
503 | delete generations matching PATTERN")) | |
0afdc485 LC |
504 | (display (_ " |
505 | -p, --profile=PROFILE use PROFILE instead of the user's default profile")) | |
dd67b429 | 506 | (newline) |
0afdc485 | 507 | (display (_ " |
cc57f25d | 508 | --bootstrap use the bootstrap Guile to build the profile")) |
70915c1a LC |
509 | (display (_ " |
510 | --verbose produce verbose output")) | |
0afdc485 LC |
511 | (newline) |
512 | (display (_ " | |
acc08466 NK |
513 | -s, --search=REGEXP search in synopsis and description using REGEXP")) |
514 | (display (_ " | |
733b4130 LC |
515 | -I, --list-installed[=REGEXP] |
516 | list installed packages matching REGEXP")) | |
64fc89b6 LC |
517 | (display (_ " |
518 | -A, --list-available[=REGEXP] | |
519 | list available packages matching REGEXP")) | |
733b4130 | 520 | (newline) |
dd67b429 LC |
521 | (show-build-options-help) |
522 | (newline) | |
733b4130 | 523 | (display (_ " |
0afdc485 LC |
524 | -h, --help display this help and exit")) |
525 | (display (_ " | |
526 | -V, --version display version information and exit")) | |
527 | (newline) | |
3441e164 | 528 | (show-bug-report-information)) |
0afdc485 LC |
529 | |
530 | (define %options | |
531 | ;; Specification of the command-line options. | |
dd67b429 LC |
532 | (cons* (option '(#\h "help") #f #f |
533 | (lambda args | |
534 | (show-help) | |
535 | (exit 0))) | |
536 | (option '(#\V "version") #f #f | |
537 | (lambda args | |
538 | (show-version-and-exit "guix package"))) | |
539 | ||
540 | (option '(#\i "install") #f #t | |
541 | (lambda (opt name arg result arg-handler) | |
542 | (let arg-handler ((arg arg) (result result)) | |
543 | (values (if arg | |
544 | (alist-cons 'install arg result) | |
545 | result) | |
546 | arg-handler)))) | |
547 | (option '(#\e "install-from-expression") #t #f | |
548 | (lambda (opt name arg result arg-handler) | |
549 | (values (alist-cons 'install (read/eval-package-expression arg) | |
550 | result) | |
551 | #f))) | |
552 | (option '(#\r "remove") #f #t | |
553 | (lambda (opt name arg result arg-handler) | |
554 | (let arg-handler ((arg arg) (result result)) | |
555 | (values (if arg | |
556 | (alist-cons 'remove arg result) | |
557 | result) | |
558 | arg-handler)))) | |
559 | (option '(#\u "upgrade") #f #t | |
560 | (lambda (opt name arg result arg-handler) | |
561 | (let arg-handler ((arg arg) (result result)) | |
562 | (values (alist-cons 'upgrade arg | |
563 | ;; Delete any prior "upgrade all" | |
564 | ;; command, or else "--upgrade gcc" | |
565 | ;; would upgrade everything. | |
566 | (delete '(upgrade . #f) result)) | |
567 | arg-handler)))) | |
568 | (option '("roll-back") #f #f | |
569 | (lambda (opt name arg result arg-handler) | |
570 | (values (alist-cons 'roll-back? #t result) | |
571 | #f))) | |
572 | (option '(#\l "list-generations") #f #t | |
573 | (lambda (opt name arg result arg-handler) | |
574 | (values (cons `(query list-generations ,(or arg "")) | |
575 | result) | |
576 | #f))) | |
577 | (option '(#\d "delete-generations") #f #t | |
578 | (lambda (opt name arg result arg-handler) | |
579 | (values (alist-cons 'delete-generations (or arg "") | |
580 | result) | |
581 | #f))) | |
582 | (option '("search-paths") #f #f | |
583 | (lambda (opt name arg result arg-handler) | |
584 | (values (cons `(query search-paths) result) | |
585 | #f))) | |
586 | (option '(#\p "profile") #t #f | |
587 | (lambda (opt name arg result arg-handler) | |
88371f0d | 588 | (values (alist-cons 'profile (canonicalize-profile arg) |
dd67b429 LC |
589 | (alist-delete 'profile result)) |
590 | #f))) | |
591 | (option '(#\n "dry-run") #f #f | |
592 | (lambda (opt name arg result arg-handler) | |
593 | (values (alist-cons 'dry-run? #t result) | |
594 | #f))) | |
595 | (option '("bootstrap") #f #f | |
596 | (lambda (opt name arg result arg-handler) | |
597 | (values (alist-cons 'bootstrap? #t result) | |
598 | #f))) | |
599 | (option '("verbose") #f #f | |
600 | (lambda (opt name arg result arg-handler) | |
601 | (values (alist-cons 'verbose? #t result) | |
602 | #f))) | |
603 | (option '(#\s "search") #t #f | |
604 | (lambda (opt name arg result arg-handler) | |
605 | (values (cons `(query search ,(or arg "")) | |
606 | result) | |
607 | #f))) | |
608 | (option '(#\I "list-installed") #f #t | |
609 | (lambda (opt name arg result arg-handler) | |
610 | (values (cons `(query list-installed ,(or arg "")) | |
611 | result) | |
612 | #f))) | |
613 | (option '(#\A "list-available") #f #t | |
614 | (lambda (opt name arg result arg-handler) | |
615 | (values (cons `(query list-available ,(or arg "")) | |
616 | result) | |
617 | #f))) | |
618 | ||
619 | %standard-build-options)) | |
0afdc485 | 620 | |
f067fc3e LC |
621 | (define (options->installable opts manifest) |
622 | "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold', | |
1fcc3ba3 LC |
623 | return the new list of manifest entries." |
624 | (define (deduplicate deps) | |
625 | ;; Remove duplicate entries from DEPS, a list of propagated inputs, where | |
626 | ;; each input is a name/path tuple. | |
edac8846 LC |
627 | (define (same? d1 d2) |
628 | (match d1 | |
629 | ((_ p1) | |
630 | (match d2 | |
631 | ((_ p2) (eq? p1 p2)) | |
632 | (_ #f))) | |
633 | ((_ p1 out1) | |
634 | (match d2 | |
635 | ((_ p2 out2) | |
636 | (and (string=? out1 out2) | |
637 | (eq? p1 p2))) | |
638 | (_ #f))))) | |
639 | ||
1fcc3ba3 | 640 | (delete-duplicates deps same?)) |
f067fc3e LC |
641 | |
642 | (define (package->manifest-entry p output) | |
643 | ;; Return a manifest entry for the OUTPUT of package P. | |
644 | (check-package-freshness p) | |
edac8846 LC |
645 | ;; When given a package via `-e', install the first of its |
646 | ;; outputs (XXX). | |
edac8846 LC |
647 | (let* ((output (or output (car (package-outputs p)))) |
648 | (path (package-output (%store) p output)) | |
1fcc3ba3 | 649 | (deps (deduplicate (package-transitive-propagated-inputs p)))) |
f067fc3e LC |
650 | (manifest-entry |
651 | (name (package-name p)) | |
652 | (version (package-version p)) | |
653 | (output output) | |
654 | (path path) | |
1fcc3ba3 LC |
655 | (dependencies (map input->name+path deps)) |
656 | (inputs (cons (list (package-name p) p output) | |
657 | deps))))) | |
edac8846 LC |
658 | |
659 | (define upgrade-regexps | |
660 | (filter-map (match-lambda | |
661 | (('upgrade . regexp) | |
662 | (make-regexp (or regexp ""))) | |
663 | (_ #f)) | |
664 | opts)) | |
665 | ||
666 | (define packages-to-upgrade | |
667 | (match upgrade-regexps | |
668 | (() | |
669 | '()) | |
670 | ((_ ...) | |
671 | (let ((newest (find-newest-available-packages))) | |
672 | (filter-map (match-lambda | |
f067fc3e | 673 | (($ <manifest-entry> name version output path _) |
edac8846 LC |
674 | (and (any (cut regexp-exec <> name) |
675 | upgrade-regexps) | |
676 | (upgradeable? name version path) | |
677 | (let ((output (or output "out"))) | |
678 | (call-with-values | |
679 | (lambda () | |
680 | (specification->package+output name output)) | |
681 | list)))) | |
682 | (_ #f)) | |
f067fc3e | 683 | (manifest-entries manifest)))))) |
edac8846 LC |
684 | |
685 | (define to-upgrade | |
686 | (map (match-lambda | |
687 | ((package output) | |
f067fc3e | 688 | (package->manifest-entry package output))) |
edac8846 LC |
689 | packages-to-upgrade)) |
690 | ||
691 | (define packages-to-install | |
692 | (filter-map (match-lambda | |
693 | (('install . (? package? p)) | |
694 | (list p "out")) | |
695 | (('install . (? string? spec)) | |
696 | (and (not (store-path? spec)) | |
697 | (let-values (((package output) | |
698 | (specification->package+output spec))) | |
699 | (and package (list package output))))) | |
700 | (_ #f)) | |
701 | opts)) | |
702 | ||
703 | (define to-install | |
704 | (append (map (match-lambda | |
705 | ((package output) | |
f067fc3e | 706 | (package->manifest-entry package output))) |
edac8846 LC |
707 | packages-to-install) |
708 | (filter-map (match-lambda | |
709 | (('install . (? package?)) | |
710 | #f) | |
711 | (('install . (? store-path? path)) | |
712 | (let-values (((name version) | |
713 | (package-name->name+version | |
714 | (store-path-package-name path)))) | |
f067fc3e LC |
715 | (manifest-entry |
716 | (name name) | |
717 | (version version) | |
718 | (output #f) | |
719 | (path path)))) | |
edac8846 LC |
720 | (_ #f)) |
721 | opts))) | |
722 | ||
1fcc3ba3 | 723 | (append to-upgrade to-install)) |
edac8846 | 724 | |
537630c5 | 725 | (define (options->removable options manifest) |
a2078770 LC |
726 | "Given options, return the list of manifest patterns of packages to be |
727 | removed from MANIFEST." | |
728 | (filter-map (match-lambda | |
729 | (('remove . spec) | |
730 | (call-with-values | |
731 | (lambda () | |
732 | (package-specification->name+version+output spec)) | |
733 | (lambda (name version output) | |
734 | (manifest-pattern | |
735 | (name name) | |
736 | (version version) | |
737 | (output output))))) | |
738 | (_ #f)) | |
739 | options)) | |
537630c5 | 740 | |
d2952326 LC |
741 | (define (maybe-register-gc-root store profile) |
742 | "Register PROFILE as a GC root, unless it doesn't need it." | |
743 | (unless (string=? profile %current-profile) | |
744 | (add-indirect-root store (canonicalize-path profile)))) | |
745 | ||
0afdc485 LC |
746 | \f |
747 | ;;; | |
748 | ;;; Entry point. | |
749 | ;;; | |
750 | ||
751 | (define (guix-package . args) | |
752 | (define (parse-options) | |
753 | ;; Return the alist of option values. | |
a5975ced | 754 | (args-fold* args %options |
6447738c | 755 | (lambda (opt name arg result arg-handler) |
a5975ced | 756 | (leave (_ "~A: unrecognized option~%") name)) |
6447738c MW |
757 | (lambda (arg result arg-handler) |
758 | (if arg-handler | |
759 | (arg-handler arg result) | |
760 | (leave (_ "~A: extraneous argument~%") arg))) | |
761 | %default-options | |
762 | #f)) | |
0afdc485 | 763 | |
9762706b LC |
764 | (define (guile-missing?) |
765 | ;; Return #t if %GUILE-FOR-BUILD is not available yet. | |
59688fc4 | 766 | (let ((out (derivation->output-path (%guile-for-build)))) |
c4d64534 | 767 | (not (valid-path? (%store) out)))) |
9762706b | 768 | |
0ec1af59 | 769 | (define (ensure-default-profile) |
70c43291 LC |
770 | ;; Ensure the default profile symlink and directory exist and are |
771 | ;; writable. | |
772 | ||
773 | (define (rtfm) | |
774 | (format (current-error-port) | |
775 | (_ "Try \"info '(guix) Invoking guix package'\" for \ | |
776 | more information.~%")) | |
777 | (exit 1)) | |
0ec1af59 LC |
778 | |
779 | ;; Create ~/.guix-profile if it doesn't exist yet. | |
d595e456 | 780 | (when (and %user-profile-directory |
0ec1af59 LC |
781 | %current-profile |
782 | (not (false-if-exception | |
d595e456 LC |
783 | (lstat %user-profile-directory)))) |
784 | (symlink %current-profile %user-profile-directory)) | |
0ec1af59 | 785 | |
70c43291 LC |
786 | (let ((s (stat %profile-directory #f))) |
787 | ;; Attempt to create /…/profiles/per-user/$USER if needed. | |
788 | (unless (and s (eq? 'directory (stat:type s))) | |
789 | (catch 'system-error | |
790 | (lambda () | |
791 | (mkdir-p %profile-directory)) | |
792 | (lambda args | |
793 | ;; Often, we cannot create %PROFILE-DIRECTORY because its | |
794 | ;; parent directory is root-owned and we're running | |
795 | ;; unprivileged. | |
796 | (format (current-error-port) | |
797 | (_ "error: while creating directory `~a': ~a~%") | |
798 | %profile-directory | |
799 | (strerror (system-error-errno args))) | |
800 | (format (current-error-port) | |
801 | (_ "Please create the `~a' directory, with you as the owner.~%") | |
802 | %profile-directory) | |
803 | (rtfm)))) | |
804 | ||
805 | ;; Bail out if it's not owned by the user. | |
cba363be | 806 | (unless (or (not s) (= (stat:uid s) (getuid))) |
70c43291 LC |
807 | (format (current-error-port) |
808 | (_ "error: directory `~a' is not owned by you~%") | |
809 | %profile-directory) | |
810 | (format (current-error-port) | |
811 | (_ "Please change the owner of `~a' to user ~s.~%") | |
6879fe23 TUBK |
812 | %profile-directory (or (getenv "USER") |
813 | (getenv "LOGNAME") | |
814 | (getuid))) | |
70c43291 | 815 | (rtfm)))) |
0ec1af59 | 816 | |
733b4130 LC |
817 | (define (process-actions opts) |
818 | ;; Process any install/remove/upgrade action from OPTS. | |
24e262f0 LC |
819 | |
820 | (define dry-run? (assoc-ref opts 'dry-run?)) | |
821 | (define verbose? (assoc-ref opts 'verbose?)) | |
822 | (define profile (assoc-ref opts 'profile)) | |
823 | ||
f067fc3e LC |
824 | (define (same-package? entry name output) |
825 | (match entry | |
826 | (($ <manifest-entry> entry-name _ entry-output _ ...) | |
827 | (and (equal? name entry-name) | |
828 | (equal? output entry-output))))) | |
079d1273 | 829 | |
b7884ca3 NK |
830 | (define current-generation-number |
831 | (generation-number profile)) | |
832 | ||
833 | (define (display-and-delete number) | |
477d30d0 | 834 | (let ((generation (generation-file-name profile number))) |
b7884ca3 NK |
835 | (unless (zero? number) |
836 | (format #t (_ "deleting ~a~%") generation) | |
837 | (delete-file generation)))) | |
838 | ||
839 | (define (delete-generation number) | |
840 | (let* ((previous-number (previous-generation-number profile number)) | |
477d30d0 LC |
841 | (previous-generation |
842 | (generation-file-name profile previous-number))) | |
b7884ca3 NK |
843 | (cond ((zero? number)) ; do not delete generation 0 |
844 | ((and (= number current-generation-number) | |
845 | (not (file-exists? previous-generation))) | |
846 | (link-to-empty-profile previous-generation) | |
847 | (switch-to-previous-generation profile) | |
848 | (display-and-delete number)) | |
849 | ((= number current-generation-number) | |
850 | (roll-back profile) | |
851 | (display-and-delete number)) | |
852 | (else | |
853 | (display-and-delete number))))) | |
854 | ||
24e262f0 | 855 | ;; First roll back if asked to. |
b7884ca3 NK |
856 | (cond ((and (assoc-ref opts 'roll-back?) (not dry-run?)) |
857 | (begin | |
858 | (roll-back profile) | |
859 | (process-actions (alist-delete 'roll-back? opts)))) | |
860 | ((and (assoc-ref opts 'delete-generations) | |
861 | (not dry-run?)) | |
862 | (filter-map | |
863 | (match-lambda | |
864 | (('delete-generations . pattern) | |
865 | (cond ((not (file-exists? profile)) ; XXX: race condition | |
866 | (leave (_ "profile '~a' does not exist~%") | |
867 | profile)) | |
868 | ((string-null? pattern) | |
869 | (let ((numbers (generation-numbers profile))) | |
870 | (if (equal? numbers '(0)) | |
871 | (exit 0) | |
872 | (for-each display-and-delete | |
873 | (delete current-generation-number | |
874 | numbers))))) | |
875 | ;; Do not delete the zeroth generation. | |
876 | ((equal? 0 (string->number pattern)) | |
877 | (exit 0)) | |
d7ddb257 LC |
878 | |
879 | ;; If PATTERN is a duration, match generations that are | |
880 | ;; older than the specified duration. | |
881 | ((matching-generations pattern profile | |
882 | #:duration-relation >) | |
b7884ca3 NK |
883 | => |
884 | (lambda (numbers) | |
885 | (if (null-list? numbers) | |
886 | (exit 1) | |
887 | (for-each delete-generation numbers)))) | |
888 | (else | |
889 | (leave (_ "invalid syntax: ~a~%") | |
890 | pattern))) | |
891 | ||
892 | (process-actions | |
893 | (alist-delete 'delete-generations opts))) | |
894 | (_ #f)) | |
895 | opts)) | |
896 | (else | |
1fcc3ba3 | 897 | (let* ((manifest (profile-manifest profile)) |
537630c5 LC |
898 | (install (options->installable opts manifest)) |
899 | (remove (options->removable opts manifest)) | |
1fcc3ba3 | 900 | (entries |
537630c5 | 901 | (append install |
1fcc3ba3 LC |
902 | (fold (lambda (package result) |
903 | (match package | |
904 | (($ <manifest-entry> name _ out _ ...) | |
905 | (filter (negate | |
906 | (cut same-package? <> | |
907 | name out)) | |
908 | result)))) | |
909 | (manifest-entries | |
910 | (manifest-remove manifest remove)) | |
537630c5 | 911 | install))) |
1fcc3ba3 LC |
912 | (new (make-manifest entries))) |
913 | ||
914 | (when (equal? profile %current-profile) | |
915 | (ensure-default-profile)) | |
916 | ||
917 | (if (manifest=? new manifest) | |
918 | (format (current-error-port) (_ "nothing to be done~%")) | |
a2078770 LC |
919 | (let ((prof-drv (profile-derivation (%store) new)) |
920 | (remove (manifest-matching-entries manifest remove))) | |
537630c5 | 921 | (show-what-to-remove/install remove install dry-run?) |
1fcc3ba3 LC |
922 | (show-what-to-build (%store) (list prof-drv) |
923 | #:use-substitutes? | |
924 | (assoc-ref opts 'substitutes?) | |
925 | #:dry-run? dry-run?) | |
926 | ||
927 | (or dry-run? | |
477d30d0 LC |
928 | (let* ((prof (derivation->output-path prof-drv)) |
929 | (number (generation-number profile)) | |
1fcc3ba3 LC |
930 | |
931 | ;; Always use NUMBER + 1 for the new profile, | |
932 | ;; possibly overwriting a "previous future | |
933 | ;; generation". | |
477d30d0 LC |
934 | (name (generation-file-name profile |
935 | (+ 1 number)))) | |
1fcc3ba3 LC |
936 | (and (build-derivations (%store) (list prof-drv)) |
937 | (let ((count (length entries))) | |
938 | (switch-symlinks name prof) | |
939 | (switch-symlinks profile name) | |
d2952326 | 940 | (maybe-register-gc-root (%store) profile) |
1fcc3ba3 LC |
941 | (format #t (N_ "~a package in profile~%" |
942 | "~a packages in profile~%" | |
943 | count) | |
944 | count) | |
945 | (display-search-paths entries | |
946 | profile))))))))))) | |
733b4130 LC |
947 | |
948 | (define (process-query opts) | |
949 | ;; Process any query specified by OPTS. Return #t when a query was | |
950 | ;; actually processed, #f otherwise. | |
951 | (let ((profile (assoc-ref opts 'profile))) | |
952 | (match (assoc-ref opts 'query) | |
2cd09108 NK |
953 | (('list-generations pattern) |
954 | (define (list-generation number) | |
4b2bc804 | 955 | (unless (zero? number) |
9ac9360d NK |
956 | (let ((header (format #f (_ "Generation ~a\t~a") number |
957 | (date->string | |
958 | (time-utc->date | |
959 | (generation-time profile number)) | |
960 | "~b ~d ~Y ~T"))) | |
961 | (current (generation-number profile))) | |
962 | (if (= number current) | |
963 | (format #t (_ "~a\t(current)~%") header) | |
964 | (format #t "~a~%" header))) | |
2cd09108 | 965 | (for-each (match-lambda |
f067fc3e | 966 | (($ <manifest-entry> name version output location _) |
2cd09108 NK |
967 | (format #t " ~a\t~a\t~a\t~a~%" |
968 | name version output location))) | |
bd9bde1c LC |
969 | |
970 | ;; Show most recently installed packages last. | |
971 | (reverse | |
f067fc3e | 972 | (manifest-entries |
bd9bde1c | 973 | (profile-manifest |
477d30d0 | 974 | (generation-file-name profile number))))) |
2cd09108 NK |
975 | (newline))) |
976 | ||
977 | (cond ((not (file-exists? profile)) ; XXX: race condition | |
978 | (leave (_ "profile '~a' does not exist~%") | |
979 | profile)) | |
980 | ((string-null? pattern) | |
0ab212b9 | 981 | (let ((numbers (generation-numbers profile))) |
1a43e4dc LC |
982 | (leave-on-EPIPE |
983 | (if (equal? numbers '(0)) | |
984 | (exit 0) | |
985 | (for-each list-generation numbers))))) | |
2cd09108 NK |
986 | ((matching-generations pattern profile) |
987 | => | |
0ab212b9 NK |
988 | (lambda (numbers) |
989 | (if (null-list? numbers) | |
990 | (exit 1) | |
1a43e4dc LC |
991 | (leave-on-EPIPE |
992 | (for-each list-generation numbers))))) | |
2cd09108 NK |
993 | (else |
994 | (leave (_ "invalid syntax: ~a~%") | |
995 | pattern))) | |
996 | #t) | |
997 | ||
733b4130 LC |
998 | (('list-installed regexp) |
999 | (let* ((regexp (and regexp (make-regexp regexp))) | |
1000 | (manifest (profile-manifest profile)) | |
f067fc3e | 1001 | (installed (manifest-entries manifest))) |
1a43e4dc LC |
1002 | (leave-on-EPIPE |
1003 | (for-each (match-lambda | |
1004 | (($ <manifest-entry> name version output path _) | |
1005 | (when (or (not regexp) | |
1006 | (regexp-exec regexp name)) | |
1007 | (format #t "~a\t~a\t~a\t~a~%" | |
1008 | name (or version "?") output path)))) | |
1009 | ||
1010 | ;; Show most recently installed packages last. | |
1011 | (reverse installed))) | |
64fc89b6 | 1012 | #t)) |
acc08466 | 1013 | |
64fc89b6 LC |
1014 | (('list-available regexp) |
1015 | (let* ((regexp (and regexp (make-regexp regexp))) | |
1016 | (available (fold-packages | |
1017 | (lambda (p r) | |
1018 | (let ((n (package-name p))) | |
1019 | (if regexp | |
1020 | (if (regexp-exec regexp n) | |
1021 | (cons p r) | |
1022 | r) | |
1023 | (cons p r)))) | |
1024 | '()))) | |
1a43e4dc LC |
1025 | (leave-on-EPIPE |
1026 | (for-each (lambda (p) | |
1027 | (format #t "~a\t~a\t~a\t~a~%" | |
1028 | (package-name p) | |
1029 | (package-version p) | |
1030 | (string-join (package-outputs p) ",") | |
1031 | (location->string (package-location p)))) | |
1032 | (sort available | |
1033 | (lambda (p1 p2) | |
1034 | (string<? (package-name p1) | |
1035 | (package-name p2)))))) | |
64fc89b6 | 1036 | #t)) |
acc08466 NK |
1037 | |
1038 | (('search regexp) | |
cb09fb24 | 1039 | (let ((regexp (make-regexp regexp regexp/icase))) |
eb9a9fee LC |
1040 | (leave-on-EPIPE |
1041 | (for-each (cute package->recutils <> (current-output-port)) | |
1042 | (find-packages-by-description regexp))) | |
acc08466 | 1043 | #t)) |
5924080d LC |
1044 | |
1045 | (('search-paths) | |
1046 | (let* ((manifest (profile-manifest profile)) | |
f067fc3e LC |
1047 | (entries (manifest-entries manifest)) |
1048 | (packages (map manifest-entry-name entries)) | |
1049 | (settings (search-path-environment-variables entries profile | |
5924080d LC |
1050 | (const #f)))) |
1051 | (format #t "~{~a~%~}" settings) | |
1052 | #t)) | |
1053 | ||
733b4130 LC |
1054 | (_ #f)))) |
1055 | ||
0afdc485 | 1056 | (let ((opts (parse-options))) |
0f5378eb | 1057 | (or (process-query opts) |
ef86c39f LC |
1058 | (with-error-handling |
1059 | (parameterize ((%store (open-connection))) | |
dd67b429 | 1060 | (set-build-options-from-command-line (%store) opts) |
3b824605 | 1061 | |
c4d64534 LC |
1062 | (parameterize ((%guile-for-build |
1063 | (package-derivation (%store) | |
1064 | (if (assoc-ref opts 'bootstrap?) | |
1065 | %bootstrap-guile | |
1066 | guile-final)))) | |
1067 | (process-actions opts))))))) |