blob: e91a59ce275f93c3edf7ac16b2c69b6292b53291 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
;;; guix-web - Web interface for GNU Guix
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (guix web package)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (guix config)
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix ui)
#:use-module (gnu packages)
#:export (%all-packages
package-install
profile-generations*))
(define %all-packages
(fold-packages cons '()))
(define %profile
(string-append %state-directory "/profiles/"
(or (and=> (or (getenv "USER")
(getenv "LOGNAME"))
(cut string-append "per-user/" <>))
"default")
"/guix-profile"))
(define manifest (profile-manifest %profile))
(define (maybe-register-gc-root store profile)
"Register PROFILE as a GC root, unless it doesn't need it."
(unless (string=? profile %profile)
(add-indirect-root store (canonicalize-path profile))))
(define (install-new-profile-generation profile prof)
"Let PROF become the new generation of PROFILE."
(let* ((number (generation-number profile))
(name (generation-file-name profile (+ 1 number))))
(switch-symlinks name prof)
(switch-symlinks profile name)
;; (maybe-register-gc-root (%store) profile)
))
(define (package-install package)
(with-store %store
(let* ((new (manifest-add manifest
(list (package->manifest-entry package))))
(prof-drv (run-with-store %store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(profile-derivation new))))
(prof (derivation->output-path prof-drv)))
(and (build-derivations %store (list prof-drv))
(install-new-profile-generation %profile prof)))))
(define (profile-generations*)
(map (lambda (n)
(cons n (reverse
(manifest-entries
(profile-manifest
(generation-file-name %profile n))))))
(generation-numbers %profile)))
|
