From f34c56be3a53c10d9a267331a0a6119c79c815a0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 11 Nov 2014 22:42:15 +0100
Subject: [PATCH] activation: Set the firmware search path.

* gnu/build/activation.scm (activate-firmware): New procedure.
* gnu/system.scm (<operating-system>)[firmware]: New field.
  (directory-union): New procedure.
  (%base-firmware): New variable.
  (operating-system-activation-script): Use 'directory-union', and call
  'activate-firmware'.
* doc/guix.texi (operating-system Reference): Document 'firmware'.
---
 doc/guix.texi            |  7 +++++++
 gnu/build/activation.scm | 10 ++++++++++
 gnu/system.scm           | 28 ++++++++++++++++++++++++++++
 3 files changed, 45 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index c7f72d76d1..c0bad3c7fa 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3385,6 +3385,13 @@ The system bootloader configuration object.  @xref{GRUB Configuration}.
 A two-argument monadic procedure that returns an initial RAM disk for
 the Linux kernel.  @xref{Initial RAM Disk}.
 
+@item @code{firmware} (default: @var{%base-firmware})
+@cindex firmware
+List of firmware packages loadable by the operating system kernel.
+
+The default includes firmware needed for Atheros-based WiFi devices
+(Linux-libre module @code{ath9k}.)
+
 @item @code{host-name}
 The host name.
 
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 142ed8f693..3eebb71dfc 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -28,6 +28,7 @@
             activate-setuid-programs
             activate-/bin/sh
             activate-modprobe
+            activate-firmware
             activate-current-system))
 
 ;;; Commentary:
@@ -259,6 +260,15 @@ copy SOURCE to TARGET."
     (lambda (port)
       (display modprobe port))))
 
+(define (activate-firmware directory)
+  "Tell the kernel to look for device firmware under DIRECTORY.  This
+mechanism bypasses udev: it allows Linux to handle firmware loading directly
+by itself, without having to resort to a \"user helper\"."
+  (call-with-output-file "/sys/module/firmware_class/parameters/path"
+    (lambda (port)
+      (display directory port))))
+
+
 (define %current-system
   ;; The system that is current (a symlink.)  This is not necessarily the same
   ;; as the system we booted (aka. /run/booted-system) because we can re-build
diff --git a/gnu/system.scm b/gnu/system.scm
index 57d71e5158..2ac803986f 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -39,6 +39,7 @@
   #:use-module (gnu packages lsof)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages firmware)
   #:autoload   (gnu packages cryptsetup) (cryptsetup)
   #:use-module (gnu services)
   #:use-module (gnu services dmd)
@@ -79,6 +80,7 @@
             local-host-aliases
             %setuid-programs
             %base-packages
+            %base-firmware
 
             luks-device-mapping))
 
@@ -99,6 +101,8 @@
 
   (initrd operating-system-initrd                 ; (list fs) -> M derivation
           (default base-initrd))
+  (firmware operating-system-firmware             ; list of packages
+            (default %base-firmware))
 
   (host-name operating-system-host-name)          ; string
   (hosts-file operating-system-hosts-file         ; M item | #f
@@ -159,6 +163,20 @@ file."
 
   (gexp->derivation name builder))
 
+(define (directory-union name things)
+  "Return a directory that is the union of THINGS."
+  (match things
+    ((one)
+     ;; Only one thing; return it.
+     (with-monad %store-monad (return one)))
+    (_
+     (gexp->derivation name
+                       #~(begin
+                           (use-modules (guix build union))
+                           (union-build #$output '#$things))
+                       #:modules '((guix build union))
+                       #:local-build? #t))))
+
 
 ;;;
 ;;; Services.
@@ -298,6 +316,10 @@ explicitly appear in OS."
 ;;; /etc.
 ;;;
 
+(define %base-firmware
+  ;; Firmware usable by default.
+  (list ath9k-htc-firmware))
+
 (define %base-packages
   ;; Default set of packages globally visible.  It should include anything
   ;; required for basic administrator tasks.
@@ -518,6 +540,8 @@ etc."
                        (modules  (imported-modules %modules))
                        (compiled (compiled-modules %modules))
                        (modprobe (modprobe-wrapper))
+                       (firmware (directory-union
+                                  "firmware" (operating-system-firmware os)))
                        (accounts (operating-system-accounts os)))
     (define setuid-progs
       (operating-system-setuid-programs os))
@@ -563,6 +587,10 @@ etc."
                     ;; Tell the kernel to use our 'modprobe' command.
                     (activate-modprobe #$modprobe)
 
+                    ;; Tell the kernel where firmware is.
+                    (activate-firmware
+                     (string-append #$firmware "/lib/firmware"))
+
                     ;; Run the services' activation snippets.
                     ;; TODO: Use 'load-compiled'.
                     (for-each primitive-load '#$actions)