aboutsummaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/activation.scm49
1 files changed, 46 insertions, 3 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 909e971833..64c3410baf 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -40,6 +40,24 @@
;;;
;;; Code:
+(define (enumerate thunk)
+ "Return the list of values returned by THUNK until it returned #f."
+ (let loop ((entry (thunk))
+ (result '()))
+ (if (not entry)
+ (reverse result)
+ (loop (thunk) (cons entry result)))))
+
+(define (current-users)
+ "Return the passwd entries for all the currently defined user accounts."
+ (setpw)
+ (enumerate getpwent))
+
+(define (current-groups)
+ "Return the group entries for all the currently defined user groups."
+ (setgr)
+ (enumerate getgrent))
+
(define* (add-group name #:key gid password system?
(log-port (current-error-port)))
"Add NAME as a user group, with the given numeric GID if specified."
@@ -128,6 +146,17 @@ properties. Return #t on success."
,name)))
(zero? (apply system* "usermod" args))))
+(define* (delete-user name #:key (log-port (current-error-port)))
+ "Remove user account NAME. Return #t on success. This may fail if NAME is
+logged in."
+ (format log-port "deleting user '~a'...~%" name)
+ (zero? (system* "userdel" name)))
+
+(define* (delete-group name #:key (log-port (current-error-port)))
+ "Remove group NAME. Return #t on success."
+ (format log-port "deleting group '~a'...~%" name)
+ (zero? (system* "groupdel" name)))
+
(define* (ensure-user name group
#:key uid comment home shell password system?
(supplementary-groups '())
@@ -186,8 +215,22 @@ numeric gid or #f."
#:system? system?))))
groups)
- ;; Finally create the other user accounts.
- (for-each activate-user users))
+ ;; Create the other user accounts.
+ (for-each activate-user users)
+
+ ;; Finally, delete extra user accounts and groups.
+ (for-each delete-user
+ (lset-difference string=?
+ (map passwd:name (current-users))
+ (match users
+ (((names . _) ...)
+ names))))
+ (for-each delete-group
+ (lset-difference string=?
+ (map group:name (current-groups))
+ (match groups
+ (((names . _) ...)
+ names)))))
(define (activate-etc etc)
"Install ETC, a directory in the store, as the source of static files for