[jackhill/guix/guix.git] / gnu / system / shadow.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu system shadow)
  #:use-module (guix store)
  #:use-module (ice-9 match)
  #:use-module (guix records)
  #:export (user-account
            user-account?
            user-account-name
            user-account-pass
            user-account-uid
            user-account-gid
            user-account-comment
            user-account-home-directory
            user-account-shell

            user-group
            user-group?
            user-group-name
            user-group-password
            user-group-id
            user-group-members

            passwd-file
            group-file))

;;; Commentary:
;;;
;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.)
;;;
;;; Code:

(define-record-type* <user-account>
  user-account make-user-account
  user-account?
  (name           user-account-name)
  (password       user-account-pass (default ""))
  (uid            user-account-uid)
  (gid            user-account-gid)
  (comment        user-account-comment (default ""))
  (home-directory user-account-home-directory)
  (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?)
  "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
file."
  ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
  (define contents
    (let loop ((accounts accounts)
               (result   '()))
      (match accounts
        ((($ <user-account> name pass uid gid comment home-dir shell)
          rest ...)
         (loop rest
               (cons (if shadow?
                         (string-append name
                                        ":"       ; XXX: use (crypt PASS …)?
                                        ":::::::")
                         (string-append name
                                        ":" "x"
                                        ":" (number->string uid)
                                        ":" (number->string gid)
                                        ":" comment ":" home-dir ":" shell))
                     result)))
        (()
         (string-join (reverse result) "\n" 'suffix)))))

  (add-text-to-store store (if shadow? "shadow" "passwd")
                     contents '()))

;;; shadow.scm ends here
Commit	Line	Data
0ded70f3 LC	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19	(define-module (gnu system shadow)
	20	#:use-module (guix store)
	21	#:use-module (ice-9 match)
bacadb02 LC	22	#:use-module (guix records)
	23	#:export (user-account
	24	user-account?
	25	user-account-name
	26	user-account-pass
	27	user-account-uid
	28	user-account-gid
	29	user-account-comment
	30	user-account-home-directory
	31	user-account-shell
	32
16a0e9dc LC	33	user-group
	34	user-group?
	35	user-group-name
	36	user-group-password
	37	user-group-id
	38	user-group-members
	39
	40	passwd-file
	41	group-file))
0ded70f3 LC	42
	43	;;; Commentary:
	44	;;;
	45	;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.)
	46	;;;
	47	;;; Code:
	48
bacadb02 LC	49	(define-record-type* <user-account>
	50	user-account make-user-account
	51	user-account?
	52	(name user-account-name)
	53	(password user-account-pass (default ""))
	54	(uid user-account-uid)
	55	(gid user-account-gid)
	56	(comment user-account-comment (default ""))
	57	(home-directory user-account-home-directory)
	58	(shell user-account-shell (default "/bin/sh")))
	59
16a0e9dc LC	60	(define-record-type* <user-group>
	61	user-group make-user-group
	62	user-group?
	63	(name user-group-name)
	64	(password user-group-password (default #f))
	65	(id user-group-id)
	66	(members user-group-members (default '())))
	67
	68	(define (group-file store groups)
	69	"Return a /etc/group file for GROUPS, a list of <user-group> objects."
	70	(define contents
	71	(let loop ((groups groups)
	72	(result '()))
	73	(match groups
	74	((($ <user-group> name _ gid (users ...)) rest ...)
	75	;; XXX: Ignore the group password.
	76	(loop rest
	77	(cons (string-append name "::" (number->string gid)
	78	":" (string-join users ","))
	79	result)))
	80	(()
	81	(string-join (reverse result) "\n" 'suffix)))))
	82
	83	(add-text-to-store store "group" contents))
	84
0ded70f3	85	(define* (passwd-file store accounts #:key shadow?)
bacadb02 LC	86	"Return a password file for ACCOUNTS, a list of <user-account> objects. If
	87	SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd
	88	file."
0ded70f3 LC	89	;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
	90	(define contents
	91	(let loop ((accounts accounts)
	92	(result '()))
	93	(match accounts
bacadb02 LC	94	((($ <user-account> name pass uid gid comment home-dir shell)
bacadb02 LC	95	rest ...)
0ded70f3 LC	96	(loop rest
	97	(cons (if shadow?
	98	(string-append name
	99	":" ; XXX: use (crypt PASS …)?
	100	":::::::")
	101	(string-append name
	102	":" "x"
	103	":" (number->string uid)
	104	":" (number->string gid)
	105	":" comment ":" home-dir ":" shell))
	106	result)))
	107	(()
	108	(string-join (reverse result) "\n" 'suffix)))))
	109
	110	(add-text-to-store store (if shadow? "shadow" "passwd")
	111	contents '()))
	112
	113	;;; shadow.scm ends here