;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019, 2021 Ludovic Courtès ;;; ;;; 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 . (define-module (gnu build accounts) #:use-module (guix records) #:use-module (guix combinators) #:use-module (gnu system accounts) #:use-module (srfi srfi-1) #:u
aboutsummaryrefslogtreecommitdiff
ModeNameSize
-rw-r--r--.dir-locals.el5284logplainabout
-rw-r--r--.gitignore2665logplainabout
-rw-r--r--.guix-channel81logplainabout
-rw-r--r--.mailmap4283logplainabout
-rw-r--r--AUTHORS472logplainabout
-rw-r--r--CODE-OF-CONDUCT3273logplainabout
-rw-r--r--COPYING35147logplainabout
-rw-r--r--ChangeLog163logplainabout
-rw-r--r--HACKING749logplainabout
-rw-r--r--Makefile.am30612logplainabout
-rw-r--r--NEWS351752logplainabout
-rw-r--r--README5919logplainabout
-rw-r--r--ROADMAP3237logplainabout
-rw-r--r--THANKS2381logplainabout
-rw-r--r--TODO4360logplainabout
-rwxr-xr-xbootstrap904logplainabout
d---------build-aux778logplain
-rw-r--r--config-daemon.ac4808logplainabout
-rw-r--r--configure.ac9291logplainabout
-rw-r--r--d3.v3.js339545logplainabout
d---------doc406logplain
d---------etc506logplain
-rw-r--r--gnu.scm5345logplainabout
d---------gnu660logplain
-rw-r--r--graph.js4207logplainabout
-rw-r--r--guix.scm1357logplainabout
d---------guix2894logplain
d---------m435logplain
d---------nix282logplain
d---------po96logplain
d---------scripts35logplain
d---------tests3909logplain
generated by cgit
(user-account-comment user)) (directory (user-account-home-directory user)) (shell (user-account-shell user)) (system? (user-account-system? user))) (let*-values (((previous) (previous-entry name)) ((allocation id) (cond ((number? requested-id) (values (reserve-ids allocation (list requested-id)) requested-id)) (previous (values allocation (password-entry-uid previous))) (else (allocate-id allocation #:system? system?))))) (values (cons (password-entry (name name) (uid id) (directory directory) (gid (if (number? group) group (group-id group))) ;; Users might change their name to something ;; other than what the sysadmin chose, with ;; 'chfn'. Thus consider it "stateful". (real-name (if (and previous (not system?)) (password-entry-real-name previous) real-name)) ;; Do not reuse the shell of PREVIOUS since (1) ;; that could lead to confusion, and (2) the ;; shell might have been GC'd. See ;; . (shell shell)) result) allocation)))) '() uids users))) (define* (days-since-epoch #:optional (current-time current-time)) "Return the number of days elapsed since the 1st of January, 1970." (let* ((now (current-time time-utc)) (epoch (make-time time-utc 0 0)) (diff (time-difference now epoch))) (quotient (time-second diff) (* 24 3600)))) (define* (passwd->shadow users passwd #:optional (current-shadow '()) #:key (current-time current-time)) "Return a list of shadow entries for the password entries listed in PASSWD. Reuse shadow entries from CURRENT-SHADOW when they exist, and take the initial password from USERS." (define previous-entry (lookup-procedure current-shadow shadow-entry-name)) (define now (days-since-epoch current-time)) (map (lambda (user passwd) (or (previous-entry (password-entry-name passwd)) (shadow-entry (name (password-entry-name passwd)) (password (user-account-password user)) (last-change now)))) users passwd)) (define (empty-if-not-found thunk) "Call THUNK and return the empty list if that throws to ENOENT." (catch 'system-error thunk (lambda args (if (= ENOENT (system-error-errno args)) '() (apply throw args))))) (define* (user+group-databases users groups #:key (current-passwd (empty-if-not-found read-passwd)) (current-groups (empty-if-not-found read-group)) (current-shadow (empty-if-not-found read-shadow)) (current-time current-time)) "Return three values: the list of group entries, the list of password entries, and the list of shadow entries corresponding to USERS and GROUPS. Preserve stateful bits from CURRENT-PASSWD, CURRENT-GROUPS, and CURRENT-SHADOW: UIDs, GIDs, passwords, user shells, etc." (define members ;; Map group name to user names. (fold (lambda (user members) (fold (cute vhash-cons <> (user-account-name user) <>) members (user-account-supplementary-groups user))) vlist-null users)) (define group-entries (allocate-groups groups members current-groups)) (define passwd-entries (allocate-passwd users group-entries current-passwd)) (define shadow-entries (passwd->shadow users passwd-entries current-shadow #:current-time current-time)) (values group-entries passwd-entries shadow-entries))