summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorAlex Griffin <a@ajgrf.com>2022-09-10 10:03:10 +0200
committerMathieu Othacehe <othacehe@gnu.org>2022-09-24 14:49:09 +0200
commitc8112f3bd95269ce4aca12dedbfe61bb6b37acae (patch)
tree04fb56e2d174d33c4d53212bb0509fcf5689c9a1 /gnu/system
parent233cf9f0367e78562f07ac9885ed2cc6defe17e1 (diff)
system: images: Add wsl2 module.
* gnu/system/images/wsl2.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi ("System Images"): Document it. Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/images/wsl2.scm170
1 files changed, 170 insertions, 0 deletions
diff --git a/gnu/system/images/wsl2.scm b/gnu/system/images/wsl2.scm
new file mode 100644
index 0000000000..15cb4f69b8
--- /dev/null
+++ b/gnu/system/images/wsl2.scm
@@ -0,0 +1,170 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
+;;; Copyright © 2022 Mathieu Othacehe <othacehe@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 images wsl2)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
+ #:use-module (gnu packages base)
+ #:use-module (gnu packages bash)
+ #:use-module (gnu packages guile)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu services)
+ #:use-module (gnu services base)
+ #:use-module (gnu system)
+ #:use-module (gnu system image)
+ #:use-module (gnu system shadow)
+ #:use-module (guix build-system trivial)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:export (wsl-boot-program
+ wsl-os
+ wsl2-image))
+
+(define (wsl-boot-program user)
+ "Program that runs the system boot script, then starts a login shell as
+USER."
+ (program-file
+ "wsl-boot-program"
+ (with-imported-modules '((guix build syscalls))
+ #~(begin
+ (use-modules (guix build syscalls))
+ (unless (file-exists? "/run/current-system")
+ (let ((shepherd-socket "/var/run/shepherd/socket"))
+ ;; Clean up this file so we can wait for it later.
+ (when (file-exists? shepherd-socket)
+ (delete-file shepherd-socket))
+
+ ;; Child process boots the system and is replaced by shepherd.
+ (when (zero? (primitive-fork))
+ (let* ((system-generation
+ (readlink "/var/guix/profiles/system"))
+ (system (readlink
+ (string-append
+ (if (absolute-file-name? system-generation)
+ ""
+ "/var/guix/profiles/")
+ system-generation))))
+ (setenv "GUIX_NEW_SYSTEM" system)
+ (execl #$(file-append guile-3.0 "/bin/guile")
+ "guile"
+ "--no-auto-compile"
+ (string-append system "/boot"))))
+
+ ;; Parent process waits for shepherd before continuing.
+ (while (not (file-exists? shepherd-socket))
+ (sleep 1))))
+
+ (let* ((pw (getpw #$user))
+ (shell (passwd:shell pw))
+ (sudo #+(file-append sudo "/bin/sudo"))
+ (args (cdr (command-line))))
+ ;; Save the value of $PATH set by WSL. Useful for finding
+ ;; Windows binaries to run with WSL's binfmt interop.
+ (setenv "WSLPATH" (getenv "PATH"))
+
+ ;; /run is mounted with the nosuid flag by WSL. This prevents
+ ;; running the /run/setuid-programs. Remount it without this flag
+ ;; as a workaround. See:
+ ;; https://github.com/microsoft/WSL/issues/8716.
+ (mount #f "/run" #f
+ MS_REMOUNT
+ #:update-mtab? #f)
+
+ ;; Start login shell as user.
+ (apply execl sudo "sudo"
+ "--preserve-env=WSLPATH"
+ "-u" #$user
+ "--"
+ shell "-l" args))))))
+
+(define dummy-package
+ (package
+ (name "dummy")
+ (version "0")
+ (source #f)
+ (build-system trivial-build-system)
+ (arguments
+ `(#:modules ((guix build utils))
+ #:target #f
+ #:builder (begin
+ (use-modules (guix build utils))
+ (let* ((out (assoc-ref %outputs "out"))
+ (dummy (string-append out "/dummy")))
+ (mkdir-p out)
+ (call-with-output-file dummy
+ (const #t))))))
+ (home-page #f)
+ (synopsis #f)
+ (description #f)
+ (license #f)))
+
+(define dummy-bootloader
+ (bootloader
+ (name 'dummy-bootloader)
+ (package dummy-package)
+ (configuration-file "/dev/null")
+ (configuration-file-generator
+ (lambda (. _rest)
+ (plain-file "dummy-bootloader" "")))
+ (installer #~(const #t))))
+
+(define dummy-kernel dummy-package)
+
+(define (dummy-initrd . _rest)
+ (plain-file "dummy-initrd" ""))
+
+(define-public wsl-os
+ (operating-system
+ (host-name "gnu")
+ (timezone "Etc/UTC")
+ (bootloader
+ (bootloader-configuration
+ (bootloader dummy-bootloader)))
+ (kernel dummy-kernel)
+ (initrd dummy-initrd)
+ (initrd-modules '())
+ (firmware '())
+ (file-systems '())
+ (users (cons* (user-account
+ (name "guest")
+ (group "users")
+ (supplementary-groups '("wheel")) ; allow use of sudo
+ (password "")
+ (comment "Guest of GNU"))
+ (user-account
+ (inherit %root-account)
+ (shell (wsl-boot-program "guest")))
+ %base-user-accounts))
+ (services
+ (list
+ (service guix-service-type)
+ (service special-files-service-type
+ `(("/bin/sh" ,(file-append bash "/bin/bash"))
+ ("/bin/mount" ,(file-append util-linux "/bin/mount"))
+ ("/usr/bin/env" ,(file-append coreutils "/bin/env"))))))))
+
+(define wsl2-image
+ (image
+ (inherit
+ (os->image wsl-os
+ #:type wsl2-image-type))
+ (name 'wsl2-image)))
+
+wsl2-image