| 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 | (define-module (gnu home)
|
| 29 | #:use-module (gnu home services)
|
| 30 | #:use-module (gnu home services symlink-manager)
|
| 31 | #:use-module (gnu home services shells)
|
| 32 | #:use-module (gnu home services shepherd)
|
| 33 | #:use-module (gnu home services xdg)
|
| 34 | #:use-module (gnu home services fontutils)
|
| 35 | #:use-module (gnu home services admin)
|
| 36 | #:use-module (gnu services)
|
| 37 | #:use-module (guix records)
|
| 38 | #:use-module (guix diagnostics)
|
| 39 | #:use-module (guix gexp)
|
| 40 | #:use-module (guix store)
|
| 41 | #:use-module (ice-9 match)
|
| 42 | #:use-module (ice-9 regex)
|
| 43 | #:export (home-environment
|
| 44 | home-environment?
|
| 45 | this-home-environment
|
| 46 |
|
| 47 | home-environment-derivation
|
| 48 | home-environment-packages
|
| 49 | home-environment-user-services
|
| 50 | home-environment-essential-services
|
| 51 | home-environment-default-essential-services
|
| 52 | home-environment-services
|
| 53 | home-environment-transformation
|
| 54 | home-environment-location
|
| 55 |
|
| 56 | home-environment-with-provenance
|
| 57 |
|
| 58 | home-generation-base
|
| 59 |
|
| 60 | %base-home-services))
|
| 61 |
|
| 62 | (define-record-type* <home-environment> home-environment
|
| 63 | make-home-environment
|
| 64 | home-environment?
|
| 65 | this-home-environment
|
| 66 |
|
| 67 | (packages home-environment-packages |
| 68 | (default '()))
|
| 69 |
|
| 70 | (essential-services home-environment-essential-services |
| 71 | (thunked)
|
| 72 | (default (home-environment-default-essential-services
|
| 73 | this-home-environment)))
|
| 74 |
|
| 75 | (services home-environment-user-services
|
| 76 | (default %base-home-services)
|
| 77 | (sanitize validate-service-list))
|
| 78 | (transformation home-environment-transformation
|
| 79 | (default identity))
|
| 80 |
|
| 81 | (location home-environment-location |
| 82 | (default (and=> (current-source-location)
|
| 83 | source-properties->location))
|
| 84 | (innate)))
|
| 85 |
|
| 86 | (define %base-home-services
|
| 87 | |
| 88 | (list (service home-log-rotation-service-type)
|
| 89 | (service home-shepherd-timer-service-type)
|
| 90 | (service home-shepherd-transient-service-type)))
|
| 91 |
|
| 92 | (define (home-environment-default-essential-services he)
|
| 93 | "Return the list of essential services for home environment."
|
| 94 | (list
|
| 95 | (service home-run-on-first-login-service-type)
|
| 96 | (service home-activation-service-type)
|
| 97 | (service home-environment-variables-service-type)
|
| 98 |
|
| 99 | (service home-symlink-manager-service-type)
|
| 100 |
|
| 101 | (service home-fontconfig-service-type)
|
| 102 | (service home-xdg-base-directories-service-type)
|
| 103 | (service home-shell-profile-service-type)
|
| 104 |
|
| 105 | (service home-service-type)
|
| 106 | (service home-profile-service-type (home-environment-packages he))))
|
| 107 |
|
| 108 | (define* (home-environment-services he)
|
| 109 | "Return all the services of home environment."
|
| 110 | (instantiate-missing-services
|
| 111 | (append (home-environment-user-services he)
|
| 112 | (home-environment-essential-services he))))
|
| 113 |
|
| 114 | (define* (home-environment-derivation he)
|
| 115 | "Return a derivation that builds home environment."
|
| 116 | (with-transformation (home-environment-transformation he)
|
| 117 | (let* ((services (home-environment-services he))
|
| 118 | (home (fold-services services
|
| 119 | #:target-type home-service-type)))
|
| 120 | (service-value home))))
|
| 121 |
|
| 122 |
|
| 123 | (define (home-environment-configuration-file he)
|
| 124 | "Return the configuration file of HE, based on its 'location' field, or #f
|
| 125 | if it could not be determined."
|
| 126 | (let ((file (and=> (home-environment-location he)
|
| 127 | location-file)))
|
| 128 | (and file
|
| 129 | (or (and (string-prefix? "/" file) file)
|
| 130 | (search-path %load-path file)))))
|
| 131 |
|
| 132 | (define* (home-environment-with-provenance he
|
| 133 | #:optional
|
| 134 | (config-file
|
| 135 | (home-environment-configuration-file
|
| 136 | he)))
|
| 137 | "Return a variant of HE that stores its own provenance information,
|
| 138 | including CONFIG-FILE, if available. This is achieved by adding an instance
|
| 139 | of HOME-PROVENANCE-SERVICE-TYPE to its services."
|
| 140 | (home-environment
|
| 141 | (inherit he)
|
| 142 | (services (cons (service home-provenance-service-type config-file)
|
| 143 | (home-environment-user-services he)))))
|
| 144 |
|
| 145 | (define-gexp-compiler (home-environment-compiler (he <home-environment>)
|
| 146 | system target)
|
| 147 | ((store-lift
|
| 148 | (lambda (store)
|
| 149 | (run-with-store store (home-environment-derivation he)
|
| 150 | #:system system
|
| 151 | #:target target)))))
|
| 152 |
|
| 153 | (define %profile-generation-rx
|
| 154 | |
| 155 | (make-regexp "(.*)-([0-9]+)-link$"))
|
| 156 |
|
| 157 | (define (home-generation-base file)
|
| 158 | "If FILE is a Home generation GC root such as \"guix-home-42-link\",
|
| 159 | return its corresponding base---e.g., \"guix-home\". Otherwise return #f.
|
| 160 |
|
| 161 | This is similar to the 'generation-profile' procedure but applied to Home
|
| 162 | generations."
|
| 163 | (match (regexp-exec %profile-generation-rx file)
|
| 164 | (#f #f)
|
| 165 | (m (let ((profile (match:substring m 1)))
|
| 166 | |
| 167 | (and (file-exists? (string-append profile "/on-first-login"))
|
| 168 | (file-exists? (string-append profile "/profile/manifest"))
|
| 169 | profile)))))
|