ssmithxandClaude Opus 5.5
cf228218ac
On a fresh image 99-tollgate-setup ran at activation, before wifi-setup had created /etc/config/wireless, so the open TollGate SSID never appeared (the Pi release image came up with `guix-router`). uci-service- type gains late-defaults, run by wifi-setup after `wifi config` and the first config, then one reboot if any ran. TollGate's setup and the MT6000's 99_zz-wired-private move there. Tested on the Pi (fresh WiFi state: TollGate-C69B after one automatic reboot); MT6000 generation 7 (scripts already done there: no reboot). PITFALLS #57. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
1409 lines
62 KiB
Scheme
1409 lines
62 KiB
Scheme
;;; Shepherd services for the OpenWrt userland (Phase 4).
|
|
;;;
|
|
;;; Design decisions (README "OpenWrt on Guix"):
|
|
;;; - Shepherd, not procd, supervises everything; a procd compatibility
|
|
;;; layer comes later, as far as netifd/firewall4/rpcd need one.
|
|
;;; - /etc/config is seeded once by Guix, then owned by UCI (and LuCI):
|
|
;;; a seed file is only copied when /etc/config/NAME doesn't exist, so
|
|
;;; `uci set' changes survive deploys. uci-defaults scripts run once,
|
|
;;; as OpenWrt runs /etc/uci-defaults on first boot.
|
|
(define-module (openwrt-services)
|
|
#:use-module (gnu services)
|
|
#:use-module (gnu services shepherd)
|
|
#:use-module (guix gexp)
|
|
#:use-module (guix records)
|
|
#:use-module ((guix config) #:select (%guix-version))
|
|
#:use-module (ice-9 match)
|
|
#:use-module (json)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-26)
|
|
#:use-module (openwrt)
|
|
#:use-module (gnu packages bash)
|
|
#:use-module (gnu packages busybox)
|
|
#:use-module ((gnu packages linux) #:select (nftables))
|
|
#:use-module ((gnu packages tls) #:select (openssl))
|
|
#:use-module ((gnu packages dns) #:select (dnsmasq))
|
|
#:use-module ((gnu packages admin) #:select (shadow))
|
|
#:use-module ((gnu packages base) #:select (coreutils))
|
|
#:use-module (gnu system shadow)
|
|
#:export (ubus-configuration
|
|
ubus-configuration?
|
|
ubus-service-type
|
|
|
|
procd-compat-configuration
|
|
procd-compat-configuration?
|
|
procd-compat-service-type
|
|
|
|
sysfixtime-configuration
|
|
sysfixtime-configuration?
|
|
sysfixtime-service-type
|
|
|
|
openwrt-init.d-service-type
|
|
|
|
openwrt-init-script
|
|
openwrt-init-script?
|
|
openwrt-init-script-service-type
|
|
|
|
uci-configuration
|
|
uci-configuration?
|
|
uci-extension
|
|
uci-extension?
|
|
uci-service-type
|
|
|
|
%hotplug-call
|
|
netifd-configuration
|
|
netifd-configuration?
|
|
netifd-service-type
|
|
|
|
odhcpd-configuration
|
|
odhcpd-configuration?
|
|
odhcpd-service-type
|
|
|
|
firewall-configuration
|
|
firewall-configuration?
|
|
firewall-service-type
|
|
|
|
openwrt-dnsmasq-configuration
|
|
openwrt-dnsmasq-configuration?
|
|
openwrt-dnsmasq-service-type
|
|
|
|
nodogsplash-configuration
|
|
nodogsplash-configuration?
|
|
nodogsplash-service-type
|
|
|
|
openwrt-wireless-configuration
|
|
openwrt-wireless-configuration?
|
|
openwrt-wireless-service-type
|
|
|
|
rpcd-configuration
|
|
rpcd-configuration?
|
|
rpcd-service-type
|
|
|
|
uhttpd-configuration
|
|
uhttpd-configuration?
|
|
uhttpd-service-type
|
|
|
|
luci-configuration
|
|
luci-configuration?
|
|
luci-service-type))
|
|
|
|
|
|
;;;
|
|
;;; ubus.
|
|
;;;
|
|
|
|
(define-record-type* <ubus-configuration>
|
|
ubus-configuration make-ubus-configuration
|
|
ubus-configuration?
|
|
(ubus ubus-configuration-ubus (default ubus)))
|
|
|
|
(define (ubus-shepherd-service config)
|
|
(match-record config <ubus-configuration> (ubus)
|
|
(list (shepherd-service
|
|
(documentation "Run ubusd, the OpenWrt message bus.")
|
|
(provision '(ubus))
|
|
(requirement '(user-processes))
|
|
(start
|
|
#~(lambda args
|
|
;; The socket, /var/run/ubus/ubus.sock, is compiled in and
|
|
;; ubusd doesn't create its directory.
|
|
(mkdir-p "/var/run/ubus")
|
|
(apply (make-forkexec-constructor
|
|
(list #$(file-append ubus "/sbin/ubusd")))
|
|
args)))
|
|
(stop #~(make-kill-destructor))))))
|
|
|
|
(define ubus-service-type
|
|
(service-type
|
|
(name 'ubus)
|
|
(extensions
|
|
(list (service-extension shepherd-root-service-type ubus-shepherd-service)
|
|
(service-extension profile-service-type
|
|
(lambda (config)
|
|
;; libubox for jshn and jshn.sh.
|
|
(list (ubus-configuration-ubus config)
|
|
libubox)))))
|
|
(default-value (ubus-configuration))
|
|
(description "Run @command{ubusd}, the OpenWrt RPC and event bus.")))
|
|
|
|
|
|
;;;
|
|
;;; sysfixtime.
|
|
;;;
|
|
|
|
;; Routers without an RTC boot at 1970 until NTP answers -- if it ever
|
|
;; does: dnsmasq leases, logs and certificate checks get nonsense times.
|
|
;; OpenWrt's sysfixtime sets the clock forward to the newest file in /etc;
|
|
;; here, at activation (early boot, before Shepherd starts services), to the
|
|
;; newest mtime among FILES (a directory counts for its entries), and a
|
|
;; stamp file is touched when the system shuts down.
|
|
(define-record-type* <sysfixtime-configuration>
|
|
sysfixtime-configuration make-sysfixtime-configuration
|
|
sysfixtime-configuration?
|
|
(stamp sysfixtime-configuration-stamp (default "/var/lib/sysfixtime"))
|
|
(files sysfixtime-configuration-files
|
|
(default '("/var/log/messages" "/etc/config"))))
|
|
|
|
(define (sysfixtime-activation config)
|
|
(match-record config <sysfixtime-configuration> (stamp files)
|
|
#~(begin
|
|
(use-modules (ice-9 ftw))
|
|
(let* ((mtime (lambda (file)
|
|
(let ((st (false-if-exception (stat file))))
|
|
(cond ((not st) 0)
|
|
((eq? 'directory (stat:type st))
|
|
(apply max 0
|
|
(map (lambda (f)
|
|
(let ((st (false-if-exception
|
|
(stat (string-append
|
|
file "/" f)))))
|
|
(if st (stat:mtime st) 0)))
|
|
(or (scandir file) '()))))
|
|
(else (stat:mtime st))))))
|
|
(newest (apply max (map mtime (cons #$stamp '#$files)))))
|
|
;; Boot-time activation output only reaches the console: keep a
|
|
;; record.
|
|
(call-with-output-file "/var/log/sysfixtime.log"
|
|
(lambda (port)
|
|
(format port "now ~a newest ~a~%" (current-time) newest)
|
|
(when (< (current-time) newest)
|
|
;; Guile here has no settimeofday.
|
|
(let ((status (system* #$(file-append coreutils "/bin/date")
|
|
"-u" "-s"
|
|
(string-append "@" (number->string
|
|
newest)))))
|
|
(format port "date -s @~a: ~a~%" newest status)))))))))
|
|
|
|
(define (sysfixtime-shepherd-service config)
|
|
(let ((stamp (sysfixtime-configuration-stamp config)))
|
|
(list (shepherd-service
|
|
(documentation "Record the time at shutdown for sysfixtime.")
|
|
(provision '(sysfixtime))
|
|
(requirement '(file-systems))
|
|
(start #~(const #t))
|
|
(stop #~(lambda _
|
|
(false-if-exception
|
|
(begin
|
|
(mkdir-p (dirname #$stamp))
|
|
(call-with-output-file #$stamp
|
|
(lambda (port)
|
|
(display (current-time) port)))))
|
|
#f))))))
|
|
|
|
(define sysfixtime-service-type
|
|
(service-type
|
|
(name 'sysfixtime)
|
|
(extensions
|
|
(list (service-extension activation-service-type sysfixtime-activation)
|
|
(service-extension shepherd-root-service-type
|
|
sysfixtime-shepherd-service)))
|
|
(default-value (sysfixtime-configuration))
|
|
(description "Set the clock at boot to the newest of some file times, for
|
|
machines without a real-time clock.")))
|
|
|
|
|
|
;;;
|
|
;;; /etc/init.d shims.
|
|
;;;
|
|
|
|
;; OpenWrt scripts and LuCI drive services through /etc/init.d/NAME ACTION
|
|
;; (TollGate's postinst: `/etc/init.d/firewall reload', ...; LuCI's Startup
|
|
;; page: rpcd's `rc' object, which reads START= and USE_PROCD= from the
|
|
;; script and treats /etc/rc.d/SNNNAME as "enabled"). Services extend
|
|
;; openwrt-init.d-service-type with (NAME SHEPHERD-SERVICE START): NAME is
|
|
;; OpenWrt's (network), SHEPHERD-SERVICE ours (netifd). enable/disable are
|
|
;; Shepherd's, until the next boot: which services exist is the operating
|
|
;; system declaration's business. Never run these from a Shepherd action
|
|
;; (PITFALLS #43).
|
|
(define (executable-text-file name text)
|
|
(computed-file name
|
|
#~(begin
|
|
(call-with-output-file #$output
|
|
(lambda (port) (display #$text port)))
|
|
(chmod #$output #o555))))
|
|
|
|
(define (init.d-script name service start)
|
|
(executable-text-file name (string-append "#!/bin/sh
|
|
# /etc/init.d/" name ": Shepherd service '" (symbol->string service) "'
|
|
# (openwrt-init.d-service-type).
|
|
START=" (number->string start) "
|
|
USE_PROCD=1
|
|
herd=/run/current-system/profile/bin/herd
|
|
service=" (symbol->string service) "
|
|
case \"$1\" in
|
|
# OpenWrt's disable only affects boot; Shepherd's would also refuse a
|
|
# start (and Shepherd disables services that hit their respawn limit).
|
|
start|boot) $herd enable $service >/dev/null 2>&1
|
|
exec $herd start $service ;;
|
|
stop) exec $herd stop $service ;;
|
|
restart) $herd enable $service >/dev/null 2>&1
|
|
exec $herd restart $service ;;
|
|
reload)
|
|
# Not every service has a reload action; restart those.
|
|
$herd reload $service 2>/dev/null || exec $herd restart $service ;;
|
|
enable) exec $herd enable $service ;;
|
|
disable) exec $herd disable $service ;;
|
|
enabled) $herd status $service 2>/dev/null | grep -q 'It is enabled' ;;
|
|
running) $herd status $service 2>/dev/null | grep -q 'It is running' ;;
|
|
status)
|
|
if $herd status $service 2>/dev/null | grep -q 'It is running'; then
|
|
echo running
|
|
else
|
|
echo inactive; exit 3
|
|
fi ;;
|
|
*)
|
|
echo \"Syntax: $0 [start|stop|restart|reload|enable|disable|enabled|running|status]\" >&2
|
|
exit 1 ;;
|
|
esac
|
|
")))
|
|
|
|
(define (init.d-etc-files entries)
|
|
(append-map (match-lambda
|
|
((name service start)
|
|
(let ((script (init.d-script name service start)))
|
|
`((,(string-append "init.d/" name) ,script)
|
|
(,(format #f "rc.d/S~2,'0d~a" start name) ,script)))))
|
|
entries))
|
|
|
|
(define openwrt-init.d-service-type
|
|
(service-type
|
|
(name 'openwrt-init.d)
|
|
(extensions
|
|
(list (service-extension etc-service-type init.d-etc-files)))
|
|
(compose concatenate)
|
|
(extend append)
|
|
(default-value '())
|
|
(description "Provide OpenWrt-style @file{/etc/init.d} scripts for
|
|
Shepherd services.")))
|
|
|
|
|
|
;;;
|
|
;;; OpenWrt procd init scripts under Shepherd.
|
|
;;;
|
|
|
|
;; An OpenWrt init script (USE_PROCD=1) run as a Shepherd service by
|
|
;; procd-compat's openwrt-rc: start_service with procd stubbed, then its
|
|
;; first instance's command. `herd reload' re-runs it and restarts the
|
|
;; process if the instance changed. The script must use store paths (patch
|
|
;; /usr/sbin/... when packaging it); it may run what the profile has by name.
|
|
(define-record-type* <openwrt-init-script>
|
|
openwrt-init-script make-openwrt-init-script
|
|
openwrt-init-script?
|
|
(name openwrt-init-script-name) ;/etc/init.d/NAME
|
|
(script openwrt-init-script-script) ;file-like
|
|
(provision openwrt-init-script-provision ;symbol; default NAME
|
|
(default #f))
|
|
(requirement openwrt-init-script-requirement
|
|
(default '(ubus user-processes)))
|
|
(start-priority openwrt-init-script-start-priority (default 50))
|
|
;; "VAR=value" strings or gexps, for the script and its process.
|
|
(environment openwrt-init-script-environment (default '()))
|
|
(procd-compat openwrt-init-script-procd-compat (default procd-compat)))
|
|
|
|
(define (openwrt-init-script-symbol script)
|
|
(or (openwrt-init-script-provision script)
|
|
(string->symbol (openwrt-init-script-name script))))
|
|
|
|
(define (openwrt-init-script-shepherd-service init)
|
|
;; Not `name': inside (shepherd-action (name ...) ...), later fields see
|
|
;; the action's own `name' field.
|
|
(let ((rc-name (openwrt-init-script-name init))
|
|
(script (openwrt-init-script-script init))
|
|
(runner (file-append (openwrt-init-script-procd-compat init)
|
|
"/sbin/openwrt-rc"))
|
|
(environment #~(append (list #$@(openwrt-init-script-environment
|
|
init))
|
|
(default-environment-variables))))
|
|
;; Shepherd only forks openwrt-rc, never waits for it (PITFALLS #43).
|
|
(shepherd-service
|
|
(documentation (string-append "Run OpenWrt's /etc/init.d/" rc-name "."))
|
|
(provision (list (openwrt-init-script-symbol init)))
|
|
(requirement (openwrt-init-script-requirement init))
|
|
(start #~(make-forkexec-constructor
|
|
(list #$runner #$rc-name #$script "exec")
|
|
#:environment-variables #$environment))
|
|
(stop #~(make-kill-destructor))
|
|
(actions
|
|
(list (shepherd-action
|
|
(name 'reload)
|
|
(documentation
|
|
"Re-run the init script; restart if its instance changed.")
|
|
(procedure
|
|
#~(lambda (running . _)
|
|
(let ((pid (and running
|
|
(if (integer? running)
|
|
running
|
|
(process-id running)))))
|
|
(and pid
|
|
(begin
|
|
(fork+exec-command
|
|
(list #$runner #$rc-name #$script "reload"
|
|
(number->string pid))
|
|
#:environment-variables #$environment)
|
|
#t)))))))))))
|
|
|
|
(define openwrt-init-script-service-type
|
|
(service-type
|
|
(name 'openwrt-init-script)
|
|
(extensions
|
|
(list (service-extension shepherd-root-service-type
|
|
(cut map openwrt-init-script-shepherd-service <>))
|
|
(service-extension openwrt-init.d-service-type
|
|
(cut map (lambda (script)
|
|
(list (openwrt-init-script-name script)
|
|
(openwrt-init-script-symbol script)
|
|
(openwrt-init-script-start-priority
|
|
script)))
|
|
<>))))
|
|
(compose concatenate)
|
|
(extend append)
|
|
(default-value '())
|
|
(description "Run OpenWrt procd init scripts as Shepherd services.")))
|
|
|
|
|
|
;;;
|
|
;;; procd compatibility.
|
|
;;;
|
|
|
|
;; Reload triggers: on OpenWrt an init script declares which UCI configs
|
|
;; reload its service (procd_add_reload_trigger); `uci commit' + reload_config,
|
|
;; or rpcd (LuCI's Save & Apply), send config.change and procd reloads it.
|
|
;; Here services extend procd-compat-service-type with (CONFIG SERVICE)
|
|
;; pairs, e.g. ("firewall" firewall), and procd-compat runs `herd reload
|
|
;; SERVICE' -- so each SERVICE needs a `reload' action.
|
|
(define-record-type* <procd-compat-configuration>
|
|
procd-compat-configuration make-procd-compat-configuration
|
|
procd-compat-configuration?
|
|
(procd-compat procd-compat-configuration-procd-compat
|
|
(default procd-compat))
|
|
(ucode procd-compat-configuration-ucode (default ucode))
|
|
;; List of (CONFIG SERVICE): UCI config name, Shepherd service symbol.
|
|
(triggers procd-compat-configuration-triggers (default '()))
|
|
;; `ubus call system board' release table, as procd reads it from
|
|
;; os-release: distribution, version, revision, target, description.
|
|
(release procd-compat-configuration-release
|
|
(default `(("distribution" . "Guix System")
|
|
("version" . ,%guix-version)
|
|
("description" . "Guix System, OpenWrt userland")))))
|
|
|
|
(define (procd-compat-config-file config)
|
|
(match-record config <procd-compat-configuration> (triggers release)
|
|
(let* ((configs (delete-duplicates (map first triggers)))
|
|
(services (lambda (name)
|
|
(list->vector
|
|
(delete-duplicates
|
|
(filter-map (match-lambda
|
|
((c service)
|
|
(and (string=? c name)
|
|
(symbol->string service))))
|
|
triggers))))))
|
|
;; herd and reboot of the running system's Shepherd; uci-service-type's
|
|
;; uci.
|
|
(plain-file "procd-compat.json"
|
|
(scm->json-string
|
|
`(("herd" . "/run/current-system/profile/bin/herd")
|
|
("reboot" . "/run/current-system/profile/sbin/reboot")
|
|
("uci" . "/run/current-system/profile/bin/uci")
|
|
("triggers" . ,(map (lambda (c) (cons c (services c)))
|
|
configs))
|
|
("release" . ,release)))))))
|
|
|
|
(define (procd-compat-shepherd-service config)
|
|
(match-record config <procd-compat-configuration> (procd-compat ucode)
|
|
(let ((reload-config (file-append procd-compat "/sbin/reload_config")))
|
|
(list (shepherd-service
|
|
(documentation
|
|
"Provide procd's ubus service and system objects.")
|
|
(provision '(procd-compat))
|
|
(requirement '(ubus))
|
|
(start
|
|
#~(lambda args
|
|
;; reload_config's digests are of the configs as they were
|
|
;; when it last ran; start from the current ones.
|
|
(when (file-exists? "/var/run/config.md5")
|
|
(delete-file "/var/run/config.md5"))
|
|
(system* #$reload-config)
|
|
(apply (make-forkexec-constructor
|
|
(list #$(file-append ucode "/bin/ucode")
|
|
#$(file-append procd-compat
|
|
"/share/procd-compat/procd-compat.uc")
|
|
#$(procd-compat-config-file config)))
|
|
args)))
|
|
(stop #~(make-kill-destructor)))))))
|
|
|
|
(define procd-compat-service-type
|
|
(service-type
|
|
(name 'procd-compat)
|
|
(extensions
|
|
(list (service-extension shepherd-root-service-type
|
|
procd-compat-shepherd-service)
|
|
;; reload_config, to run after `uci commit'.
|
|
(service-extension profile-service-type
|
|
(compose list
|
|
procd-compat-configuration-procd-compat))
|
|
;; Sourced or read by OpenWrt scripts (TollGate's version).
|
|
(service-extension etc-service-type
|
|
(lambda (config)
|
|
(let ((release
|
|
(procd-compat-configuration-release
|
|
config)))
|
|
(define (field key)
|
|
(or (assoc-ref release key) ""))
|
|
`(("openwrt_release"
|
|
,(plain-file
|
|
"openwrt_release"
|
|
(string-append
|
|
"DISTRIB_ID='" (field "distribution") "'\n"
|
|
"DISTRIB_RELEASE='" (field "version") "'\n"
|
|
"DISTRIB_REVISION='" (field "revision") "'\n"
|
|
"DISTRIB_TARGET='" (field "target") "'\n"
|
|
"DISTRIB_DESCRIPTION='"
|
|
(field "description") "'\n")))))))))
|
|
(compose concatenate)
|
|
(extend (lambda (config triggers)
|
|
(procd-compat-configuration
|
|
(inherit config)
|
|
(triggers (append (procd-compat-configuration-triggers config)
|
|
triggers)))))
|
|
(default-value (procd-compat-configuration))
|
|
(description "Run procd-compat, which answers procd's ubus API for OpenWrt
|
|
tools: UCI config changes reload the Shepherd services registered for them,
|
|
and @code{ubus call system board} works.")))
|
|
|
|
|
|
;;;
|
|
;;; UCI.
|
|
;;;
|
|
|
|
(define-record-type* <uci-configuration>
|
|
uci-configuration make-uci-configuration
|
|
uci-configuration?
|
|
(uci uci-configuration-uci (default uci))
|
|
;; List of (NAME FILE-LIKE): initial /etc/config/NAME contents.
|
|
(seeds uci-configuration-seeds (default '()))
|
|
;; List of (NAME FILE-LIKE): OpenWrt uci-defaults scripts, run in order
|
|
;; with busybox sh after seeding, each followed by `uci commit'. OpenWrt
|
|
;; deletes a script once it exits 0; here a marker in
|
|
;; /etc/uci-defaults.done/NAME records that, so a failing script is
|
|
;; retried on the next activation.
|
|
(defaults uci-configuration-defaults (default '()))
|
|
;; Like DEFAULTS, but run by wifi-setup once /etc/config/wireless exists
|
|
;; (on a fresh system that is after activation: the radios need their
|
|
;; drivers). For scripts that configure WiFi interfaces, such as
|
|
;; TollGate's setup. If any ran, wifi-setup reboots once, so that every
|
|
;; service starts from their result -- as uci-defaults run before
|
|
;; services on OpenWrt. Same markers as DEFAULTS.
|
|
(late-defaults uci-configuration-late-defaults (default '())))
|
|
|
|
(define (uci-defaults-runner uci defaults)
|
|
;; A gexp running the not-yet-done scripts of DEFAULTS, a list of (NAME
|
|
;; FILE-LIKE), in order; it evaluates to the number that ran.
|
|
;; (The caller imports (guix build utils) and (ice-9 match).)
|
|
#~(let ((ran 0))
|
|
(mkdir-p "/etc/uci-defaults.done")
|
|
(for-each (match-lambda
|
|
((name script)
|
|
(let ((done (string-append "/etc/uci-defaults.done/"
|
|
name)))
|
|
(unless (file-exists? done)
|
|
(let ((status
|
|
(system* #$(file-append busybox "/bin/env")
|
|
(string-append "PATH=" #$uci "/bin:"
|
|
#$busybox "/bin:"
|
|
#$busybox "/sbin")
|
|
#$(file-append busybox "/bin/sh")
|
|
script)))
|
|
(if (zero? status)
|
|
(begin
|
|
;; As OpenWrt's uci_apply_defaults.
|
|
(system* #$(file-append uci "/bin/uci")
|
|
"commit")
|
|
(call-with-output-file done (const #t))
|
|
(set! ran (+ ran 1))
|
|
(format #t "uci: ran defaults ~a~%" name))
|
|
(format #t "uci: defaults ~a failed (~a)~%"
|
|
name status)))))))
|
|
'#$(map (match-lambda
|
|
((name file) #~(#$name #$file)))
|
|
defaults))
|
|
ran))
|
|
|
|
(define (uci-activation config)
|
|
(match-record config <uci-configuration> (uci seeds defaults)
|
|
#~(begin
|
|
(use-modules (guix build utils) (ice-9 match))
|
|
(mkdir-p "/etc/config")
|
|
(for-each (match-lambda
|
|
((name file)
|
|
(let ((target (string-append "/etc/config/" name)))
|
|
;; Seed once; afterwards the file belongs to UCI.
|
|
(unless (file-exists? target)
|
|
(copy-file file target)
|
|
(chmod target #o644)
|
|
(format #t "uci: seeded ~a~%" target)))))
|
|
'#$(map (match-lambda
|
|
((name file) #~(#$name #$file)))
|
|
seeds))
|
|
#$(uci-defaults-runner uci defaults))))
|
|
|
|
(define (uci-late-defaults-program config)
|
|
;; /etc/uci-late-defaults, which wifi-setup runs: exit status 10 if any
|
|
;; script ran, 0 otherwise.
|
|
(match-record config <uci-configuration> (uci late-defaults)
|
|
(program-file "uci-late-defaults"
|
|
(with-imported-modules '((guix build utils))
|
|
#~(begin
|
|
(use-modules (guix build utils) (ice-9 match))
|
|
(exit (if (zero? #$(uci-defaults-runner uci late-defaults))
|
|
0
|
|
10)))))))
|
|
|
|
;; What other services add to uci-service-type: seeds and uci-defaults
|
|
;; scripts for the configs they own (rpcd, luci).
|
|
(define-record-type* <uci-extension>
|
|
uci-extension make-uci-extension
|
|
uci-extension?
|
|
(seeds uci-extension-seeds (default '()))
|
|
(defaults uci-extension-defaults (default '()))
|
|
(late-defaults uci-extension-late-defaults (default '())))
|
|
|
|
(define uci-service-type
|
|
(service-type
|
|
(name 'uci)
|
|
(extensions
|
|
(list (service-extension activation-service-type uci-activation)
|
|
(service-extension etc-service-type
|
|
(lambda (config)
|
|
`(("uci-late-defaults"
|
|
,(uci-late-defaults-program config)))))
|
|
(service-extension profile-service-type
|
|
(compose list uci-configuration-uci))))
|
|
(compose identity)
|
|
(extend (lambda (config extensions)
|
|
(uci-configuration
|
|
(inherit config)
|
|
(seeds (append (uci-configuration-seeds config)
|
|
(append-map uci-extension-seeds extensions)))
|
|
;; Run in name order like /etc/uci-defaults, whoever adds
|
|
;; them.
|
|
(defaults
|
|
(sort (append (uci-configuration-defaults config)
|
|
(append-map uci-extension-defaults extensions))
|
|
(lambda (a b) (string<? (first a) (first b)))))
|
|
(late-defaults
|
|
(sort (append (uci-configuration-late-defaults config)
|
|
(append-map uci-extension-late-defaults
|
|
extensions))
|
|
(lambda (a b) (string<? (first a) (first b))))))))
|
|
(default-value (uci-configuration))
|
|
(description "Provide @command{uci} and seed @file{/etc/config}.")))
|
|
|
|
|
|
;;;
|
|
;;; hotplug-call and netifd.
|
|
;;;
|
|
|
|
;; procd's job in OpenWrt: run /etc/hotplug.d/TYPE/* for an event, with the
|
|
;; event's environment (ACTION, INTERFACE, DEVICE, ...). netifd calls this
|
|
;; on interface up/down; firewall4 and odhcpd hook in there. Like
|
|
;; base-files' /sbin/hotplug-call, minus /lib/functions.sh (not packaged yet).
|
|
(define %hotplug-call
|
|
(program-file "hotplug-call"
|
|
#~(begin
|
|
(use-modules (ice-9 ftw))
|
|
(let* ((type (cadr (command-line)))
|
|
(dir (string-append "/etc/hotplug.d/" type)))
|
|
(setenv "HOTPLUG_TYPE" type)
|
|
(setenv "PATH" "/run/current-system/profile/bin:\
|
|
/run/current-system/profile/sbin")
|
|
(when (file-exists? dir)
|
|
(for-each (lambda (script)
|
|
;; Each script in its own shell, like `( . $script )'.
|
|
(system* #$(file-append bash "/bin/bash") "-c"
|
|
". \"$0\"" (string-append dir "/" script)))
|
|
(or (scandir dir (lambda (f)
|
|
(not (member f '("." ".."))))
|
|
string<?)
|
|
'())))))))
|
|
|
|
(define-record-type* <netifd-configuration>
|
|
netifd-configuration make-netifd-configuration
|
|
netifd-configuration?
|
|
(netifd netifd-configuration-netifd (default netifd))
|
|
(hotplug netifd-configuration-hotplug (default %hotplug-call))
|
|
;; DNS servers learnt by netifd's protocols; kept apart from
|
|
;; /etc/resolv.conf while dhcpcd still owns that.
|
|
(resolv-conf netifd-configuration-resolv-conf
|
|
(default "/var/run/netifd/resolv.conf.auto"))
|
|
;; List of (INTERFACE DEVICE REQUIREMENT): WiFi netdevs managed outside
|
|
;; netifd (e.g. by wpa-supplicant-service-type). netifd won't take a
|
|
;; device with phy80211 from `option device'; like OpenWrt's wireless
|
|
;; scripts, attach it as an external device over ubus once REQUIREMENT
|
|
;; (a Shepherd service, e.g. 'wpa-supplicant) has started.
|
|
(external-devices netifd-configuration-external-devices (default '())))
|
|
|
|
(define (external-device-shepherd-service entry)
|
|
(match entry
|
|
((interface device requirement)
|
|
(let ((name (symbol-append 'netifd-attach- (string->symbol device))))
|
|
(shepherd-service
|
|
(documentation
|
|
(string-append "Attach " device " to netifd interface " interface "."))
|
|
(provision (list name))
|
|
(requirement (list 'netifd requirement))
|
|
(one-shot? #t)
|
|
(start
|
|
#~(lambda _
|
|
;; netifd's ubus objects appear shortly after it starts.
|
|
(let loop ((tries 30))
|
|
(cond ((zero? (system* #$(file-append ubus "/bin/ubus")
|
|
"call"
|
|
#$(string-append "network.interface."
|
|
interface)
|
|
"add_device"
|
|
#$(string-append "{\"name\":\"" device
|
|
"\",\"link-ext\":true}")))
|
|
#t)
|
|
((zero? tries) #f)
|
|
(else (sleep 1) (loop (- tries 1))))))))))))
|
|
|
|
(define (netifd-shepherd-service config)
|
|
(match-record config <netifd-configuration>
|
|
(netifd hotplug resolv-conf external-devices)
|
|
(cons (shepherd-service
|
|
(documentation "Run netifd, configuring interfaces from UCI.")
|
|
;; 'networking: netifd now owns the LAN, which sshd and dnsmasq
|
|
;; wait for. "Started" means netifd runs, not that every
|
|
;; interface is up (dnsmasq binds the wildcard address).
|
|
(provision '(netifd lan networking))
|
|
(requirement '(ubus user-processes))
|
|
(start
|
|
#~(lambda args
|
|
(mkdir-p (dirname #$resolv-conf))
|
|
(mkdir-p "/var/state") ;uci -P /var/state, used by scripts
|
|
(apply (make-forkexec-constructor
|
|
(list #$(file-append netifd "/sbin/netifd")
|
|
"-h" #$hotplug
|
|
"-r" #$resolv-conf)
|
|
;; Protocol scripts (dhcp.sh, dhcp.script) call
|
|
;; ubus, jsonfilter, uci, logger by name.
|
|
#:environment-variables
|
|
'("PATH=/run/current-system/profile/bin:\
|
|
/run/current-system/profile/sbin"))
|
|
args)))
|
|
(stop #~(make-kill-destructor))
|
|
(actions
|
|
(list (shepherd-action
|
|
(name 'reload)
|
|
;; procd's reload trigger on network/wireless: netifd
|
|
;; rereads /etc/config/network and applies the changes.
|
|
(documentation "Reread /etc/config/network.")
|
|
(procedure
|
|
#~(lambda _
|
|
(zero? (system* #$(file-append ubus "/bin/ubus")
|
|
"call" "network" "reload"))))))))
|
|
(map external-device-shepherd-service external-devices))))
|
|
|
|
(define netifd-service-type
|
|
(service-type
|
|
(name 'netifd)
|
|
(extensions
|
|
(list (service-extension shepherd-root-service-type
|
|
netifd-shepherd-service)
|
|
(service-extension profile-service-type
|
|
(compose list netifd-configuration-netifd))
|
|
(service-extension procd-compat-service-type
|
|
(const '(("network" netifd)
|
|
("wireless" netifd))))
|
|
(service-extension openwrt-init.d-service-type
|
|
(const '(("network" netifd 20))))))
|
|
(default-value (netifd-configuration))
|
|
(description "Run netifd, OpenWrt's network configuration daemon, with
|
|
@file{/etc/config/network} as its configuration.")))
|
|
|
|
|
|
;;;
|
|
;;; odhcpd.
|
|
;;;
|
|
|
|
(define-record-type* <odhcpd-configuration>
|
|
odhcpd-configuration make-odhcpd-configuration
|
|
odhcpd-configuration?
|
|
(odhcpd odhcpd-configuration-odhcpd (default odhcpd)))
|
|
|
|
(define (odhcpd-shepherd-service config)
|
|
(match-record config <odhcpd-configuration> (odhcpd)
|
|
(list (shepherd-service
|
|
(documentation
|
|
"Run odhcpd, serving router advertisements and DHCPv6.")
|
|
(provision '(odhcpd))
|
|
;; It follows netifd's interfaces over ubus, and reads them at
|
|
;; startup: start once netifd runs.
|
|
(requirement '(ubus netifd))
|
|
(start
|
|
#~(lambda args
|
|
;; Directories named in /etc/config/dhcp (seed): odhcpd
|
|
;; doesn't create them.
|
|
(for-each mkdir-p '("/tmp/hosts" "/tmp/odhcpd-piodir"))
|
|
(apply (make-forkexec-constructor
|
|
(list #$(file-append odhcpd "/sbin/odhcpd")))
|
|
args)))
|
|
(stop #~(make-kill-destructor))
|
|
(actions
|
|
(list (shepherd-action
|
|
(name 'reload)
|
|
;; procd's reload trigger on dhcp (procd-compat runs it
|
|
;; on config.change).
|
|
(documentation "Reread /etc/config/dhcp (SIGHUP).")
|
|
(procedure
|
|
#~(lambda (running . _)
|
|
(kill (if (integer? running)
|
|
running
|
|
(process-id running))
|
|
SIGHUP)
|
|
#t)))))))))
|
|
|
|
(define odhcpd-service-type
|
|
(service-type
|
|
(name 'odhcpd)
|
|
(extensions
|
|
(list (service-extension shepherd-root-service-type
|
|
odhcpd-shepherd-service)
|
|
;; odhcpd-update, the leasetrigger, by a stable file name.
|
|
(service-extension profile-service-type
|
|
(compose list odhcpd-configuration-odhcpd))
|
|
(service-extension procd-compat-service-type
|
|
(const '(("dhcp" odhcpd))))
|
|
(service-extension openwrt-init.d-service-type
|
|
(const '(("odhcpd" odhcpd 35))))))
|
|
(default-value (odhcpd-configuration))
|
|
(description "Run odhcpd, OpenWrt's IPv6 RA/DHCPv6 server, configured from
|
|
@file{/etc/config/dhcp}.")))
|
|
|
|
|
|
;;;
|
|
;;; firewall4.
|
|
;;;
|
|
|
|
(define-record-type* <firewall-configuration>
|
|
firewall-configuration make-firewall-configuration
|
|
firewall-configuration?
|
|
(firewall4 firewall-configuration-firewall4 (default firewall4)))
|
|
|
|
(define (firewall-shepherd-service config)
|
|
(match-record config <firewall-configuration> (firewall4)
|
|
(let ((fw4 (file-append firewall4 "/sbin/fw4")))
|
|
(list (shepherd-service
|
|
(documentation
|
|
"Load the firewall4 ruleset rendered from /etc/config/firewall.")
|
|
;; 'nftables: what nftables-service-type provided, which this
|
|
;; replaces -- fw4 owns the whole ruleset (`fw4 flush' deletes
|
|
;; every table).
|
|
(provision '(firewall nftables))
|
|
;; Zones name netifd interfaces; fw4 asks netifd over ubus for
|
|
;; their devices. Interfaces that come up later reload it
|
|
;; through netifd's hotplug (/etc/hotplug.d/iface/20-firewall),
|
|
;; as on OpenWrt.
|
|
(requirement '(ubus netifd))
|
|
;; No process: the ruleset lives in the kernel. fw4 runs
|
|
;; firewall includes (nodogsplash's calls herd), so Shepherd
|
|
;; doesn't wait for it (PITFALLS #43); `herd check firewall'
|
|
;; and the log report failures. Forked outside the service:
|
|
;; with no process as running value, Shepherd would take fw4's
|
|
;; exit for the service's.
|
|
(start #~(lambda _
|
|
(parameterize ((current-service #f))
|
|
(fork+exec-command (list #$fw4 "-q" "start")))
|
|
#t))
|
|
(stop #~(lambda _
|
|
(system* #$fw4 "flush")
|
|
#f))
|
|
(actions
|
|
(list (shepherd-action
|
|
(name 'reload)
|
|
;; procd's reload trigger on firewall (procd-compat).
|
|
(documentation "Re-render and reload the ruleset.")
|
|
(procedure #~(lambda _
|
|
(parameterize ((current-service #f))
|
|
(fork+exec-command (list #$fw4 "reload")))
|
|
#t)))
|
|
(shepherd-action
|
|
(name 'check)
|
|
(documentation
|
|
"Check the ruleset /etc/config/firewall renders to.")
|
|
(procedure #~(lambda _
|
|
(zero? (system* #$fw4 "check"))))))))))))
|
|
|
|
(define (firewall-activation config)
|
|
(match-record config <firewall-configuration> (firewall4)
|
|
#~(begin
|
|
(use-modules (guix build utils))
|
|
;; /etc/nftables.d: user includes, a conffile directory on OpenWrt.
|
|
;; Seed once, like /etc/config.
|
|
(unless (file-exists? "/etc/nftables.d")
|
|
(copy-recursively #$(file-append firewall4 "/etc/nftables.d")
|
|
"/etc/nftables.d")
|
|
(for-each (lambda (f) (chmod f #o644))
|
|
(find-files "/etc/nftables.d"))))))
|
|
|
|
(define firewall-service-type
|
|
(service-type
|
|
(name 'firewall)
|
|
(extensions
|
|
(list (service-extension shepherd-root-service-type
|
|
firewall-shepherd-service)
|
|
(service-extension activation-service-type firewall-activation)
|
|
;; netifd's hotplug-call runs /etc/hotplug.d/iface/* on ifup.
|
|
(service-extension etc-service-type
|
|
(lambda (config)
|
|
`(("hotplug.d/iface/20-firewall"
|
|
,(file-append
|
|
(firewall-configuration-firewall4 config)
|
|
"/etc/hotplug.d/iface/20-firewall")))))
|
|
;; fw4 on PATH, for people and the hotplug script; nft to
|
|
;; inspect the ruleset (`nft list table inet fw4').
|
|
(service-extension profile-service-type
|
|
(lambda (config)
|
|
(list (firewall-configuration-firewall4 config)
|
|
nftables)))
|
|
(service-extension procd-compat-service-type
|
|
(const '(("firewall" firewall))))
|
|
(service-extension openwrt-init.d-service-type
|
|
(const '(("firewall" firewall 19))))))
|
|
(default-value (firewall-configuration))
|
|
(description "Run firewall4, OpenWrt's nftables firewall, configured from
|
|
@file{/etc/config/firewall}.")))
|
|
|
|
|
|
;;;
|
|
;;; dnsmasq, configured from UCI.
|
|
;;;
|
|
|
|
;; OpenWrt's dnsmasq init script renders /etc/config/dhcp (what LuCI's DHCP
|
|
;; and DNS pages edit) into /var/etc/dnsmasq.conf.SECTION and starts dnsmasq
|
|
;; with it, as an openwrt-init-script. Only the first `config dnsmasq'
|
|
;; instance runs.
|
|
(define-record-type* <openwrt-dnsmasq-configuration>
|
|
openwrt-dnsmasq-configuration make-openwrt-dnsmasq-configuration
|
|
openwrt-dnsmasq-configuration?
|
|
(dnsmasq openwrt-dnsmasq-configuration-dnsmasq (default dnsmasq))
|
|
(openwrt-dnsmasq openwrt-dnsmasq-configuration-openwrt-dnsmasq
|
|
(default openwrt-dnsmasq))
|
|
(requirement openwrt-dnsmasq-configuration-requirement
|
|
(default '(user-processes lan))))
|
|
|
|
(define (openwrt-dnsmasq-init-script config)
|
|
(match-record config <openwrt-dnsmasq-configuration>
|
|
(dnsmasq openwrt-dnsmasq requirement)
|
|
(list (openwrt-init-script
|
|
(name "dnsmasq")
|
|
(script (file-append openwrt-dnsmasq
|
|
"/share/openwrt-dnsmasq/dnsmasq.init"))
|
|
;; The init script asks netifd for interfaces over ubus.
|
|
(requirement `(ubus ,@requirement))
|
|
(start-priority 19)
|
|
(environment
|
|
(list #~(string-append "DNSMASQ=" #$dnsmasq "/sbin/dnsmasq")))))))
|
|
|
|
;; OpenWrt's dnsmasq has interface triggers: DHCP ranges come from netifd's
|
|
;; interface state, so render again when an interface comes up.
|
|
(define %dnsmasq-hotplug
|
|
(plain-file "25-dnsmasq" "\
|
|
[ \"$ACTION\" = ifup ] || exit 0
|
|
/run/current-system/profile/bin/herd reload dnsmasq >/dev/null 2>&1
|
|
"))
|
|
|
|
(define (openwrt-dnsmasq-accounts config)
|
|
(list (user-group (name "dnsmasq") (system? #t))
|
|
(user-account
|
|
(name "dnsmasq")
|
|
(group "dnsmasq")
|
|
(system? #t)
|
|
(comment "dnsmasq daemon user")
|
|
(home-directory "/var/empty")
|
|
(shell (file-append shadow "/sbin/nologin")))))
|
|
|
|
(define openwrt-dnsmasq-service-type
|
|
(service-type
|
|
(name 'openwrt-dnsmasq)
|
|
(extensions
|
|
(list (service-extension openwrt-init-script-service-type
|
|
openwrt-dnsmasq-init-script)
|
|
;; The generated config has user=dnsmasq.
|
|
(service-extension account-service-type openwrt-dnsmasq-accounts)
|
|
(service-extension etc-service-type
|
|
(const `(("hotplug.d/iface/25-dnsmasq"
|
|
,%dnsmasq-hotplug))))
|
|
;; dnsmasq in the profile: LuCI shows its DNS page when it is.
|
|
(service-extension profile-service-type
|
|
(compose list
|
|
openwrt-dnsmasq-configuration-dnsmasq))
|
|
(service-extension procd-compat-service-type
|
|
(const '(("dhcp" dnsmasq)
|
|
("system" dnsmasq))))))
|
|
(default-value (openwrt-dnsmasq-configuration))
|
|
(description "Run dnsmasq with the configuration OpenWrt's init script
|
|
renders from @file{/etc/config/dhcp}.")))
|
|
|
|
|
|
;;;
|
|
;;; nodogsplash.
|
|
;;;
|
|
|
|
;; Captive portal, as OpenWrt's package: its init script renders
|
|
;; /etc/config/nodogsplash; a firewall include restarts it when fw4 reloads
|
|
;; (its iptables rules live beside fw4's table, through iptables-nft).
|
|
;; ENABLED? goes into the seed: OpenWrt's stock config gates br-lan as soon
|
|
;; as it is installed, so the default here is off.
|
|
(define-record-type* <nodogsplash-configuration>
|
|
nodogsplash-configuration make-nodogsplash-configuration
|
|
nodogsplash-configuration?
|
|
(nodogsplash nodogsplash-configuration-nodogsplash
|
|
(default nodogsplash))
|
|
(openwrt-nodogsplash nodogsplash-configuration-openwrt-nodogsplash
|
|
(default openwrt-nodogsplash))
|
|
(enabled? nodogsplash-configuration-enabled? (default #f)))
|
|
|
|
(define (nodogsplash-file config file)
|
|
(file-append (nodogsplash-configuration-openwrt-nodogsplash config)
|
|
"/share/openwrt-nodogsplash/" file))
|
|
|
|
(define (nodogsplash-seed config)
|
|
(computed-file "nodogsplash"
|
|
#~(begin
|
|
(use-modules (ice-9 textual-ports) (ice-9 regex))
|
|
(let ((text (call-with-input-file
|
|
#$(nodogsplash-file config "nodogsplash.config")
|
|
get-string-all)))
|
|
(call-with-output-file #$output
|
|
(lambda (port)
|
|
(display (regexp-substitute/global
|
|
#f "option enabled [01]" text
|
|
'pre #$(if (nodogsplash-configuration-enabled? config)
|
|
"option enabled 1"
|
|
"option enabled 0")
|
|
'post)
|
|
port)))))))
|
|
|
|
(define (nodogsplash-activation config)
|
|
;; Its webroot, /etc/nodogsplash/htdocs, is mutable (TollGate rewrites
|
|
;; it): seed once.
|
|
#~(begin
|
|
(use-modules (guix build utils))
|
|
(unless (file-exists? "/etc/nodogsplash/htdocs")
|
|
(copy-recursively
|
|
#$(file-append (nodogsplash-configuration-nodogsplash config)
|
|
"/share/nodogsplash/htdocs")
|
|
"/etc/nodogsplash/htdocs")
|
|
(for-each (lambda (f) (chmod f #o644))
|
|
(find-files "/etc/nodogsplash/htdocs")))))
|
|
|
|
(define nodogsplash-service-type
|
|
(service-type
|
|
(name 'nodogsplash)
|
|
(extensions
|
|
(list (service-extension openwrt-init-script-service-type
|
|
(lambda (config)
|
|
(list (openwrt-init-script
|
|
(name "nodogsplash")
|
|
(script (nodogsplash-file
|
|
config "nodogsplash.init"))
|
|
(requirement
|
|
'(ubus networking firewall))
|
|
(start-priority 95)))))
|
|
(service-extension uci-service-type
|
|
(lambda (config)
|
|
(uci-extension
|
|
(seeds `(("nodogsplash"
|
|
,(nodogsplash-seed config))))
|
|
(defaults `(("40_nodogsplash"
|
|
,(nodogsplash-file
|
|
config "40_nodogsplash")))))))
|
|
(service-extension activation-service-type nodogsplash-activation)
|
|
;; ndsctl (TollGate, the firewall include), iptables for its
|
|
;; rules, the include itself at a stable path.
|
|
(service-extension profile-service-type
|
|
(lambda (config)
|
|
(list (nodogsplash-configuration-nodogsplash
|
|
config)
|
|
(nodogsplash-configuration-openwrt-nodogsplash
|
|
config)
|
|
iptables-nft/cross)))
|
|
(service-extension procd-compat-service-type
|
|
(const '(("nodogsplash" nodogsplash))))))
|
|
;; Extending it only pulls it into the system (TollGate).
|
|
(compose (const #t))
|
|
(extend (lambda (config _) config))
|
|
(default-value (nodogsplash-configuration))
|
|
(description "Run nodogsplash, a captive portal, configured from
|
|
@file{/etc/config/nodogsplash} by OpenWrt's init script.")))
|
|
|
|
|
|
;;;
|
|
;;; Wireless.
|
|
;;;
|
|
|
|
;; OpenWrt's wireless stack: wpad's hostapd and wpa_supplicant wait on
|
|
;; global control sockets and ubus; netifd's wireless.uc (wifi-scripts)
|
|
;; configures them from /etc/config/wireless. wifi-setup, at boot, detects
|
|
;; the radios into /tmp/sysinfo/board.json (from BOARD-BASE, as OpenWrt's
|
|
;; wifi-detect) and, if there is no /etc/config/wireless yet, runs
|
|
;; `wifi config' and then FIRST-CONFIG, a uci batch script (the AP defaults),
|
|
;; then makes netifd reload.
|
|
(define-record-type* <openwrt-wireless-configuration>
|
|
openwrt-wireless-configuration make-openwrt-wireless-configuration
|
|
openwrt-wireless-configuration?
|
|
(wpad openwrt-wireless-configuration-wpad (default wpad))
|
|
(wifi-scripts openwrt-wireless-configuration-wifi-scripts
|
|
(default wifi-scripts))
|
|
;; /etc/board-base.json: model, network roles (OpenWrt's board_detect).
|
|
(board-base openwrt-wireless-configuration-board-base)
|
|
;; Shell run once after `wifi config' (uci set ...; uci commit wireless).
|
|
(first-config openwrt-wireless-configuration-first-config (default #f)))
|
|
|
|
(define (wpad-shepherd-services config)
|
|
(let ((wpad (openwrt-wireless-configuration-wpad config)))
|
|
(map (match-lambda
|
|
((name provision dir args)
|
|
(shepherd-service
|
|
(documentation (string-append "Run " name " (wpad) for netifd's
|
|
wireless handling."))
|
|
(provision (list provision))
|
|
(requirement '(ubus user-processes))
|
|
(start #~(lambda args
|
|
(mkdir-p #$dir)
|
|
(apply (make-forkexec-constructor
|
|
(cons #$(file-append wpad "/sbin/" name)
|
|
'#$args))
|
|
args)))
|
|
(stop #~(make-kill-destructor)))))
|
|
;; As OpenWrt's wpad.init.
|
|
`(("hostapd" hostapd "/var/run/hostapd"
|
|
("-s" "-g" "/var/run/hostapd/global"))
|
|
("wpa_supplicant" wpa_supplicant "/var/run/wpa_supplicant"
|
|
("-n" "-s" "-g" "/var/run/wpa_supplicant/global"))))))
|
|
|
|
(define (wifi-setup-script config)
|
|
(match-record config <openwrt-wireless-configuration>
|
|
(wifi-scripts first-config)
|
|
(program-file "wifi-setup"
|
|
#~(begin
|
|
(setenv "PATH" "/run/current-system/profile/bin:\
|
|
/run/current-system/profile/sbin")
|
|
;; brcmfmac and friends load firmware after boot: wait for a phy.
|
|
(let loop ((tries 60))
|
|
(unless (or (file-exists? "/sys/class/ieee80211/phy0")
|
|
(zero? tries))
|
|
(sleep 1)
|
|
(loop (- tries 1))))
|
|
(system* "mkdir" "-p" "/tmp/sysinfo")
|
|
(system* "ucode" #$(file-append wifi-scripts
|
|
"/share/hostap/wifi-detect.uc"))
|
|
(unless (file-exists? "/etc/config/wireless")
|
|
(system* #$(file-append wifi-scripts "/sbin/wifi") "config")
|
|
#$@(if first-config
|
|
(list #~(system* "sh" #$first-config))
|
|
'()))
|
|
;; uci-defaults that need the WiFi config (uci-service-type's
|
|
;; late-defaults): if any ran, reboot so that every service
|
|
;; starts from their result.
|
|
(if (and (file-exists? "/etc/uci-late-defaults")
|
|
(= 10 (status:exit-val
|
|
(system* "/etc/uci-late-defaults"))))
|
|
(begin
|
|
(system* "sync")
|
|
(system* "reboot"))
|
|
(system* "ubus" "call" "network" "reload"))))))
|
|
|
|
(define (openwrt-wireless-shepherd-services config)
|
|
(cons (shepherd-service
|
|
(documentation "Detect radios; first boot: create /etc/config/wireless.")
|
|
(provision '(wifi-setup))
|
|
(requirement '(netifd ubus))
|
|
(one-shot? #t)
|
|
;; Forked: it waits for the radio, and Shepherd mustn't
|
|
;; (PITFALLS #43, #46).
|
|
(start #~(lambda _
|
|
(parameterize ((current-service #f))
|
|
(fork+exec-command
|
|
(list #$(wifi-setup-script config))))
|
|
#t)))
|
|
(wpad-shepherd-services config)))
|
|
|
|
(define (openwrt-wireless-activation config)
|
|
#~(begin
|
|
;; As OpenWrt: /etc/board.json is what wifi-detect writes.
|
|
(unless (false-if-exception (lstat "/etc/board.json"))
|
|
(symlink "/tmp/sysinfo/board.json" "/etc/board.json"))))
|
|
|
|
(define openwrt-wireless-service-type
|
|
(service-type
|
|
(name 'openwrt-wireless)
|
|
(extensions
|
|
(list (service-extension shepherd-root-service-type
|
|
openwrt-wireless-shepherd-services)
|
|
(service-extension activation-service-type
|
|
openwrt-wireless-activation)
|
|
(service-extension etc-service-type
|
|
(lambda (config)
|
|
`(("board-base.json"
|
|
,(openwrt-wireless-configuration-board-base
|
|
config)))))
|
|
;; wpad (hostapd.uc), wifi-scripts (ucode modules, `wifi').
|
|
(service-extension profile-service-type
|
|
(lambda (config)
|
|
(list (openwrt-wireless-configuration-wpad config)
|
|
(openwrt-wireless-configuration-wifi-scripts
|
|
config))))))
|
|
(description "Run OpenWrt's wireless stack: wpad (hostapd,
|
|
wpa_supplicant) configured by netifd from @file{/etc/config/wireless}.")))
|
|
|
|
|
|
;;;
|
|
;;; rpcd.
|
|
;;;
|
|
|
|
(define-record-type* <rpcd-configuration>
|
|
rpcd-configuration make-rpcd-configuration
|
|
rpcd-configuration?
|
|
(rpcd rpcd-configuration-rpcd (default rpcd))
|
|
;; Seconds before a ubus call made for a session times out (-t).
|
|
(timeout rpcd-configuration-timeout (default 30)))
|
|
|
|
;; OpenWrt's /etc/config/rpcd (package/system/rpcd/files/rpcd.config):
|
|
;; root logs in with its system password ($p$ = from the shadow file).
|
|
(define %rpcd-seed
|
|
(plain-file "rpcd" "config rpcd
|
|
option socket /var/run/ubus/ubus.sock
|
|
option timeout 30
|
|
|
|
config login
|
|
option username 'root'
|
|
option password '$p$root'
|
|
list read '*'
|
|
list write '*'
|
|
"))
|
|
|
|
(define (rpcd-shepherd-service config)
|
|
(match-record config <rpcd-configuration> (rpcd timeout)
|
|
(list (shepherd-service
|
|
(documentation "Run rpcd, the ubus RPC backend of LuCI.")
|
|
(provision '(rpcd))
|
|
(requirement '(ubus))
|
|
(start
|
|
#~(make-forkexec-constructor
|
|
(list #$(file-append rpcd "/sbin/rpcd")
|
|
"-t" #$(number->string timeout))
|
|
;; `file exec' and the ucode plugins run commands by name.
|
|
#:environment-variables
|
|
'("PATH=/run/current-system/profile/bin:\
|
|
/run/current-system/profile/sbin")))
|
|
(stop #~(make-kill-destructor))
|
|
(actions
|
|
(list (shepherd-action
|
|
(name 'reload)
|
|
;; procd's reload: SIGHUP rereads ACLs and plugins.
|
|
(documentation "Reload ACLs and plugins (SIGHUP).")
|
|
(procedure
|
|
#~(lambda (running . _)
|
|
(kill (if (integer? running)
|
|
running
|
|
(process-id running))
|
|
SIGHUP)
|
|
#t)))))))))
|
|
|
|
(define rpcd-service-type
|
|
(service-type
|
|
(name 'rpcd)
|
|
(extensions
|
|
(list (service-extension shepherd-root-service-type
|
|
rpcd-shepherd-service)
|
|
;; Its plugins and ACL in the profile: rpcd reads
|
|
;; /run/current-system/profile/{lib,share}/rpcd.
|
|
(service-extension profile-service-type
|
|
(compose list rpcd-configuration-rpcd))
|
|
(service-extension uci-service-type
|
|
(const (uci-extension
|
|
(seeds `(("rpcd" ,%rpcd-seed))))))
|
|
(service-extension procd-compat-service-type
|
|
(const '(("rpcd" rpcd))))
|
|
(service-extension openwrt-init.d-service-type
|
|
(const '(("rpcd" rpcd 12))))))
|
|
;; Extending it only pulls it into the system (luci-service-type).
|
|
(compose (const #t))
|
|
(extend (lambda (config _) config))
|
|
(default-value (rpcd-configuration))
|
|
(description "Run rpcd, OpenWrt's ubus RPC daemon: sessions and ACLs, UCI
|
|
over ubus, and plugins (LuCI's backend).")))
|
|
|
|
|
|
;;;
|
|
;;; uhttpd.
|
|
;;;
|
|
|
|
;; uhttpd as OpenWrt runs it: its init script turns /etc/config/uhttpd
|
|
;; (seeded with OpenWrt's stock file; LuCI and TollGate's setup edit it)
|
|
;; into the command line, generating a self-signed certificate for HTTPS
|
|
;; when there is none. Listens on all addresses, as OpenWrt: the firewall's
|
|
;; wan zone keeps it in the LAN.
|
|
(define-record-type* <uhttpd-configuration>
|
|
uhttpd-configuration make-uhttpd-configuration
|
|
uhttpd-configuration?
|
|
(uhttpd uhttpd-configuration-uhttpd (default uhttpd))
|
|
(openwrt-uhttpd uhttpd-configuration-openwrt-uhttpd
|
|
(default openwrt-uhttpd)))
|
|
|
|
(define (uhttpd-files config file)
|
|
(file-append (uhttpd-configuration-openwrt-uhttpd config)
|
|
"/share/openwrt-uhttpd/" file))
|
|
|
|
(define uhttpd-service-type
|
|
(service-type
|
|
(name 'uhttpd)
|
|
(extensions
|
|
(list (service-extension openwrt-init-script-service-type
|
|
(lambda (config)
|
|
(list (openwrt-init-script
|
|
(name "uhttpd")
|
|
(script (uhttpd-files config
|
|
"uhttpd.init"))
|
|
;; Its ubus handler connects at start.
|
|
(requirement '(ubus networking))
|
|
(start-priority 50)))))
|
|
(service-extension uci-service-type
|
|
(lambda (config)
|
|
(uci-extension
|
|
(seeds `(("uhttpd" ,(uhttpd-files
|
|
config "uhttpd.config"))))
|
|
(defaults `(("00_uhttpd_ubus"
|
|
,(uhttpd-files
|
|
config "ubus.default")))))))
|
|
;; `uhttpd -m' (LuCI's password hashing) by name.
|
|
(service-extension profile-service-type
|
|
(compose list uhttpd-configuration-uhttpd))
|
|
(service-extension procd-compat-service-type
|
|
(const '(("uhttpd" uhttpd))))))
|
|
;; Extending it only pulls it into the system (luci-service-type).
|
|
(compose (const #t))
|
|
(extend (lambda (config _) config))
|
|
(default-value (uhttpd-configuration))
|
|
(description "Run uhttpd, OpenWrt's web server, configured from
|
|
@file{/etc/config/uhttpd} by OpenWrt's init script.")))
|
|
|
|
|
|
;;;
|
|
;;; LuCI.
|
|
;;;
|
|
|
|
;; What luci-base's postinst does: LuCI's dispatcher at /cgi-bin/luci.
|
|
(define %luci-uhttpd-defaults
|
|
(plain-file "luci-uhttpd" "\
|
|
if ! uci -q get uhttpd.main.ucode_prefix | grep -sq /cgi-bin/luci; then
|
|
uci add_list uhttpd.main.ucode_prefix='/cgi-bin/luci=/run/current-system/profile/share/ucode/luci/uhttpd.uc'
|
|
fi
|
|
"))
|
|
|
|
(define-record-type* <luci-configuration>
|
|
luci-configuration make-luci-configuration
|
|
luci-configuration?
|
|
(luci luci-configuration-luci (default luci))
|
|
;; List of (FILE TARGET [exec]): symlinks made at activation, or with
|
|
;; `exec', a script that execs TARGET. LuCI's pages run
|
|
;; tools and read files through rpcd's `file' object by OpenWrt path, and
|
|
;; its ACLs (share/rpcd/acl.d) name those exact paths: point them at the
|
|
;; system profile. An existing non-symlink FILE is left alone.
|
|
(commands luci-configuration-commands (default %luci-commands)))
|
|
|
|
(define %profile "/run/current-system/profile")
|
|
|
|
(define %luci-commands
|
|
`(;; Pages list and read their own files through rpcd by /www path
|
|
;; (status overview: view/status/include/).
|
|
("/www" ,(string-append %profile "/www"))
|
|
("/sbin/ip" ,(string-append %profile "/sbin/ip"))
|
|
("/sbin/ifup" ,(string-append %profile "/sbin/ifup"))
|
|
("/sbin/ifdown" ,(string-append %profile "/sbin/ifdown"))
|
|
("/sbin/reboot" ,(string-append %profile "/sbin/reboot"))
|
|
;; Log and nftables pages (through cgi-exec).
|
|
;; A script, not a symlink: the page execs the path `file stat'
|
|
;; returns, which resolves symlinks, and only this path is in its ACL.
|
|
("/usr/libexec/syslog-wrapper"
|
|
,(string-append %profile "/libexec/syslog-wrapper") exec)
|
|
("/bin/dmesg" ,(string-append %profile "/bin/dmesg"))
|
|
("/usr/sbin/nft" ,(string-append %profile "/sbin/nft"))
|
|
;; Diagnostics page.
|
|
("/bin/ping" ,(string-append %profile "/bin/ping"))
|
|
("/bin/ping6" ,(string-append %profile "/bin/ping6"))
|
|
("/bin/traceroute" ,(string-append %profile "/bin/traceroute"))
|
|
("/usr/bin/nslookup" ,(file-append busybox "/bin/nslookup"))
|
|
;; Processes and mount points pages.
|
|
("/bin/kill" ,(string-append %profile "/bin/kill"))
|
|
("/bin/umount" ,(string-append %profile "/bin/umount"))))
|
|
|
|
(define (luci-activation config)
|
|
#~(begin
|
|
(use-modules (guix build utils) (ice-9 match) (ice-9 textual-ports))
|
|
(let ()
|
|
(define marker "#!/bin/sh\n# luci-service-type\n")
|
|
(define (replaceable? file)
|
|
;; Ours from a previous activation, or absent.
|
|
(match (false-if-exception (lstat file))
|
|
(#f #t)
|
|
(st (or (eq? 'symlink (stat:type st))
|
|
(and (eq? 'regular (stat:type st))
|
|
(equal? marker
|
|
(call-with-input-file file
|
|
(lambda (port)
|
|
(get-string-n port
|
|
(string-length marker))))))))))
|
|
(for-each (match-lambda
|
|
((file target . kind)
|
|
(mkdir-p (dirname file))
|
|
(when (replaceable? file)
|
|
(false-if-exception (delete-file file))
|
|
(if (equal? kind '(exec))
|
|
(begin
|
|
(call-with-output-file file
|
|
(lambda (port)
|
|
(format port "~aexec ~a \"$@\"~%"
|
|
marker target)))
|
|
(chmod file #o755))
|
|
(symlink target file)))))
|
|
'#$(map (match-lambda
|
|
((file target . kind)
|
|
#~(#$file #$target #$@kind)))
|
|
(luci-configuration-commands config))))))
|
|
|
|
(define luci-service-type
|
|
(service-type
|
|
(name 'luci)
|
|
(extensions
|
|
(list (service-extension profile-service-type
|
|
(compose list luci-configuration-luci))
|
|
(service-extension activation-service-type luci-activation)
|
|
;; uhttpd serves it; the dispatcher's ucode_prefix comes from
|
|
;; %luci-uhttpd-defaults.
|
|
(service-extension uhttpd-service-type (const #t))
|
|
;; rpcd: sessions, UCI, and LuCI's plugins (luci-rpc, ucode luci).
|
|
(service-extension rpcd-service-type (const #t))
|
|
(service-extension uci-service-type
|
|
(lambda (config)
|
|
(let ((luci (luci-configuration-luci config)))
|
|
(uci-extension
|
|
(seeds
|
|
`(("luci" ,(file-append luci "/etc/config/luci"))
|
|
("luci_plugins"
|
|
,(file-append luci "/etc/config/luci_plugins"))))
|
|
(defaults
|
|
(cons
|
|
`("60_luci-uhttpd" ,%luci-uhttpd-defaults)
|
|
(map (lambda (name)
|
|
(list name
|
|
(file-append
|
|
luci "/etc/uci-defaults/" name)))
|
|
'("30_luci-theme-bootstrap"
|
|
"50_luci-mod-admin-full"))))))))))
|
|
(default-value (luci-configuration))
|
|
(description "Install LuCI, OpenWrt's web interface, served by uhttpd at
|
|
@code{/cgi-bin/luci} with rpcd as its backend.")))
|