gnu/system/file-systems.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016 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 file-systems)
  20   #:use-module (ice-9 match)
  21   #:use-module (guix records)
  22   #:use-module (guix store)
  23   #:use-module ((gnu build file-systems)
  24                 #:select (string->uuid uuid->string))
  25   #:re-export (string->uuid
  26                uuid->string)
  27   #:export (<file-system>
  28             file-system
  29             file-system?
  30             file-system-device
  31             file-system-title
  32             file-system-mount-point
  33             file-system-type
  34             file-system-needed-for-boot?
  35             file-system-flags
  36             file-system-options
  37             file-system-mount?
  38             file-system-check?
  39             file-system-create-mount-point?
  40             file-system-dependencies
  41
  42             file-system->spec
  43             specification->file-system-mapping
  44             uuid
  45
  46             %fuse-control-file-system
  47             %binary-format-file-system
  48             %shared-memory-file-system
  49             %pseudo-terminal-file-system
  50             %immutable-store
  51             %control-groups
  52             %elogind-file-systems
  53
  54             %base-file-systems
  55             %container-file-systems
  56
  57             <file-system-mapping>
  58             file-system-mapping
  59             file-system-mapping?
  60             file-system-mapping-source
  61             file-system-mapping-target
  62             file-system-mapping-writable?
  63
  64             %store-mapping))
  65
  66 ;;; Commentary:
  67 ;;;
  68 ;;; Declaring file systems to be mounted.
  69 ;;;
  70 ;;; Code:
  71
  72 ;; File system declaration.
  73 (define-record-type* <file-system> file-system
  74   make-file-system
  75   file-system?
  76   (device           file-system-device)           ; string
  77   (title            file-system-title             ; 'device | 'label | 'uuid
  78                     (default 'device))
  79   (mount-point      file-system-mount-point)      ; string
  80   (type             file-system-type)             ; string
  81   (flags            file-system-flags             ; list of symbols
  82                     (default '()))
  83   (options          file-system-options           ; string or #f
  84                     (default #f))
  85   (mount?           file-system-mount?            ; Boolean
  86                     (default #t))
  87   (needed-for-boot? %file-system-needed-for-boot? ; Boolean
  88                     (default #f))
  89   (check?           file-system-check?            ; Boolean
  90                     (default #t))
  91   (create-mount-point? file-system-create-mount-point? ; Boolean
  92                        (default #f))
  93   (dependencies     file-system-dependencies      ; list of <file-system>
  94                     (default '())))               ; or <mapped-device>
  95
  96 (define-inlinable (file-system-needed-for-boot? fs)
  97   "Return true if FS has the 'needed-for-boot?' flag set, or if it's the root
  98 file system."
  99   (or (%file-system-needed-for-boot? fs)
 100       (string=? "/" (file-system-mount-point fs))))
 101
 102 (define (file-system->spec fs)
 103   "Return a list corresponding to file-system FS that can be passed to the
 104 initrd code."
 105   (match fs
 106     (($ <file-system> device title mount-point type flags options _ _ check?)
 107      (list device title mount-point type flags options check?))))
 108
 109 (define (specification->file-system-mapping spec writable?)
 110   "Read the SPEC and return the corresponding <file-system-mapping>.  SPEC is
 111 a string of the form \"SOURCE\" or \"SOURCE=TARGET\".  The former specifies
 112 that SOURCE from the host should be mounted at SOURCE in the other system.
 113 The latter format specifies that SOURCE from the host should be mounted at
 114 TARGET in the other system."
 115   (let ((index (string-index spec #\=)))
 116     (if index
 117         (file-system-mapping
 118          (source (substring spec 0 index))
 119          (target (substring spec (+ 1 index)))
 120          (writable? writable?))
 121         (file-system-mapping
 122          (source spec)
 123          (target spec)
 124          (writable? writable?)))))
 125
 126 (define-syntax uuid
 127   (lambda (s)
 128     "Return the bytevector corresponding to the given UUID representation."
 129     (syntax-case s ()
 130       ((_ str)
 131        (string? (syntax->datum #'str))
 132        ;; A literal string: do the conversion at expansion time.
 133        (let ((bv (string->uuid (syntax->datum #'str))))
 134          (unless bv
 135            (syntax-violation 'uuid "invalid UUID" s))
 136          (datum->syntax #'str bv)))
 137       ((_ str)
 138        #'(string->uuid str)))))
 139
 140 \f
 141 ;;;
 142 ;;; Common file systems.
 143 ;;;
 144
 145 (define %fuse-control-file-system
 146   ;; Control file system for Linux' file systems in user-space (FUSE).
 147   (file-system
 148     (device "fusectl")
 149     (mount-point "/sys/fs/fuse/connections")
 150     (type "fusectl")
 151     (check? #f)))
 152
 153 (define %binary-format-file-system
 154   ;; Support for arbitrary executable binary format.
 155   (file-system
 156     (device "binfmt_misc")
 157     (mount-point "/proc/sys/fs/binfmt_misc")
 158     (type "binfmt_misc")
 159     (check? #f)))
 160
 161 (define %tty-gid
 162   ;; ID of the 'tty' group.  Allocate it statically to make it easy to refer
 163   ;; to it from here and from the 'tty' group definitions.
 164   996)
 165
 166 (define %pseudo-terminal-file-system
 167   ;; The pseudo-terminal file system.  It needs to be mounted so that
 168   ;; statfs(2) returns DEVPTS_SUPER_MAGIC like libc's getpt(3) expects (and
 169   ;; thus openpty(3) and its users, such as xterm.)
 170   (file-system
 171     (device "none")
 172     (mount-point "/dev/pts")
 173     (type "devpts")
 174     (check? #f)
 175     (needed-for-boot? #f)
 176     (create-mount-point? #t)
 177     (options (string-append "gid=" (number->string %tty-gid) ",mode=620"))))
 178
 179 (define %shared-memory-file-system
 180   ;; Shared memory.
 181   (file-system
 182     (device "tmpfs")
 183     (mount-point "/dev/shm")
 184     (type "tmpfs")
 185     (check? #f)
 186     (flags '(no-suid no-dev))
 187     (options "size=50%")                         ;TODO: make size configurable
 188     (create-mount-point? #t)))
 189
 190 (define %immutable-store
 191   ;; Read-only store to avoid users or daemons accidentally modifying it.
 192   ;; 'guix-daemon' has provisions to remount it read-write in its own name
 193   ;; space.
 194   (file-system
 195     (device (%store-prefix))
 196     (mount-point (%store-prefix))
 197     (type "none")
 198     (check? #f)
 199     (flags '(read-only bind-mount))))
 200
 201 (define %control-groups
 202   (let ((parent (file-system
 203                   (device "cgroup")
 204                   (mount-point "/sys/fs/cgroup")
 205                   (type "tmpfs")
 206                   (check? #f))))
 207     (cons parent
 208           (map (lambda (subsystem)
 209                  (file-system
 210                    (device "cgroup")
 211                    (mount-point (string-append "/sys/fs/cgroup/" subsystem))
 212                    (type "cgroup")
 213                    (check? #f)
 214                    (options subsystem)
 215                    (create-mount-point? #t)
 216
 217                    ;; This must be mounted after, and unmounted before the
 218                    ;; parent directory.
 219                    (dependencies (list parent))))
 220                '("cpuset" "cpu" "cpuacct" "memory" "devices" "freezer"
 221                  "blkio" "perf_event" "hugetlb")))))
 222
 223 (define %elogind-file-systems
 224   ;; We don't use systemd, but these file systems are needed for elogind,
 225   ;; which was extracted from systemd.
 226   (list (file-system
 227           (device "none")
 228           (mount-point "/run/systemd")
 229           (type "tmpfs")
 230           (check? #f)
 231           (flags '(no-suid no-dev no-exec))
 232           (options "mode=0755")
 233           (create-mount-point? #t))
 234         (file-system
 235           (device "none")
 236           (mount-point "/run/user")
 237           (type "tmpfs")
 238           (check? #f)
 239           (flags '(no-suid no-dev no-exec))
 240           (options "mode=0755")
 241           (create-mount-point? #t))
 242         ;; Elogind uses cgroups to organize processes, allowing it to map PIDs
 243         ;; to sessions.  Elogind's cgroup hierarchy isn't associated with any
 244         ;; resource controller ("subsystem").
 245         (file-system
 246           (device "cgroup")
 247           (mount-point "/sys/fs/cgroup/elogind")
 248           (type "cgroup")
 249           (check? #f)
 250           (options "none,name=elogind")
 251           (create-mount-point? #t)
 252           (dependencies (list (car %control-groups))))))
 253
 254 (define %base-file-systems
 255   ;; List of basic file systems to be mounted.  Note that /proc and /sys are
 256   ;; currently mounted by the initrd.
 257   (append (list %pseudo-terminal-file-system
 258                 %shared-memory-file-system
 259                 %immutable-store)
 260           %elogind-file-systems
 261           %control-groups))
 262
 263 ;; File systems for Linux containers differ from %base-file-systems in that
 264 ;; they impose additional restrictions such as no-exec or need different
 265 ;; options to function properly.
 266 ;;
 267 ;; The file system flags and options conform to the libcontainer
 268 ;; specification:
 269 ;; https://github.com/docker/libcontainer/blob/master/SPEC.md#filesystem
 270 (define %container-file-systems
 271   (list
 272    ;; Pseudo-terminal file system.
 273    (file-system
 274      (device "none")
 275      (mount-point "/dev/pts")
 276      (type "devpts")
 277      (flags '(no-exec no-suid))
 278      (needed-for-boot? #t)
 279      (create-mount-point? #t)
 280      (check? #f)
 281      (options "newinstance,ptmxmode=0666,mode=620"))
 282    ;; Shared memory file system.
 283    (file-system
 284      (device "tmpfs")
 285      (mount-point "/dev/shm")
 286      (type "tmpfs")
 287      (flags '(no-exec no-suid no-dev))
 288      (options "mode=1777,size=65536k")
 289      (needed-for-boot? #t)
 290      (create-mount-point? #t)
 291      (check? #f))
 292    ;; Message queue file system.
 293    (file-system
 294      (device "mqueue")
 295      (mount-point "/dev/mqueue")
 296      (type "mqueue")
 297      (flags '(no-exec no-suid no-dev))
 298      (needed-for-boot? #t)
 299      (create-mount-point? #t)
 300      (check? #f))))
 301
 302 \f
 303 ;;;
 304 ;;; Shared file systems, for VMs/containers.
 305 ;;;
 306
 307 ;; Mapping of host file system SOURCE to mount point TARGET in the guest.
 308 (define-record-type* <file-system-mapping> file-system-mapping
 309   make-file-system-mapping
 310   file-system-mapping?
 311   (source    file-system-mapping-source)          ;string
 312   (target    file-system-mapping-target)          ;string
 313   (writable? file-system-mapping-writable?        ;Boolean
 314              (default #f)))
 315
 316 (define %store-mapping
 317   ;; Mapping of the host's store into the guest.
 318   (file-system-mapping
 319    (source (%store-prefix))
 320    (target (%store-prefix))
 321    (writable? #f)))
 322
 323 ;;; file-systems.scm ends here