gnu: shadow: Add record type for user groups.
* gnu/system/shadow.scm (<user-group>): New record type. (group-file): New procedure. * gnu/system/vm.scm (system-qemu-image): Use it.
This commit is contained in:
		
							parent
							
								
									bacadb026c
								
							
						
					
					
						commit
						16a0e9dc34
					
				
					 2 changed files with 38 additions and 3 deletions
				
			
		|  | @ -30,7 +30,15 @@ | ||||||
|             user-account-home-directory |             user-account-home-directory | ||||||
|             user-account-shell |             user-account-shell | ||||||
| 
 | 
 | ||||||
|             passwd-file)) |             user-group | ||||||
|  |             user-group? | ||||||
|  |             user-group-name | ||||||
|  |             user-group-password | ||||||
|  |             user-group-id | ||||||
|  |             user-group-members | ||||||
|  | 
 | ||||||
|  |             passwd-file | ||||||
|  |             group-file)) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;;; | ;;; | ||||||
|  | @ -49,6 +57,31 @@ | ||||||
|   (home-directory user-account-home-directory) |   (home-directory user-account-home-directory) | ||||||
|   (shell          user-account-shell (default "/bin/sh"))) |   (shell          user-account-shell (default "/bin/sh"))) | ||||||
| 
 | 
 | ||||||
|  | (define-record-type* <user-group> | ||||||
|  |   user-group make-user-group | ||||||
|  |   user-group? | ||||||
|  |   (name           user-group-name) | ||||||
|  |   (password       user-group-password (default #f)) | ||||||
|  |   (id             user-group-id) | ||||||
|  |   (members        user-group-members (default '()))) | ||||||
|  | 
 | ||||||
|  | (define (group-file store groups) | ||||||
|  |   "Return a /etc/group file for GROUPS, a list of <user-group> objects." | ||||||
|  |   (define contents | ||||||
|  |     (let loop ((groups groups) | ||||||
|  |                (result '())) | ||||||
|  |       (match groups | ||||||
|  |         ((($ <user-group> name _ gid (users ...)) rest ...) | ||||||
|  |          ;; XXX: Ignore the group password. | ||||||
|  |          (loop rest | ||||||
|  |                (cons (string-append name "::" (number->string gid) | ||||||
|  |                                     ":" (string-join users ",")) | ||||||
|  |                      result))) | ||||||
|  |         (() | ||||||
|  |          (string-join (reverse result) "\n" 'suffix))))) | ||||||
|  | 
 | ||||||
|  |   (add-text-to-store store "group" contents)) | ||||||
|  | 
 | ||||||
| (define* (passwd-file store accounts #:key shadow?) | (define* (passwd-file store accounts #:key shadow?) | ||||||
|   "Return a password file for ACCOUNTS, a list of <user-account> objects.  If |   "Return a password file for ACCOUNTS, a list of <user-account> objects.  If | ||||||
| SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd | SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd | ||||||
|  |  | ||||||
|  | @ -484,8 +484,10 @@ Happy birthday, GNU!                                http://www.gnu.org/gnu30 | ||||||
|                              (shell bash-file)))) |                              (shell bash-file)))) | ||||||
|            (passwd    (passwd-file store accounts)) |            (passwd    (passwd-file store accounts)) | ||||||
|            (shadow    (passwd-file store accounts #:shadow? #t)) |            (shadow    (passwd-file store accounts #:shadow? #t)) | ||||||
|            (group     (add-text-to-store store "group" |            (group     (group-file store | ||||||
|                                          "root:x:0:\n")) |                                   (list (user-group | ||||||
|  |                                          (name "root") | ||||||
|  |                                          (id 0))))) | ||||||
|            (pam.d-drv (pam-services->directory store %pam-services)) |            (pam.d-drv (pam-services->directory store %pam-services)) | ||||||
|            (pam.d     (derivation->output-path pam.d-drv)) |            (pam.d     (derivation->output-path pam.d-drv)) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
		Reference in a new issue