aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/rsync.scm170
1 files changed, 123 insertions, 47 deletions
diff --git a/gnu/services/rsync.scm b/gnu/services/rsync.scm
index 6e27edde25..d456911563 100644
--- a/gnu/services/rsync.scm
+++ b/gnu/services/rsync.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,11 +26,23 @@
#:use-module (gnu packages admin)
#:use-module (guix records)
#:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (rsync-configuration
rsync-configuration?
+ rsync-configuration-modules
+
+ rsync-module
+ rsync-module?
+ rsync-module-name
+ rsync-module-file-name
+ rsync-module-comment
+ rsync-module-read-only
+ rsync-module-timeout
+
rsync-service-type))
;;;; Commentary:
@@ -39,6 +52,13 @@
;;;
;;;; Code:
+(define-with-syntax-properties (warn-share-field-deprecation (value properties))
+ (unless (unspecified? value)
+ (warning (source-properties->location properties)
+ (G_ "the 'share-path' and 'share-comment' fields is deprecated, \
+please use 'modules' instead~%")))
+ value)
+
(define-record-type* <rsync-configuration>
rsync-configuration
make-rsync-configuration
@@ -56,15 +76,22 @@
(log-file rsync-configuration-log-file ; string
(default "/var/log/rsyncd.log"))
(use-chroot? rsync-configuration-use-chroot? ; boolean
- (default #t))
+ (sanitize warn-share-field-deprecation)
+ (default *unspecified*))
+ (modules rsync-configuration-actual-modules ;list of <rsync-module>
+ (default %default-modules)) ;TODO: eventually remove default
(share-path rsync-configuration-share-path ; string
- (default "/srv/rsyncd"))
+ (sanitize warn-share-field-deprecation)
+ (default *unspecified*))
(share-comment rsync-configuration-share-comment ; string
- (default "Rsync share"))
+ (sanitize warn-share-field-deprecation)
+ (default *unspecified*))
(read-only? rsync-configuration-read-only? ; boolean
- (default #f))
+ (sanitize warn-share-field-deprecation)
+ (default *unspecified*))
(timeout rsync-configuration-timeout ; integer
- (default 300))
+ (sanitize warn-share-field-deprecation)
+ (default *unspecified*))
(user rsync-configuration-user ; string
(default "root"))
(group rsync-configuration-group ; string
@@ -74,6 +101,45 @@
(gid rsync-configuration-gid ; string
(default "rsyncd")))
+;; Rsync "module": a directory exported the rsync protocol.
+(define-record-type* <rsync-module>
+ rsync-module make-rsync-module
+ rsync-module?
+ (name rsync-module-name) ;string
+ (file-name rsync-module-file-name) ;string
+ (comment rsync-module-comment ;string
+ (default ""))
+ (read-only? rsync-module-read-only? ;boolean
+ (default #t))
+ (chroot? rsync-module-chroot? ;boolean
+ (default #t))
+ (timeout rsync-module-timeout ;integer
+ (default 300)))
+
+(define %default-modules
+ ;; Default modules, provided for backward compatibility.
+ (list (rsync-module (name "files")
+ (file-name "/srv/rsyncd")
+ (comment "Rsync share")
+ (read-only? #f)))) ;yes, that was the default
+
+(define (rsync-configuration-modules config)
+ (match-record config <rsync-configuration>
+ (modules
+ share-path share-comment use-chroot? read-only? timeout) ;deprecated
+ (if (unspecified? share-path)
+ (rsync-configuration-actual-modules config)
+ (list (rsync-module ;backward compatibility
+ (name "files")
+ (file-name share-path)
+ (comment "Rsync share")
+ (chroot?
+ (if (unspecified? use-chroot?) #t use-chroot?))
+ (read-only?
+ (if (unspecified? read-only?) #f read-only?))
+ (timeout
+ (if (unspecified? timeout) 300 timeout)))))))
+
(define (rsync-account config)
"Return the user accounts and user groups for CONFIG."
(let ((rsync-user (if (rsync-configuration-uid config)
@@ -96,55 +162,62 @@
"Return the activation GEXP for CONFIG."
(with-imported-modules '((guix build utils))
#~(begin
- (let ((share-directory #$(rsync-configuration-share-path config))
- (user (getpw (if #$(rsync-configuration-uid config)
+ (let ((user (getpw (if #$(rsync-configuration-uid config)
#$(rsync-configuration-uid config)
#$(rsync-configuration-user config))))
(group (getpw (if #$(rsync-configuration-gid config)
#$(rsync-configuration-gid config)
#$(rsync-configuration-group config)))))
(mkdir-p (dirname #$(rsync-configuration-pid-file config)))
- (and=> share-directory mkdir-p)
- (chown share-directory
- (passwd:uid user)
- (group:gid group))))))
+ (for-each (lambda (directory)
+ (mkdir-p directory)
+ (chown directory (passwd:uid user) (group:gid group)))
+ '#$(map rsync-module-file-name
+ (rsync-configuration-modules config)))))))
-(define rsync-config-file
+(define (rsync-config-file config)
;; Return the rsync configuration file corresponding to CONFIG.
- (match-lambda
- (($ <rsync-configuration> package address port-number pid-file lock-file log-file
- use-chroot? share-path share-comment read-only?
- timeout user group uid gid)
- (if (not (string=? user "root"))
- (cond
- ((<= port-number 1024)
- (error (string-append "rsync-service: to run on port "
- (number->string port-number)
- ", user must be root.")))
- (use-chroot?
- (error (string-append "rsync-service: to run in a chroot"
- ", user must be root.")))
- (uid
- (error "rsync-service: to use uid, user must be root."))
- (gid
- (error "rsync-service: to use gid, user must be root."))))
- (mixed-text-file
- "rsync.conf"
- "# Generated by 'rsync-service'.\n\n"
- "pid file = " pid-file "\n"
- "lock file = " lock-file "\n"
- "log file = " log-file "\n"
- (if address (string-append "address = " address "\n") "")
- "port = " (number->string port-number) "\n"
- "use chroot = " (if use-chroot? "true" "false") "\n"
- (if uid (string-append "uid = " uid "\n") "")
- "gid = " (if gid gid "nogroup") "\n" ; no group nobody
- "\n"
- "[files]\n"
- "path = " share-path "\n"
- "comment = " share-comment "\n"
- "read only = " (if read-only? "true" "false") "\n"
- "timeout = " (number->string timeout) "\n"))))
+ (define (module-config module)
+ (match-record module <rsync-module>
+ (name file-name comment chroot? read-only? timeout)
+ (list "[" name "]\n"
+ " path = " file-name "\n"
+ " use chroot = " (if chroot? "true" "false") "\n"
+ " comment = " comment "\n"
+ " read only = " (if read-only? "true" "false") "\n"
+ " timeout = " (number->string timeout) "\n")))
+
+ (define modules
+ (rsync-configuration-modules config))
+
+ (match-record config <rsync-configuration>
+ (package address port-number pid-file lock-file log-file
+ user group uid gid)
+ (unless (string=? user "root")
+ (cond
+ ((<= port-number 1024)
+ (error (string-append "rsync-service: to run on port "
+ (number->string port-number)
+ ", user must be root.")))
+ ((find rsync-module-chroot? modules)
+ (error (string-append "rsync-service: to run in a chroot"
+ ", user must be root.")))
+ (uid
+ (error "rsync-service: to use uid, user must be root."))
+ (gid
+ (error "rsync-service: to use gid, user must be root."))))
+
+ (apply mixed-text-file "rsync.conf"
+ "# Generated by 'rsync-service'.\n\n"
+ "pid file = " pid-file "\n"
+ "lock file = " lock-file "\n"
+ "log file = " log-file "\n"
+ (if address (string-append "address = " address "\n") "")
+ "port = " (number->string port-number) "\n"
+ (if uid (string-append "uid = " uid "\n") "")
+ "gid = " (if gid gid "nogroup") "\n" ; no group nobody
+ "\n\n"
+ (append-map module-config modules))))
(define (rsync-shepherd-service config)
"Return a <shepherd-service> for rsync with CONFIG."
@@ -172,4 +245,7 @@
(list (service-extension shepherd-root-service-type rsync-shepherd-service)
(service-extension account-service-type rsync-account)
(service-extension activation-service-type rsync-activation)))
- (default-value (rsync-configuration))))
+ (default-value (rsync-configuration))
+ (description
+ "Run the rsync file copying tool in daemon mode. This allows remote hosts
+to keep synchronized copies of the files exported by rsync.")))
generated by cgit