summaryrefslogtreecommitdiff
path: root/gnu/services/guix.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/guix.scm')
-rw-r--r--gnu/services/guix.scm78
1 files changed, 75 insertions, 3 deletions
diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm
index c438da531c..96f5ecaac0 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020, 2021, 2022 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2024 Andrew Tropin <andrew@trop.in>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -101,6 +102,8 @@
guix-data-service-type
+ guix-home-service-type
+
nar-herder-service-type
nar-herder-configuration
nar-herder-configuration?
@@ -688,6 +691,41 @@ ca-certificates.crt file in the system profile."
;;;
+;;; Guix Home Service
+;;;
+
+(define (guix-home-shepherd-service config)
+ (map (match-lambda
+ ((user he)
+ (shepherd-service
+ (documentation "Activate Guix Home.")
+ (requirement '(user-processes))
+ (provision (list (symbol-append 'guix-home- (string->symbol user))))
+ (one-shot? #t)
+ (auto-start? #t)
+ (start #~(make-forkexec-constructor
+ '(#$(file-append he "/activate"))
+ #:user #$user
+ #:environment-variables
+ (list (string-append "HOME=" (passwd:dir (getpw #$user)))
+ "GUIX_SYSTEM_IS_RUNNING_HOME_ACTIVATE=t")
+ #:group (group:name (getgrgid (passwd:gid (getpw #$user))))))
+ (stop #~(make-kill-destructor)))))
+ config))
+
+(define guix-home-service-type
+ (service-type
+ (name 'guix-home)
+ (description "Sets up Guix Home for the specified user accounts.")
+ (extensions (list (service-extension
+ shepherd-root-service-type
+ guix-home-shepherd-service)))
+ (compose concatenate)
+ (extend append)
+ (default-value '())))
+
+
+;;;
;;; Nar Herder
;;;
@@ -719,6 +757,8 @@ ca-certificates.crt file in the system profile."
(default '()))
(ttl nar-herder-configuration-ttl
(default #f))
+ (new-ttl nar-herder-configuration-new-ttl
+ (default #f))
(negative-ttl nar-herder-configuration-negative-ttl
(default #f))
(log-level nar-herder-configuration-log-level
@@ -750,14 +790,22 @@ ca-certificates.crt file in the system profile."
(default #f))
(directory-max-size
nar-herder-cached-compression-configuration-directory-max-size
- (default #f)))
+ (default #f))
+ (unused-removal-duration
+ nar-herder-cached-compression-configuration-unused-removal-duration
+ (default #f))
+ (ttl nar-herder-cached-compression-configuration-ttl
+ (default #f))
+ (new-ttl nar-herder-cached-compression-configuration-new-ttl
+ (default #f)))
(define (nar-herder-shepherd-services config)
(define (cached-compression-configuration->options cached-compression)
(match-record
cached-compression
<nar-herder-cached-compression-configuration>
- (type level directory directory-max-size)
+ (type level directory directory-max-size
+ unused-removal-duration ttl new-ttl)
`(,(simple-format #f "--enable-cached-compression=~A~A"
type
@@ -775,6 +823,27 @@ ca-certificates.crt file in the system profile."
(simple-format #f "--cached-compression-directory-max-size=~A=~A"
type
directory-max-size))
+ '())
+ ,@(if unused-removal-duration
+ (list
+ (simple-format
+ #f "--cached-compression-unused-removal-duration=~A=~A"
+ type
+ unused-removal-duration))
+ '())
+ ,@(if ttl
+ (list
+ (simple-format
+ #f "--cached-compression-ttl=~A=~A"
+ type
+ ttl))
+ '())
+ ,@(if new-ttl
+ (list
+ (simple-format
+ #f "--cached-compression-new-ttl=~A=~A"
+ type
+ new-ttl))
'()))))
(match-record config <nar-herder-configuration>
@@ -783,7 +852,7 @@ ca-certificates.crt file in the system profile."
database database-dump
host port
storage storage-limit storage-nar-removal-criteria
- ttl negative-ttl log-level
+ ttl new-ttl negative-ttl log-level
cached-compressions cached-compression-min-uses
cached-compression-workers cached-compression-nar-source
extra-environment-variables)
@@ -825,6 +894,9 @@ ca-certificates.crt file in the system profile."
#$@(if ttl
(list (string-append "--ttl=" ttl))
'())
+ #$@(if new-ttl
+ (list (string-append "--new-ttl=" new-ttl))
+ '())
#$@(if negative-ttl
(list (string-append "--negative-ttl=" negative-ttl))
'())