system: Populate /etc/shells from ACCOUNT-SERVICE-TYPE.
* gnu/system.scm (user-shells): Remove. (operating-system-etc-service): Remove "shells" entry. (shells-file): Move to... * gnu/system/shadow.scm (shells-file): ... here. New procedure. (etc-skel): Rename to... (etc-files): ... this. Add "shells" entry. (account-service-type): Adjust accordingly.
This commit is contained in:
		
							parent
							
								
									ba583bd2ce
								
							
						
					
					
						commit
						21059b26b0
					
				
					 2 changed files with 26 additions and 32 deletions
				
			
		| 
						 | 
					@ -403,38 +403,11 @@ settings for 'guix.el' to work out-of-the-box."
 | 
				
			||||||
                     (chdir #$output)
 | 
					                     (chdir #$output)
 | 
				
			||||||
                     (symlink #$(emacs-site-file) "site-start.el"))))
 | 
					                     (symlink #$(emacs-site-file) "site-start.el"))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (user-shells os)
 | 
					 | 
				
			||||||
  "Return the list of all the shells used by the accounts of OS.  These may be
 | 
					 | 
				
			||||||
gexps or strings."
 | 
					 | 
				
			||||||
  (map user-account-shell (operating-system-accounts os)))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(define (shells-file shells)
 | 
					 | 
				
			||||||
  "Return a file-like object that builds a shell list for use as /etc/shells
 | 
					 | 
				
			||||||
based on SHELLS.  /etc/shells is used by xterm, polkit, and other programs."
 | 
					 | 
				
			||||||
  (computed-file "shells"
 | 
					 | 
				
			||||||
                 #~(begin
 | 
					 | 
				
			||||||
                     (use-modules (srfi srfi-1))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
                     (define shells
 | 
					 | 
				
			||||||
                       (delete-duplicates (list #$@shells)))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
                     (call-with-output-file #$output
 | 
					 | 
				
			||||||
                       (lambda (port)
 | 
					 | 
				
			||||||
                         (display "\
 | 
					 | 
				
			||||||
/bin/sh
 | 
					 | 
				
			||||||
/run/current-system/profile/bin/sh
 | 
					 | 
				
			||||||
/run/current-system/profile/bin/bash\n" port)
 | 
					 | 
				
			||||||
                         (for-each (lambda (shell)
 | 
					 | 
				
			||||||
                                     (display shell port)
 | 
					 | 
				
			||||||
                                     (newline port))
 | 
					 | 
				
			||||||
                                   shells))))))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(define* (operating-system-etc-service os)
 | 
					(define* (operating-system-etc-service os)
 | 
				
			||||||
  "Return a <service> that builds containing the static part of the /etc
 | 
					  "Return a <service> that builds containing the static part of the /etc
 | 
				
			||||||
directory."
 | 
					directory."
 | 
				
			||||||
  (let ((login.defs (plain-file "login.defs" "# Empty for now.\n"))
 | 
					  (let ((login.defs (plain-file "login.defs" "# Empty for now.\n"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        (shells     (shells-file (user-shells os)))
 | 
					 | 
				
			||||||
        (emacs      (emacs-site-directory))
 | 
					        (emacs      (emacs-site-directory))
 | 
				
			||||||
        (issue      (plain-file "issue" (operating-system-issue os)))
 | 
					        (issue      (plain-file "issue" (operating-system-issue os)))
 | 
				
			||||||
        (nsswitch   (plain-file "nsswitch.conf"
 | 
					        (nsswitch   (plain-file "nsswitch.conf"
 | 
				
			||||||
| 
						 | 
					@ -524,7 +497,6 @@ fi\n")))
 | 
				
			||||||
       ("login.defs" ,#~#$login.defs)
 | 
					       ("login.defs" ,#~#$login.defs)
 | 
				
			||||||
       ("issue" ,#~#$issue)
 | 
					       ("issue" ,#~#$issue)
 | 
				
			||||||
       ("nsswitch.conf" ,#~#$nsswitch)
 | 
					       ("nsswitch.conf" ,#~#$nsswitch)
 | 
				
			||||||
       ("shells" ,#~#$shells)
 | 
					 | 
				
			||||||
       ("profile" ,#~#$profile)
 | 
					       ("profile" ,#~#$profile)
 | 
				
			||||||
       ("bashrc" ,#~#$bashrc)
 | 
					       ("bashrc" ,#~#$bashrc)
 | 
				
			||||||
       ("hosts" ,#~#$(or (operating-system-hosts-file os)
 | 
					       ("hosts" ,#~#$(or (operating-system-hosts-file os)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -280,11 +280,33 @@ group."
 | 
				
			||||||
      (activate-users+groups (list #$@user-specs)
 | 
					      (activate-users+groups (list #$@user-specs)
 | 
				
			||||||
                             (list #$@group-specs))))
 | 
					                             (list #$@group-specs))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (etc-skel arguments)
 | 
					(define (shells-file shells)
 | 
				
			||||||
 | 
					  "Return a file-like object that builds a shell list for use as /etc/shells
 | 
				
			||||||
 | 
					based on SHELLS.  /etc/shells is used by xterm, polkit, and other programs."
 | 
				
			||||||
 | 
					  (computed-file "shells"
 | 
				
			||||||
 | 
					                 #~(begin
 | 
				
			||||||
 | 
					                     (use-modules (srfi srfi-1))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					                     (define shells
 | 
				
			||||||
 | 
					                       (delete-duplicates (list #$@shells)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					                     (call-with-output-file #$output
 | 
				
			||||||
 | 
					                       (lambda (port)
 | 
				
			||||||
 | 
					                         (display "\
 | 
				
			||||||
 | 
					/bin/sh
 | 
				
			||||||
 | 
					/run/current-system/profile/bin/sh
 | 
				
			||||||
 | 
					/run/current-system/profile/bin/bash\n" port)
 | 
				
			||||||
 | 
					                         (for-each (lambda (shell)
 | 
				
			||||||
 | 
					                                     (display shell port)
 | 
				
			||||||
 | 
					                                     (newline port))
 | 
				
			||||||
 | 
					                                   shells))))))
 | 
				
			||||||
 | 
					(define (etc-files arguments)
 | 
				
			||||||
  "Filter out among ARGUMENTS things corresponding to skeletons, and return
 | 
					  "Filter out among ARGUMENTS things corresponding to skeletons, and return
 | 
				
			||||||
the /etc/skel directory for those."
 | 
					the /etc/skel directory for those."
 | 
				
			||||||
  (let ((skels (filter pair? arguments)))
 | 
					  (let ((skels (filter pair? arguments))
 | 
				
			||||||
    `(("skel" ,(skeleton-directory skels)))))
 | 
					        (users (filter user-account? arguments)))
 | 
				
			||||||
 | 
					    `(("skel" ,(skeleton-directory skels))
 | 
				
			||||||
 | 
					      ("shells" ,(shells-file (map user-account-shell users))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define account-service-type
 | 
					(define account-service-type
 | 
				
			||||||
  (service-type (name 'account)
 | 
					  (service-type (name 'account)
 | 
				
			||||||
| 
						 | 
					@ -298,7 +320,7 @@ the /etc/skel directory for those."
 | 
				
			||||||
                 (list (service-extension activation-service-type
 | 
					                 (list (service-extension activation-service-type
 | 
				
			||||||
                                          account-activation)
 | 
					                                          account-activation)
 | 
				
			||||||
                       (service-extension etc-service-type
 | 
					                       (service-extension etc-service-type
 | 
				
			||||||
                                          etc-skel)))))
 | 
					                                          etc-files)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (account-service accounts+groups skeletons)
 | 
					(define (account-service accounts+groups skeletons)
 | 
				
			||||||
  "Return a <service> that takes care of user accounts and user groups, with
 | 
					  "Return a <service> that takes care of user accounts and user groups, with
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue