services: user-homes: Do not create home directories marked as no-create.
Fixes a bug whereby GuixSD would create the /nonexistent directory, from user 'nobody', even though it has 'create-home-directory?' set to #f. * gnu/build/activation.scm (activate-users+groups): Add comment for \#:create-home?. (activate-user-home)[ensure-user-home]: Skip when CREATE-HOME? is #f or SYSTEM? is #t. * gnu/tests/base.scm (run-basic-test)["no extra home directories"]: New tests.
This commit is contained in:
		
							parent
							
								
									f3f8938fe0
								
							
						
					
					
						commit
						51fe9cd38d
					
				
					 2 changed files with 30 additions and 1 deletions
				
			
		|  | @ -227,7 +227,11 @@ numeric gid or #f." | |||
|                      #:supplementary-groups supplementary-groups | ||||
|                      #:comment comment | ||||
|                      #:home home | ||||
| 
 | ||||
|                      ;; Home directories of non-system accounts are created by | ||||
|                      ;; 'activate-user-home'. | ||||
|                      #:create-home? (and create-home? system?) | ||||
| 
 | ||||
|                      #:shell shell | ||||
|                      #:password password) | ||||
| 
 | ||||
|  | @ -282,7 +286,10 @@ they already exist." | |||
|     (match-lambda | ||||
|       ((name uid group supplementary-groups comment home create-home? | ||||
|              shell password system?) | ||||
|        (unless (or (not home) (directory-exists? home)) | ||||
|        ;; The home directories of system accounts are created during | ||||
|        ;; activation, not here. | ||||
|        (unless (or (not home) (not create-home?) system? | ||||
|                    (directory-exists? home)) | ||||
|          (let* ((pw  (getpwnam name)) | ||||
|                 (uid (passwd:uid pw)) | ||||
|                 (gid (passwd:gid pw))) | ||||
|  |  | |||
|  | @ -199,6 +199,28 @@ info --version") | |||
|                          ',users+homes)) | ||||
|                marionette))) | ||||
| 
 | ||||
|           (test-equal "no extra home directories" | ||||
|             '() | ||||
| 
 | ||||
|             ;; Make sure the home directories that are not supposed to be | ||||
|             ;; created are indeed not created. | ||||
|             (let ((nonexistent | ||||
|                    '#$(filter-map (lambda (user) | ||||
|                                     (and (not | ||||
|                                           (user-account-create-home-directory? | ||||
|                                            user)) | ||||
|                                          (user-account-home-directory user))) | ||||
|                                   (operating-system-user-accounts os)))) | ||||
|               (marionette-eval | ||||
|                `(begin | ||||
|                   (use-modules (srfi srfi-1)) | ||||
| 
 | ||||
|                   ;; Note: Do not flag "/var/empty". | ||||
|                   (filter file-exists? | ||||
|                           ',(remove (cut string-prefix? "/var/" <>) | ||||
|                                     nonexistent))) | ||||
|                marionette))) | ||||
| 
 | ||||
|           (test-equal "login on tty1" | ||||
|             "root\n" | ||||
|             (begin | ||||
|  |  | |||
		Reference in a new issue