* [bug#51359] [PATCH 0/1] home-state-service-type and tests suite
@ 2021-10-23 18:04 Oleg Pykhalov
2021-10-23 18:06 ` [bug#51359] [PATCH 1/1] home: services: Add state services Oleg Pykhalov
` (2 more replies)
0 siblings, 3 replies; 6+ messages in thread
From: Oleg Pykhalov @ 2021-10-23 18:04 UTC (permalink / raw)
To: 51359; +Cc: Oleg Pykhalov
Hi Guix,
This patch adds support for home-state-service-type which copied from the rde
project [1]. The introduction to home state services in documentation is
copied from discussion [2].
Tests passed:
make check-system TESTS="home-state-git"
make check-system TESTS="home-state-rsync"
[1] https://github.com/abcdw/rde/
[2] https://lists.sr.ht/~abcdw/rde-devel/%3C87pmzze9nn.fsf%40trop.in%3E#%3CCABrWRW1Fq-8mS=MbWJedUpayj1vFg-YE0oNF3zVTYWBMnp29Lg@mail.gmail.com%3E
Oleg Pykhalov (1):
home: services: Add state services.
doc/guix.texi | 32 ++
gnu/home.scm | 12 +
gnu/home/services/state.scm | 210 ++++++++++++
gnu/home/services/utils.scm | 81 ++++-
gnu/home/services/version-control.scm | 442 ++++++++++++++++++++++++++
gnu/local.mk | 2 +
gnu/tests/rsync.scm | 158 ++++++++-
gnu/tests/version-control.scm | 140 +++++++-
guix/scripts/home.scm | 100 +++++-
9 files changed, 1163 insertions(+), 14 deletions(-)
create mode 100644 gnu/home/services/state.scm
create mode 100644 gnu/home/services/version-control.scm
--
2.33.1
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#51359] [PATCH 1/1] home: services: Add state services.
2021-10-23 18:04 [bug#51359] [PATCH 0/1] home-state-service-type and tests suite Oleg Pykhalov
@ 2021-10-23 18:06 ` Oleg Pykhalov
2021-10-30 11:10 ` [bug#51359] [PATCH 0/1] home-state-service-type and tests suite Xinglu Chen
2022-06-08 16:10 ` Andrew Tropin
2 siblings, 0 replies; 6+ messages in thread
From: Oleg Pykhalov @ 2021-10-23 18:06 UTC (permalink / raw)
To: 51359; +Cc: Oleg Pykhalov
* gnu/home.scm (home-environment-compiler): New procedure.
* gnu/home/services/state.scm: New file.
* doc/guix.texi (State Home Services): Document this.
* gnu/home/services/version-control.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add those.
* gnu/home/services/utils.scm
(ini-config?, default-ini-format-section, generic-serialize-ini-config,
generic-serialize-git-ini-config): New procedures.
* gnu/tests/version-control.scm (run-home-state-git-test): New procedure.
(%home-state-git-os, %test-home-state-git): New variables.
* guix/scripts/home.scm
(not-config?, switch-home-program, switch-to-home, local-eval): New procedures.
(save-load-path-excursion): New macro.
(switch-home-program): Use switch-to-home procedure.
* gnu/tests/rsync.scm (run-home-state-rsync-test): New procedures.
(%home-state-rsync-os, %test-home-state-rsync): New variables.
---
doc/guix.texi | 32 ++
gnu/home.scm | 12 +
gnu/home/services/state.scm | 210 ++++++++++++
gnu/home/services/utils.scm | 81 ++++-
gnu/home/services/version-control.scm | 442 ++++++++++++++++++++++++++
gnu/local.mk | 2 +
gnu/tests/rsync.scm | 158 ++++++++-
gnu/tests/version-control.scm | 140 +++++++-
guix/scripts/home.scm | 100 +++++-
9 files changed, 1163 insertions(+), 14 deletions(-)
create mode 100644 gnu/home/services/state.scm
create mode 100644 gnu/home/services/version-control.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 63bb22764a..c79f3acfa3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35548,6 +35548,7 @@ services)}.
* Shells: Shells Home Services. POSIX shells, Bash, Zsh.
* Mcron: Mcron Home Service. Scheduled User's Job Execution.
* Shepherd: Shepherd Home Service. Managing User's Daemons.
+* State: State Home Services. Managing User's states.
@end menu
@c In addition to that Home Services can provide
@@ -35875,6 +35876,37 @@ mechanism instead (@pxref{Shepherd Services}).
@end table
@end deftp
+@node State Home Services
+@subsection Managing User's states
+
+@cindex state
+@cindex rsync
+@cindex git
+@cindex hg
+
+@command{herd init state} will create all the neccessary dirs, will clone the
+Git repos with projects you work on, restore wallpapers dir from backup
+server via Rsync and so on. That helps at least control and init state
+your software depends on, when you switching to new machine for example.
+
+@defvr {Scheme Variable} home-state-service-type
+This is the type of the @code{state} home service, whose value is a list
+of @code{shepherd-service} objects.
+@end defvr
+
+The following examples demonstrate Git and Rsync configuration:
+
+@example
+(home-environment
+ (services
+ (list
+ (service home-state-service-type
+ (list (state-git "/home/alice/guix-maintenance"
+ "https://git.savannah.gnu.org/git/guix/maintenance.git")
+ (state-rsync "/home/alice/output"
+ "rsync://localhost:873/files/input"))))))
+@end example
+
@node Invoking guix home
@section Invoking @code{guix home}
diff --git a/gnu/home.scm b/gnu/home.scm
index d8134693e5..87d4d54b8e 100644
--- a/gnu/home.scm
+++ b/gnu/home.scm
@@ -23,8 +23,10 @@ (define-module (gnu home)
#:use-module (gnu home services xdg)
#:use-module (gnu home services fontutils)
#:use-module (gnu services)
+ #:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix diagnostics)
+ #:use-module (guix store)
#:export (home-environment
home-environment?
@@ -104,3 +106,13 @@ (define* (home-environment-with-provenance he config-file)
(inherit he)
(services (cons (service home-provenance-service-type config-file)
(home-environment-user-services he)))))
+
+(define-gexp-compiler (home-environment-compiler (he <home-environment>)
+ system target)
+ ((store-lift
+ (lambda (store)
+ ;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to
+ ;; 'home-environment-derivation'.
+ (run-with-store store (home-environment-derivation he)
+ #:system system
+ #:target target)))))
diff --git a/gnu/home/services/state.scm b/gnu/home/services/state.scm
new file mode 100644
index 0000000000..f78751b10f
--- /dev/null
+++ b/gnu/home/services/state.scm
@@ -0,0 +1,210 @@
+(define-module (gnu home services state)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services utils)
+ #:use-module (gnu home services shepherd)
+ #:use-module (gnu home services version-control)
+ #:use-module (gnu packages rsync)
+ #:use-module (gnu packages version-control)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu packages ssh)
+ #:use-module (guix packages)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
+ #:use-module (guix modules)
+ #:use-module (guix records)
+
+ #:export (home-state-service-type
+ state-generic
+ state-git
+ state-hg
+ state-rsync))
+
+(define* (state-hg path remote #:key (config #f))
+ (state-generic
+ path
+ #:init-gexp
+ #~(lambda* (_ self)
+ (let* ((meta (car (action self 'metadata)))
+ (path (assoc-ref meta 'path))
+ (remote (assoc-ref meta 'remote)))
+ (format #t "Initializing ~a.\n" self)
+ (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+ #$(file-append mercurial "/bin/hg") "clone" remote path)))
+ (waitpid WAIT_ANY)
+ (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+ (close-port port))
+
+ (when '#$config
+ (call-with-output-file (string-append path "/.hg/hgrc")
+ (lambda (port) (display (string-append
+ #$@(serialize-hg-config config)) port))))))
+ #:additional-metadata `((remote . ,remote)
+ (general-sync? . #f))))
+
+(define* (state-git path remote #:key (config #f))
+ (state-generic
+ path
+ #:init-gexp
+ #~(lambda* (_ self)
+ (let* ((meta (car (action self 'metadata)))
+ (path (assoc-ref meta 'path))
+ (remote (assoc-ref meta 'remote)))
+ (format #t "Initializing ~a.\n" self)
+ ;; TODO: revisit git clone implementation
+ ;; FIXME: Hang up shepherd if username/password asked
+ (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+ #$(file-append git "/bin/git") "clone" remote path)))
+ (waitpid WAIT_ANY)
+ (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+ (close-port port))
+
+ (when #$config
+ (call-with-output-file (string-append path "/.git/config")
+ (lambda (port) (display #$config port))))))
+ #:additional-metadata `((remote . ,remote)
+ (general-sync? . #f))))
+
+(define* (state-rsync path remote)
+ (state-generic
+ path
+ #:init-gexp
+ #~(lambda* (_ self)
+ (let* ((meta (car (action self 'metadata)))
+ (path (assoc-ref meta 'path))
+ (remote (assoc-ref meta 'remote)))
+ (format #t "Initializing ~a.\n" self)
+ ;; TODO: revisit git clone implementation
+ (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+ #$(file-append rsync "/bin/rsync") "-aP" remote path)))
+ (waitpid WAIT_ANY)
+ (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+ (close-port port))))
+ #:sync-gexp
+ #~(lambda* (_ self)
+ (let* ((meta (car (action self 'metadata)))
+ (path (assoc-ref meta 'path))
+ (remote (assoc-ref meta 'remote)))
+ (format #t "Synchronizing ~a.\n" self)
+ (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+ #$(file-append rsync "/bin/rsync") "-aP" path remote)))
+ (waitpid WAIT_ANY)
+ (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+ (close-port port))))
+ #:additional-metadata `((remote . ,remote)
+ (general-sync? . #t))))
+
+(define* (state-generic
+ path
+ #:key
+ (init-gexp
+ #~(lambda* (_ self)
+ (let ((path (assoc-ref (car (action self 'metadata)) 'path)))
+ (format #t "Initializing ~a.\n" self)
+ (format #t "Creating ~a directory..." path)
+ (mkdir-p path)
+ (display " done\n"))))
+ (sync-gexp
+ #~(lambda* (_ self)
+ (let ((path (assoc-ref (car (action self 'metadata)) 'path)))
+ (format #t "Synchronizing ~a.\n" self)
+ (format #t "Nothing to synchronize.\n"))))
+ (additional-metadata '((general-sync? . #f))))
+ "A function which returns a shepherd-service with all required
+actions for state management, should be used as a basis for other
+state related items like git-state, rsync-state, etc."
+ (let ((self (string->symbol
+ (format #f "state-~a" path))))
+ (shepherd-service
+ (documentation (format #f "Managing state at ~a." path))
+ (provision (list self))
+ (auto-start? #f)
+ (start #~(lambda ()
+ (if (car (action '#$self 'state-exists?))
+ #t
+ (begin
+ (format #t "~a is not initilized yet." '#$self)
+ #f))))
+ (actions (list
+ (shepherd-action
+ (name 'state-exists?)
+ (documentation "Check if state file/directory exists.")
+ (procedure #~(lambda* (#:rest rest)
+ (file-exists? #$path))))
+ (shepherd-action
+ (name 'unchecked-init)
+ (documentation "Do not use this action directly.")
+ (procedure init-gexp))
+ (shepherd-action
+ (name 'metadata)
+ (documentation "Returns metadata related to the state.")
+ (procedure #~(lambda* _
+ (append
+ '((path . #$path)
+ (self . #$self))
+ '#$additional-metadata))))
+ (shepherd-action
+ (name 'sync)
+ (documentation "Sync the state.")
+ (procedure sync-gexp))
+ (shepherd-action
+ (name 'init)
+ (documentation "Generic initialize.")
+ (procedure #~(lambda* (#:rest rest)
+ (if (car (action '#$self 'state-exists?))
+ (format #t "~a already initialized.\n" '#$self)
+ (begin
+ (action '#$self 'unchecked-init '#$self)
+ (start '#$self)))))))))))
+
+(define (add-shepherd-services services)
+ (let* ((service-names
+ (map
+ (lambda (service) (car (shepherd-service-provision service)))
+ services)))
+ (append
+ services
+ (list
+ (shepherd-service
+ (documentation "Init, update and maybe destroy state.")
+ (provision '(state))
+ (auto-start? #t)
+ (start #~(lambda ()
+ (map (lambda (name)
+ (when (car (action name 'state-exists?))
+ (start name)))
+ '#$service-names)))
+ (actions (list
+ (shepherd-action
+ (name 'sync)
+ (documentation
+ "Sync all the state. Highly dependent on state type.")
+ (procedure
+ #~(lambda _
+ (map (lambda (name)
+ (when (assoc-ref (car (action name 'metadata))
+ 'general-sync?)
+ (action name 'sync name)))
+ '#$service-names))))
+ (shepherd-action
+ (name 'init)
+ (documentation "Initialize all the state.")
+ (procedure #~(lambda _
+ (map (lambda (name)
+ (when (not (car (action name 'state-exists?)))
+ (action name 'init)
+ (start name)))
+ '#$service-names)))))))))))
+
+(define home-state-service-type
+ (service-type (name 'home-state)
+ (extensions
+ (list (service-extension
+ home-shepherd-service-type
+ add-shepherd-services)))
+ (default-value '())
+ (compose concatenate)
+ (extend append)
+ (description "A toolset for initializing state.")))
diff --git a/gnu/home/services/utils.scm b/gnu/home/services/utils.scm
index cea75ee896..8f2122dda9 100644
--- a/gnu/home/services/utils.scm
+++ b/gnu/home/services/utils.scm
@@ -21,11 +21,17 @@ (define-module (gnu home services utils)
#:use-module (ice-9 string-fun)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:use-module (gnu services configuration)
#:export (maybe-object->string
object->snake-case-string
object->camel-case-string
- list->human-readable-list))
+ list->human-readable-list
+
+ ini-config?
+ generic-serialize-ini-config
+ generic-serialize-git-ini-config))
(define (maybe-object->string object)
"Like @code{object->string} but don't do anyting if OBJECT already is
@@ -103,3 +109,76 @@ (define* (list->human-readable-list lst
word
(maybe-object->string (proc (last lst)))))))
+\f
+;;;
+;;; Serializers.
+;;;
+
+(define ini-config? list?)
+(define (generic-serialize-ini-config-section section proc)
+ "Format a section from SECTION for an INI configuration.
+Apply the procedure PROC on SECTION after it has been converted to a string"
+ (format #f "[~a]\n" (proc section)))
+
+(define default-ini-format-section
+ (match-lambda
+ ((section subsection)
+ (string-append (maybe-object->string section) " "
+ (maybe-object->string subsection)))
+ (section
+ (maybe-object->string section))))
+
+(define* (generic-serialize-ini-config
+ #:key
+ (combine-ini string-join)
+ (combine-alist string-append)
+ (combine-section-alist string-append)
+ (format-section default-ini-format-section)
+ serialize-field
+ fields)
+ "Create an INI configuration from nested lists FIELDS. This uses
+@code{generic-serialize-ini-config-section} and @{generic-serialize-alist} to
+serialize the section and the association lists, respectively.
+
+@example
+(generic-serialize-ini-config
+ #:serialize-field (lambda (a b) (format #f \"~a = ~a\n\" a b))
+ #:format-section (compose string-capitalize symbol->string)
+ #:fields '((application ((key . value)))))
+@end example
+
+@result{} \"[Application]\nkey = value\n\""
+ (combine-ini
+ (map (match-lambda
+ ((section alist)
+ (combine-section-alist
+ (generic-serialize-ini-config-section section format-section)
+ (generic-serialize-alist combine-alist serialize-field alist))))
+ fields)
+ "\n"))
+
+(define* (generic-serialize-git-ini-config
+ #:key
+ (combine-ini string-join)
+ (combine-alist string-append)
+ (combine-section-alist string-append)
+ (format-section default-ini-format-section)
+ serialize-field
+ fields)
+ "Like @code{generic-serialize-ini-config}, but the section can also
+have a @dfn{subsection}. FORMAT-SECTION will take a list of two
+elements: the section and the subsection."
+ (combine-ini
+ (map (match-lambda
+ ((section subsection alist)
+ (combine-section-alist
+ (generic-serialize-ini-config-section
+ (list section subsection) format-section)
+ (generic-serialize-alist combine-alist serialize-field alist)))
+ ((section alist)
+ (combine-section-alist
+ (generic-serialize-ini-config-section section format-section)
+ (generic-serialize-alist combine-alist serialize-field alist))))
+ fields)
+ "\n"))
+
diff --git a/gnu/home/services/version-control.scm b/gnu/home/services/version-control.scm
new file mode 100644
index 0000000000..afc9c539a7
--- /dev/null
+++ b/gnu/home/services/version-control.scm
@@ -0,0 +1,442 @@
+(define-module (gnu home services version-control)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services utils)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu packages version-control)
+ #:use-module (guix packages)
+ #:use-module (guix gexp)
+ #:use-module (guix records)
+ #:use-module ((guix import utils) #:select (flatten))
+
+ #:export (home-git-configuration
+ home-git-extension
+ home-git-service-type
+ serialize-git-config
+
+ home-hg-configuration
+ home-hg-extension
+ serialize-hg-config
+ home-hg-service-type))
+
+;;; Commentary:
+;;;
+;;; Version control related services.
+;;;
+;;; Code:
+
+;;;
+;;; Git.
+;;;
+;;; (service home-git-service-type
+;;; (home-git-configuration
+;;; (attributes
+;;; '((* . text=auto)
+;;; (*.sh . "text eol=lf")))
+;;; (ignore
+;;; '("*.so" "*.o"))
+;;; (ignore-extra-content
+;;; "*.dll\n*.exe\n")
+;;; (config
+;;; `((http "https://weak.example.com"
+;;; ((ssl-verify . #f)))
+;;; (gpg
+;;; ((program . ,(file-append gnupg "/bin/gpg"))))
+;;; (sendmail
+;;; ((annotate . #t))))
+;;; (config-extra-content (slurp-file-gexp
+;;; (local-file "./gitconfig")))))
+;;;
+;;; (simple-service
+;;; 'add-something-to-git
+;;; home-git-service-type
+;;; (home-git-extension
+;;; (config
+;;; `((sendmail
+;;; ((annotate . #t)))))))
+
+
+(define (uglify-field-name field-name)
+ "Convert symbol FIELD-NAME to a camel case string.
+@code{symbol-name} => \"@code{symbolName}\"."
+ (let* ((str (symbol->string field-name))
+ (spl-str (string-split str #\-)))
+ (apply string-append
+ (car spl-str)
+ (map string-capitalize (cdr spl-str)))))
+
+(define (serialize-field field-name val)
+ (cond
+ ((boolean? val) (serialize-boolean field-name val))
+ (else
+ (list (format #f "\t~a = " (uglify-field-name field-name))
+ val "\n"))))
+
+(define (serialize-alist field-name val)
+ (generic-serialize-alist append serialize-field val))
+
+(define (serialize-boolean field-name val)
+ (serialize-field field-name (if val "true" "false")))
+
+(define serialize-string serialize-field)
+(define git-config? list?)
+
+(define (serialize-git-section-header name value)
+ (format #f "[~a~a]\n" (uglify-field-name name)
+ (if value (format #f " \"~a\"" value) "")))
+
+(define serialize-git-section
+ (match-lambda
+ ((name options)
+ (cons
+ (serialize-git-section-header name #f)
+ (serialize-alist #f options)))
+ ((name value options)
+ (cons
+ (serialize-git-section-header name value)
+ (serialize-alist #f options)))))
+
+;; TODO: cover it with tests
+(define (serialize-git-config field-name val)
+ #~(string-append #$@(append-map serialize-git-section val)))
+
+(define (git-ignore? patterns)
+ (list-of-strings? patterns))
+(define (serialize-git-ignore field-name val)
+ (string-join val "\n" 'suffix))
+
+(define (git-attributes? attrs)
+ (list? attrs))
+(define (serialize-git-attributes field-name val)
+ (string-join
+ (map
+ (match-lambda
+ ((key . value) (format #f "~a\t~a" key value)))
+ val)
+ "\n"
+ 'suffix))
+
+(define-configuration home-git-extension
+ (attributes
+ (git-attributes '())
+ "Alist of pattern attribute pairs for @file{git/attributes.}")
+ (ignore
+ (git-ignore '())
+ "List of patterns for @file{git/ignore.}")
+ (config
+ (git-config '())
+ "List of git sections. The same format as in
+@code{home-git-configuration}."))
+
+(define-configuration home-git-configuration
+ (package
+ (package git)
+ "The Git package to use.")
+ (attributes
+ (git-attributes '())
+ "Alist of pattern attribute pairs for @file{git/attributes.}")
+ (attributes-extra-content
+ (text-config "")
+ "String or value of string-valued g-exps will be added to the end
+of the @file{git/attributes} file.")
+ (ignore
+ (git-ignore '())
+ "List of patterns for git/ignore.")
+ (ignore-extra-content
+ (text-config "")
+ "String or value of string-valued g-exps will be added to the end
+of the git/ignore file.")
+ (config
+ (git-config '())
+ "List of sections and corresponding options. Something like this:
+
+@lisp
+`((sendmail
+ ((annotate . #t))))
+@end lisp
+
+will turn into this:
+
+@example
+[sendmail]
+ annotate = true
+@end example")
+ (config-extra-content
+ (text-config "")
+ "String or value of string-valued g-exps will be added to the end
+of the configuration file."))
+
+(define (add-git-configuration config)
+ (define (filter-fields fields)
+ (filter-configuration-fields home-git-configuration-fields fields))
+ `(("config/git/attributes"
+ ,(mixed-text-file
+ "git-attributes"
+ (serialize-configuration
+ config
+ (filter-fields '(attributes)))
+ (home-git-configuration-attributes-extra-content config)))
+ ("config/git/ignore"
+ ,(mixed-text-file
+ "git-ignore"
+ (serialize-configuration
+ config
+ (filter-fields '(ignore)))
+ (home-git-configuration-ignore-extra-content config)))
+ ("config/git/config"
+ ,(mixed-text-file
+ "git-config"
+ (serialize-configuration
+ config
+ (filter-fields '(config)))
+ (home-git-configuration-config-extra-content config)))))
+
+(define (add-git-packages config)
+ (list (home-git-configuration-package config)))
+
+(define (home-git-extensions original-config extension-configs)
+ (home-git-configuration
+ (inherit original-config)
+ (attributes
+ (append (home-git-configuration-attributes original-config)
+ (append-map
+ home-git-extension-attributes extension-configs)))
+ (ignore
+ (append (home-git-configuration-ignore original-config)
+ (append-map
+ home-git-extension-ignore extension-configs)))
+ (config
+ (append (home-git-configuration-config original-config)
+ (append-map
+ home-git-extension-config extension-configs)))))
+
+(define home-git-service-type
+ (service-type (name 'home-git)
+ (extensions
+ (list (service-extension
+ home-files-service-type
+ add-git-configuration)
+ (service-extension
+ home-profile-service-type
+ add-git-packages)))
+ (compose identity)
+ (extend home-git-extensions)
+ (default-value (home-git-configuration))
+ (description "Install and configure Git.")))
+
+(define (generate-home-git-documentation)
+ (generate-documentation
+ `((home-git-configuration
+ ,home-git-configuration-fields))
+ 'home-git-configuration))
+
+\f
+;;;
+;;; Mercurial.
+;;;
+;;; (home-hg-configuration
+;;; (regexp-ignore '("^\\.pc/"))
+;;; (glob-ignore '("*.elc" "*~"))
+;;; (config
+;;; '((commands
+;;; ((commit.post-status . #t)))
+;;; (ui
+;;; ((username . "Alice Bobson <charlie@example.org")))
+;;; (defaults
+;;; (log . "-v")))))
+;;;
+
+;; TODO: Add separate field for name and email?
+(define-configuration/no-serialization home-hg-configuration
+ (package
+ (package mercurial)
+ "The Mercurial package to use.")
+ (regexp-ignore
+ (list-of-strings '())
+ "List of regular expressions to ignore globally. The default syntax
+is Python/Perl-style regular expression (see @command{man 5 hgignore}).
+
+The @code{*-ignore} fields are equivalent to adding @code{ui.ignore =
+/file/with/ignore/rules} in your @file{hgrc}.")
+ (glob-ignore
+ (list-of-strings '())
+ "List of globs to ignore globally.")
+ (rootglob-ignore
+ (list-of-strings '())
+ "List of @dfn{rootglobs} to ignore globally.")
+ (config
+ (ini-config '())
+ "List of list representing the contents of the @file{hgrc}
+configuration file. The syntax is similar to that of the Git service.
+The key of a pair can be a symbol or string, and the value can be a
+boolean, string, symbol, number, gexp (@pxref{gexp,,,guix.info}), or a
+list of one the above.
+
+@lisp
+(config
+ `((commands
+ ((commit.post-status . #t)))
+ (graph
+ ((width . 4)))
+ (hooks
+ ((incoming.email . ,(local-file \"/path/to/email/hook\"))))))
+@end lisp
+
+will turn into this:
+
+@example
+[commands]
+ commit.post-status = True
+[graph]
+ width = 4
+[hooks]
+ incoming.email = /gnu/store/123...-email-hook
+@end example"))
+
+(define (serialize-hg-config config)
+ (define (serialize-boolean val)
+ (list (if val "True" "False")))
+
+ (define (serialize-list val)
+ (interpose (map serialize-val val) ", "))
+
+ (define (serialize-val val)
+ (cond
+ ((list? val) (serialize-list val))
+ ((boolean? val) (serialize-boolean val))
+ ((or (number? val) (symbol? val)) (list (maybe-object->string val)))
+ (else (list val))))
+
+ (define (serialize-field key val)
+ (let ((val (serialize-val val))
+ (key (symbol->string key)))
+ `(,key " = " ,@val "\n")))
+
+ (flatten (generic-serialize-ini-config
+ #:combine-ini interpose
+ #:combine-alist list
+ #:combine-section-alist cons
+ #:serialize-field serialize-field
+ #:fields config)))
+
+(define* (serialize-hg-ignores #:key regexp glob rootglob)
+ (define (add-ignore lst type)
+ (if (not (null? lst))
+ (string-append (format #f "syntax: ~a\n" type)
+ (string-join lst "\n" 'suffix))
+ ""))
+
+ (string-join (map (cut add-ignore <> <>)
+ (list regexp glob rootglob)
+ '(regexp glob rootglob))
+ "\n"))
+
+(define (home-hg-files-service config)
+ (define rest cdr)
+
+ (define (compare-sections section1 section2)
+ (string<? (symbol->string (first section1))
+ (symbol->string (first section2))))
+
+ (define (fold-sections section1 section2)
+ (cond
+ ((equal? (first section1) (first section2))
+ (list (list (first section1)
+ (append (second section1) (second section2)))))
+ (else
+ (list section1 section2))))
+
+ (define (merge-sections config)
+ (let ((sorted-config (sort config compare-sections)))
+ (fold (lambda (section acc)
+ (if (null? acc)
+ (list section)
+ (append (fold-sections section (first acc))
+ (rest acc))))
+ '()
+ sorted-config)))
+
+ (let* ((ignores (serialize-hg-ignores
+ #:regexp
+ (home-hg-configuration-regexp-ignore config)
+ #:glob
+ (home-hg-configuration-glob-ignore config)
+ #:rootglob
+ (home-hg-configuration-rootglob-ignore config)))
+ (final-config (merge-sections
+ (append (home-hg-configuration-config config)
+ `((ui
+ ((ignore . ,(plain-file "hg-ignores"
+ ignores)))))))))
+ `(("config/hg/hgrc"
+ ,(apply mixed-text-file
+ "hgrc"
+ (serialize-hg-config final-config))))))
+
+(define-configuration/no-serialization home-hg-extension
+ (regexp-ignore
+ (list-of-strings '())
+ "List of regular expressions to ignore globally.")
+ (glob-ignore
+ (list-of-strings '())
+ "List of glob expressions to ignore globally.")
+ (rootglob-ignore
+ (list-of-strings '())
+ "List of @dfn{rootglobs} to ignore globally.")
+ (config
+ (ini-config '())
+ "List of lists representing the contents of the @file{hgrc} file."))
+
+(define (home-hg-extensions original-config extension-configs)
+ (home-hg-configuration
+ (inherit original-config)
+ (regexp-ignore
+ (append (home-hg-configuration-regexp-ignore original-config)
+ (append-map
+ home-hg-extension-regexp-ignore extension-configs)))
+ (glob-ignore
+ (append (home-hg-configuration-glob-ignore original-config)
+ (append-map
+ home-hg-extension-glob-ignore extension-configs)))
+ (rootglob-ignore
+ (append (home-hg-configuration-rootglob-ignore original-config)
+ (append-map
+ home-hg-extension-rootglob-ignore extension-configs)))
+ (config
+ (append (home-hg-configuration-config original-config)
+ (append-map
+ home-hg-extension-config extension-configs)))))
+
+(define (home-hg-profile-service config)
+ (list (home-hg-configuration-package config)))
+
+(define home-hg-service-type
+ (service-type (name 'home-hg)
+ (extensions
+ (list (service-extension
+ home-files-service-type
+ home-hg-files-service)
+ (service-extension
+ home-profile-service-type
+ home-hg-profile-service)))
+ (compose identity)
+ (extend home-hg-extensions)
+ (default-value (home-hg-configuration))
+ (description "\
+Install and configure the Mercurial version control system.")))
+
+(define (generate-home-hg-documentation)
+ (string-append
+ (generate-documentation
+ `((home-hg-configuration
+ ,home-hg-configuration-fields))
+ 'home-hg-configuration)
+ "\n\n"
+ (generate-documentation
+ `((home-hg-extension
+ ,home-hg-extension-fields))
+ 'home-hg-extension)))
diff --git a/gnu/local.mk b/gnu/local.mk
index d432829e2d..4ac1083158 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -79,7 +79,9 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/fontutils.scm \
%D%/home/services/shells.scm \
%D%/home/services/shepherd.scm \
+ %D%/home/services/state.scm \
%D%/home/services/mcron.scm \
+ %D%/home/services/version-control.scm \
%D%/home/services/utils.scm \
%D%/home/services/xdg.scm \
%D%/image.scm \
diff --git a/gnu/tests/rsync.scm b/gnu/tests/rsync.scm
index 24e60d9d9d..8b4768a38a 100644
--- a/gnu/tests/rsync.scm
+++ b/gnu/tests/rsync.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,7 +30,13 @@ (define-module (gnu tests rsync)
#:use-module (gnu services networking)
#:use-module (guix gexp)
#:use-module (guix store)
- #:export (%test-rsync))
+ #:use-module (gnu home)
+ #:use-module (gnu services)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services state)
+ #:use-module (guix scripts home)
+ #:export (%test-rsync
+ %test-home-state-rsync))
(define* (run-rsync-test rsync-os #:optional (rsync-port 873))
"Run tests in %RSYNC-OS, which has rsync running and listening on
@@ -127,3 +134,152 @@ (define %test-rsync
(name "rsync")
(description "Connect to a running RSYNC server.")
(value (run-rsync-test %rsync-os))))
+
+\f
+;;;
+;;; Home
+;;;
+
+(define* (run-home-state-rsync-test home-state-rsync-os #:optional (rsync-port 873))
+ "Run tests in %HOME-STATE-RSYNC-OS, which has rsync running and listening on
+PORT."
+ (define os
+ (marionette-operating-system
+ home-state-rsync-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings '())))
+
+ (define he
+ (home-environment
+ (services
+ (list
+ (service home-state-service-type
+ (list
+ (state-rsync "/home/alice/test"
+ (string-append "rsync://localhost:"
+ (number->string rsync-port)
+ "/files/input"))))))))
+
+ (define (test script)
+ (with-imported-modules '((gnu build marionette)
+ (guix build utils))
+ #~(begin
+ (use-modules (srfi srfi-11)
+ (srfi srfi-64)
+ (gnu build marionette)
+ (guix build utils))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "home-state-rsync")
+
+ ;; Wait for rsync to be up and running.
+ (test-assert "service running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+
+ ;; Make sure the 'rsync' command is found.
+ (setenv "PATH" "/run/current-system/profile/bin")
+
+ (start-service 'rsync))
+ marionette))
+
+ ;; Make sure the PID file is created.
+ (test-assert "PID file"
+ (marionette-eval
+ '(file-exists? "/var/run/rsyncd/rsyncd.pid")
+ marionette))
+
+ (test-assert "Test file copied to share"
+ (marionette-eval
+ '(begin
+ (call-with-output-file "/tmp/input"
+ (lambda (port)
+ (display "test-file-contents\n" port)))
+ (zero?
+ (system* "rsync" "/tmp/input"
+ (string-append "rsync://localhost:"
+ (number->string #$rsync-port)
+ "/files/input"))))
+ marionette))
+
+ ;; XXX: Create /run/user/1000 and /var/guix/profiles/per-user/alice
+ ;; directories.
+ (test-assert "profile and XDG_RUNTIME_DIR directories"
+ (marionette-eval
+ '(begin
+ (for-each (lambda (directory)
+ (mkdir directory)
+ (chown directory
+ (passwd:uid (getpw "alice"))
+ (group:gid (getpw "alice"))))
+ '("/var/guix/profiles/per-user/alice"
+ "/run/user"
+ "/run/user/1000")))
+ marionette))
+
+ ;; Add /run/setuid-programs to $PATH so that the scripts
+ ;; can find 'env' and 'sudo'.
+ (marionette-eval
+ '(setenv "PATH"
+ "/run/setuid-programs:/run/current-system/profile/bin")
+ marionette)
+
+ (test-assert "script successfully evaluated"
+ (marionette-eval
+ '(begin
+ (system* "sudo" "--user" "alice" "--login"
+ "XDG_RUNTIME_DIR=/run/user/1000" "--" #$script))
+ marionette))
+
+ ;; Clone the repo.
+ (test-assert "herd init state"
+ (marionette-eval
+ '(begin
+ (invoke "sudo" "--user" "alice" "--login"
+ "--" "herd" "init" "state"))
+ marionette))
+
+ (test-equal "Test file correctly received from share"
+ "test-file-contents"
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 rdelim))
+ (call-with-input-file "/home/alice/test"
+ (lambda (port)
+ (read-line port))))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "home-state-rsync-test"
+ (test
+ (switch-home-program he "/var/guix/profiles/per-user/alice/guix-home"))))
+
+(define* %home-state-rsync-os
+ ;; Return operating system under test.
+ (let ((base-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service rsync-service-type))))
+ (operating-system
+ (inherit base-os)
+ (packages (cons* rsync
+ (operating-system-packages base-os))))))
+
+(define %test-home-state-rsync
+ (system-test
+ (name "home-state-rsync")
+ (description "Connect to a running RSYNC server.")
+ (value (run-home-state-rsync-test %home-state-rsync-os))))
diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm
index a7cde1f163..9b461d3877 100644
--- a/gnu/tests/version-control.scm
+++ b/gnu/tests/version-control.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2017, 2018, 2021 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
@@ -36,10 +36,16 @@ (define-module (gnu tests version-control)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix modules)
+ #:use-module (gnu home)
+ #:use-module (gnu services)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services state)
+ #:use-module (guix scripts home)
#:export (%test-cgit
%test-git-http
%test-gitolite
- %test-gitile))
+ %test-gitile
+ %test-home-state-git))
(define README-contents
"Hello! This is what goes inside the 'README' file.")
@@ -550,3 +556,133 @@ (define %test-gitile
(name "gitile")
(description "Connect to a running Gitile server.")
(value (run-gitile-test))))
+
+\f
+;;;
+;;; Home
+;;;
+
+(define* (run-home-state-git-test home-state-git-os)
+ "Run tests in %HOME-STATE-GIT-OS, which has Guix home configuration with
+service for Git repository management."
+ (define os
+ (marionette-operating-system
+ home-state-git-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings '())))
+
+ (define he
+ (home-environment
+ (services
+ (list
+ (service home-state-service-type
+ (list (state-git "/home/alice/test"
+ "file:///srv/git/test")))))))
+
+ (define (test script)
+ (with-imported-modules '((gnu build marionette)
+ (guix build utils))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (rnrs io ports)
+ (srfi srfi-64))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "home-state-git")
+
+ ;; Make sure Git test repository is created.
+ (test-assert "Git test repository"
+ (marionette-eval
+ '(file-exists? "/srv/git/test")
+ marionette))
+
+ ;; XXX: Create /run/user/1000 and /var/guix/profiles/per-user/alice
+ ;; directories.
+ (test-assert "profile and XDG_RUNTIME_DIR directories"
+ (marionette-eval
+ '(begin
+ (for-each (lambda (directory)
+ (mkdir directory)
+ (chown directory
+ (passwd:uid (getpw "alice"))
+ (group:gid (getpw "alice"))))
+ '("/var/guix/profiles/per-user/alice"
+ "/run/user"
+ "/run/user/1000")))
+ marionette))
+
+ ;; Add /run/setuid-programs to $PATH so that the scripts
+ ;; can find 'env' and 'sudo'.
+ (marionette-eval
+ '(setenv "PATH"
+ "/run/setuid-programs:/run/current-system/profile/bin")
+ marionette)
+
+ (test-assert "script successfully evaluated"
+ (marionette-eval
+ '(begin
+ (system* "sudo" "--user" "alice" "--login"
+ "XDG_RUNTIME_DIR=/run/user/1000" "--" #$script))
+ marionette))
+
+ ;; Clone the repo.
+ (test-assert "herd init state"
+ (marionette-eval
+ '(begin
+ (invoke "sudo" "--user" "alice" "--login"
+ "--" "herd" "init" "state"))
+ marionette))
+
+ (test-equal "repo clonned"
+ '#$README-contents
+ (marionette-eval
+ '(begin
+ (call-with-input-file "/home/alice/test/README"
+ get-string-all))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "home-state-git-test"
+ (test
+ (switch-home-program he "/var/guix/profiles/per-user/alice/guix-home"))))
+
+(define* %home-state-git-os
+ ;; Return operating system under test.
+ (let ((base-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ %test-repository-service)))
+ (operating-system
+ (inherit base-os)
+
+ ;; Set a user account; the test needs it.
+ (users (cons (user-account
+ (name "alice")
+ (group "users")
+ (uid 1000)
+ (home-directory "/home/alice"))
+ %base-user-accounts))
+
+ (packages (cons* git
+ (operating-system-packages base-os))))))
+
+(define %test-home-state-git
+ (system-test
+ (name "home-state-git")
+ (description "Manage Git repository via Guix home.")
+ (value (run-home-state-git-test %home-state-git-os))))
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 55e7b436c1..0136dd3afc 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -25,9 +25,12 @@ (define-module (guix scripts home)
#:use-module (gnu packages)
#:use-module (gnu home)
#:use-module (gnu home services)
+ #:use-module ((guix self) #:select (make-config.scm))
+ #:use-module (gnu packages gnupg)
#:use-module (guix channels)
#:use-module (guix derivations)
#:use-module (guix ui)
+ #:use-module (guix modules)
#:use-module (guix grafts)
#:use-module (guix packages)
#:use-module (guix profiles)
@@ -47,7 +50,8 @@ (define-module (guix scripts home)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
- #:export (guix-home))
+ #:export (guix-home
+ switch-home-program))
\f
;;;
@@ -139,11 +143,94 @@ (define %default-options
(verbosity . 3)
(debug . 0)))
+\f
+;;;
+;;; Profile creation.
+;;;
+
+(define not-config?
+ ;; Select (guix …) and (gnu …) modules, except (guix config).
+ (match-lambda
+ (('guix 'config) #f)
+ (('guix rest ...) #t)
+ (('gnu rest ...) #t)
+ (_ #f)))
+
+(define* (switch-home-program he-out-path #:optional (profile %guix-home))
+ "Return an executable store item that, upon being evaluated, will create a
+new generation of PROFILE pointing to the directory of HOME, switch to it
+atomically, and run HOME's activation script."
+ (program-file
+ "switch-to-home.scm"
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules `(,@(source-module-closure
+ '((guix profiles)
+ (guix utils))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (guix config)
+ (guix profiles)
+ (guix utils))
+ (let* ((number (generation-number #$profile))
+ (generation (generation-file-name
+ #$profile (+ 1 number))))
+ (use-modules (ice-9 rdelim)
+ (ice-9 popen))
+ (with-output-to-file "/tmp/out.txt"
+ (lambda ()
+ (display "he-out-path:\n")
+ (display #$he-out-path)
+ (display "\nprofile:\n")
+ (display #$profile)
+ (display "\ngeneration:\n")
+ (display generation)
+ (let* ((port
+ (open-pipe (format #f "/run/current-system/profile/bin/ls -laR ~a" #$he-out-path)
+ OPEN_READ))
+ (output (read-string port)))
+ (close-port port)
+ (pk (string-trim-right output #\newline)))))
+ (switch-symlinks generation #$he-out-path)
+ (switch-symlinks #$profile generation)
+ (setenv "GUIX_NEW_HOME" #$he-out-path)
+ (primitive-load (string-append #$he-out-path "/activate"))
+ (setenv "GUIX_NEW_HOME" #f)))))))
+
+(define* (switch-to-home eval he-out-path)
+ "Using EVAL, a monadic procedure taking a single G-Expression as an argument,
+create a new generation of PROFILE pointing to the directory of HOME, switch to
+it atomically, and run HOME's activation script."
+ (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
+ (primitive-load #$(switch-home-program he-out-path)))))
+
\f
;;;
;;; Actions.
;;;
+(define-syntax-rule (save-load-path-excursion body ...)
+ "Save the current values of '%load-path' and '%load-compiled-path', run
+BODY..., and restore them."
+ (let ((path %load-path)
+ (cpath %load-compiled-path))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ body ...)
+ (lambda ()
+ (set! %load-path path)
+ (set! %load-compiled-path cpath)))))
+
+(define (local-eval exp)
+ "Evaluate EXP, a G-Expression, in-place."
+ (mlet* %store-monad ((lowered (lower-gexp exp))
+ (_ (built-derivations (lowered-gexp-inputs lowered))))
+ (save-load-path-excursion
+ (set! %load-path (lowered-gexp-load-path lowered))
+ (set! %load-compiled-path (lowered-gexp-load-compiled-path lowered))
+ (return (primitive-eval (lowered-gexp-sexp lowered))))))
+
(define* (perform-action action he
#:key
dry-run?
@@ -170,15 +257,8 @@ (define println
(case action
((reconfigure)
- (let* ((number (generation-number %guix-home))
- (generation (generation-file-name
- %guix-home (+ 1 number))))
-
- (switch-symlinks generation he-out-path)
- (switch-symlinks %guix-home generation)
- (setenv "GUIX_NEW_HOME" he-out-path)
- (primitive-load (string-append he-out-path "/activate"))
- (setenv "GUIX_NEW_HOME" #f)
+ (mbegin %store-monad
+ (switch-to-home local-eval he-out-path)
(return he-out-path)))
(else
(newline)
--
2.33.1
^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#51359] [PATCH 0/1] home-state-service-type and tests suite
2021-10-23 18:04 [bug#51359] [PATCH 0/1] home-state-service-type and tests suite Oleg Pykhalov
2021-10-23 18:06 ` [bug#51359] [PATCH 1/1] home: services: Add state services Oleg Pykhalov
@ 2021-10-30 11:10 ` Xinglu Chen
2022-06-08 16:10 ` Andrew Tropin
2 siblings, 0 replies; 6+ messages in thread
From: Xinglu Chen @ 2021-10-30 11:10 UTC (permalink / raw)
To: Oleg Pykhalov, 51359; +Cc: Oleg Pykhalov
[-- Attachment #1: Type: text/plain, Size: 710 bytes --]
On Sat, Oct 23 2021, Oleg Pykhalov wrote:
> Hi Guix,
>
> This patch adds support for home-state-service-type which copied from the rde
> project [1]. The introduction to home state services in documentation is
> copied from discussion [2].
There are still quite a few things that have to be fixed with Guix
Home[1][2][3][4], so I suggest we fix those before adding new services.
Also, Andrew mentioned a while a go that he was going to re-design the
state services; maybe he has some updates on that.
[1]: <https://issues.guix.gnu.org/50945> and <https://issues.guix.gnu.org/50941>
[2]: <https://issues.guix.gnu.org/51141>
[3]: <https://issues.guix.gnu.org/50978>
[4]: <https://issues.guix.gnu.org/50990>
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#51359] [PATCH 0/1] home-state-service-type and tests suite
2021-10-23 18:04 [bug#51359] [PATCH 0/1] home-state-service-type and tests suite Oleg Pykhalov
2021-10-23 18:06 ` [bug#51359] [PATCH 1/1] home: services: Add state services Oleg Pykhalov
2021-10-30 11:10 ` [bug#51359] [PATCH 0/1] home-state-service-type and tests suite Xinglu Chen
@ 2022-06-08 16:10 ` Andrew Tropin
2022-06-08 17:02 ` Oleg Pykhalov
2 siblings, 1 reply; 6+ messages in thread
From: Andrew Tropin @ 2022-06-08 16:10 UTC (permalink / raw)
To: Oleg Pykhalov, 51359; +Cc: Oleg Pykhalov
[-- Attachment #1: Type: text/plain, Size: 1765 bytes --]
On 2021-10-23 21:04, Oleg Pykhalov wrote:
> Hi Guix,
>
> This patch adds support for home-state-service-type which copied from the rde
> project [1]. The introduction to home state services in documentation is
> copied from discussion [2].
>
> Tests passed:
>
> make check-system TESTS="home-state-git"
> make check-system TESTS="home-state-rsync"
>
> [1] https://github.com/abcdw/rde/
> [2] https://lists.sr.ht/~abcdw/rde-devel/%3C87pmzze9nn.fsf%40trop.in%3E#%3CCABrWRW1Fq-8mS=MbWJedUpayj1vFg-YE0oNF3zVTYWBMnp29Lg@mail.gmail.com%3E
>
> Oleg Pykhalov (1):
> home: services: Add state services.
>
> doc/guix.texi | 32 ++
> gnu/home.scm | 12 +
> gnu/home/services/state.scm | 210 ++++++++++++
> gnu/home/services/utils.scm | 81 ++++-
> gnu/home/services/version-control.scm | 442 ++++++++++++++++++++++++++
> gnu/local.mk | 2 +
> gnu/tests/rsync.scm | 158 ++++++++-
> gnu/tests/version-control.scm | 140 +++++++-
> guix/scripts/home.scm | 100 +++++-
> 9 files changed, 1163 insertions(+), 14 deletions(-)
> create mode 100644 gnu/home/services/state.scm
> create mode 100644 gnu/home/services/version-control.scm
Hi Oleg!
Thank you for the patch, but states are very WIP and not ready for
upstream yet IMO. Also, I would like to reevaluate implementation of
git service-type and probably merge it separately.
Sorry for replying slowly :)
Hope I will get back to states in foreseable future and will carefully
rethink, refactor and cleanup the code.
BTW, do you use states? Can you share your experience with it?
--
Best regards,
Andrew Tropin
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#51359] [PATCH 0/1] home-state-service-type and tests suite
2022-06-08 16:10 ` Andrew Tropin
@ 2022-06-08 17:02 ` Oleg Pykhalov
2022-06-08 18:23 ` Andrew Tropin
0 siblings, 1 reply; 6+ messages in thread
From: Oleg Pykhalov @ 2022-06-08 17:02 UTC (permalink / raw)
To: Andrew Tropin; +Cc: 51359
[-- Attachment #1: Type: text/plain, Size: 684 bytes --]
Hi Andrew,
Andrew Tropin <andrew@trop.in> writes:
[…]
> Thank you for the patch, but states are very WIP and not ready for
> upstream yet IMO. Also, I would like to reevaluate implementation of
> git service-type and probably merge it separately.
>
> Hope I will get back to states in foreseable future and will carefully
> rethink, refactor and cleanup the code.
If the user's configuration will stay the same, we probably could merge.
> BTW, do you use states? Can you share your experience with it?
I tried the git state and it worked, don't remember rsync. Also I don't
use it since the patch submitting day, because of plans to rewrite it.
Oleg.
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#51359] [PATCH 0/1] home-state-service-type and tests suite
2022-06-08 17:02 ` Oleg Pykhalov
@ 2022-06-08 18:23 ` Andrew Tropin
0 siblings, 0 replies; 6+ messages in thread
From: Andrew Tropin @ 2022-06-08 18:23 UTC (permalink / raw)
To: Oleg Pykhalov; +Cc: 51359
[-- Attachment #1: Type: text/plain, Size: 1169 bytes --]
On 2022-06-08 20:02, Oleg Pykhalov wrote:
> Hi Andrew,
>
> Andrew Tropin <andrew@trop.in> writes:
>
> […]
>
>> Thank you for the patch, but states are very WIP and not ready for
>> upstream yet IMO. Also, I would like to reevaluate implementation of
>> git service-type and probably merge it separately.
>>
>> Hope I will get back to states in foreseable future and will carefully
>> rethink, refactor and cleanup the code.
>
> If the user's configuration will stay the same, we probably could merge.
>
Not sure if it will stay the same. The implementation is quite fragile
and for sure should be revisited, maybe the user facing interface can be
organized better as well.
>> BTW, do you use states? Can you share your experience with it?
>
> I tried the git state and it worked, don't remember rsync. Also I don't
> use it since the patch submitting day, because of plans to rewrite it.
Ok. I think I'll experiment with a new version of states in rde project
first and later will come back to merging it to Guix. It seems as an
important feature, but it's hard to say when I'll get to it.
--
Best regards,
Andrew Tropin
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2022-06-08 18:24 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-23 18:04 [bug#51359] [PATCH 0/1] home-state-service-type and tests suite Oleg Pykhalov
2021-10-23 18:06 ` [bug#51359] [PATCH 1/1] home: services: Add state services Oleg Pykhalov
2021-10-30 11:10 ` [bug#51359] [PATCH 0/1] home-state-service-type and tests suite Xinglu Chen
2022-06-08 16:10 ` Andrew Tropin
2022-06-08 17:02 ` Oleg Pykhalov
2022-06-08 18:23 ` Andrew Tropin
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).