summaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
authorLeo Famulari <leo@famulari.name>2017-02-02 10:52:24 -0500
committerLeo Famulari <leo@famulari.name>2017-02-02 10:52:24 -0500
commite8c83d04e176f205b30b3d470f22ee5e1c686331 (patch)
tree30a95626ea31414a6319b93f50eea1e69b87a619 /gnu/build
parentd9b4cbc2a168ca3d248c5abf1f1d14c1808e6a20 (diff)
parentde643f0c15677665acce73db9c28c5488e623633 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/activation.scm19
-rw-r--r--gnu/build/file-systems.scm33
2 files changed, 39 insertions, 13 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 756a6872bb..d36eeafe47 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -25,6 +25,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (activate-users+groups
+ activate-user-home
activate-etc
activate-setuid-programs
activate-/bin/sh
@@ -215,7 +216,7 @@ numeric gid or #f."
#:supplementary-groups supplementary-groups
#:comment comment
#:home home
- #:create-home? create-home?
+ #:create-home? (and create-home? system?)
#:shell shell
#:password password)
@@ -263,6 +264,20 @@ numeric gid or #f."
(((names . _) ...)
names)))))
+(define (activate-user-home users)
+ "Create and populate the home directory of USERS, a list of tuples, unless
+they already exist."
+ (define ensure-user-home
+ (match-lambda
+ ((name uid group supplementary-groups comment home create-home?
+ shell password system?)
+ (unless (or (not home) (directory-exists? home))
+ (mkdir-p home)
+ (unless system?
+ (copy-account-skeletons home))))))
+
+ (for-each ensure-user-home users))
+
(define (activate-etc etc)
"Install ETC, a directory in the store, as the source of static files for
/etc."
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 6e5c6aaf15..f8ab95370c 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
;;;
;;; This file is part of GNU Guix.
@@ -72,22 +72,33 @@
"Bind-mount SOURCE at TARGET."
(mount source target "" MS_BIND))
+(define (seek* fd/port offset whence)
+ "Like 'seek' but return -1 instead of throwing to 'system-error' upon
+EINVAL. This makes it easier to catch cases like OFFSET being too large for
+FD/PORT."
+ (catch 'system-error
+ (lambda ()
+ (seek fd/port offset whence))
+ (lambda args
+ (if (= EINVAL (system-error-errno args))
+ -1
+ (apply throw args)))))
+
(define (read-superblock device offset size magic?)
"Read a superblock of SIZE from OFFSET and DEVICE. Return the raw
superblock on success, and #f if no valid superblock was found. MAGIC?
takes a bytevector and returns #t when it's a valid superblock."
(call-with-input-file device
(lambda (port)
- (seek port offset SEEK_SET)
-
- (let ((block (make-bytevector size)))
- (match (get-bytevector-n! port block 0 (bytevector-length block))
- ((? eof-object?)
- #f)
- ((? number? len)
- (and (= len (bytevector-length block))
- (and (magic? block)
- block))))))))
+ (and (= offset (seek* port offset SEEK_SET))
+ (let ((block (make-bytevector size)))
+ (match (get-bytevector-n! port block 0 (bytevector-length block))
+ ((? eof-object?)
+ #f)
+ ((? number? len)
+ (and (= len (bytevector-length block))
+ (and (magic? block)
+ block)))))))))
(define (sub-bytevector bv start size)
"Return a copy of the SIZE bytes of BV starting from offset START."