summaryrefslogtreecommitdiff
path: root/gnu/system/shadow.scm
blob: 654fd4d55b332b0826af3159f26c58a2d2b21e41 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
;;; 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 (guix records)
  #:use-module (guix packages)
  #:use-module (guix monads)
  #:use-module ((gnu packages system)
                #:select (shadow))
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #: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
            guix-build-accounts))

;;; 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 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)))))

  (text-file "group" contents))

(define* (passwd-file 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)))))

  (text-file (if shadow? "shadow" "passwd") contents))

(define* (guix-build-accounts count #:key
                              (first-uid 30001)
                              (gid 30000)
                              (shadow shadow))
  "Return a list of COUNT user accounts for Guix build users, with UIDs
starting at FIRST-UID, and under GID."
  (mlet* %store-monad ((gid* -> gid)
                       (no-login (package-file shadow "sbin/nologin")))
    (return (unfold (cut > <> count)
                    (lambda (n)
                      (user-account
                       (name (format #f "guixbuilder~2,'0d" n))
                       (password "!")
                       (uid (+ first-uid n -1))
                       (gid gid*)
                       (comment (format #f "Guix Build User ~2d" n))
                       (home-directory "/var/empty")
                       (shell no-login)))
                    1+
                    1))))

;;; shadow.scm ends here