summaryrefslogtreecommitdiff
path: root/px/system
diff options
context:
space:
mode:
Diffstat (limited to 'px/system')
-rw-r--r--px/system/config.scm123
-rw-r--r--px/system/install.scm8
-rw-r--r--px/system/os.scm298
-rw-r--r--px/system/raspberry.scm252
4 files changed, 336 insertions, 345 deletions
diff --git a/px/system/config.scm b/px/system/config.scm
index 6ec4f4c..ee27e77 100644
--- a/px/system/config.scm
+++ b/px/system/config.scm
@@ -26,49 +26,50 @@
px-desktop-os
px-desktop-ee-os
px-new-desktop
-
+
px-server-os
px-server-ee-os
px-core-arm-os
px-gui-arm-os
px-desktop-arm-os
-
+
%px-server-open-ports-common)
-;; Re-export for convenience
-#:re-export (%px-core-services
+ ;; Re-export for convenience
+ #:re-export (%px-core-services
- px-desktop-service-type
+ px-desktop-service-type
- %px-desktop-services
- %px-desktop-ee-services
+ %px-desktop-services
+ %px-desktop-ee-services
- %px-server-services
- %px-server-ee-services
-
- %px-core-arm-services
- %px-gui-arm-services
- %px-desktop-arm-services
+ %px-server-services
+ %px-server-ee-services
- %px-core-packages
+ %px-core-arm-services
+ %px-gui-arm-services
+ %px-desktop-arm-services
- %px-desktop-packages-gtk
- %px-desktop-packages-qt
- %px-desktop-packages
- %px-desktop-ee-packages
+ %px-core-packages
- %px-server-packages
- %px-server-ee-packages
- %px-core-arm-packages
- %px-gui-arm-packages))
+ %px-desktop-packages-gtk
+ %px-desktop-packages-qt
+ %px-desktop-packages
+ %px-desktop-ee-packages
+
+ %px-server-packages
+ %px-server-ee-packages
+ %px-core-arm-packages
+ %px-gui-arm-packages))
;;;
;;; PantherX Desktop OS defintions
;;;
(define %px-desktop-swap-devices
- (list (swap-space (target "/swapfile"))))
+ (list (swap-space
+ (target "/swapfile"))))
(define %px-server-open-ports-common
'(("tcp" "ssh" "http" "https")))
@@ -77,8 +78,8 @@
;;; CORE
;;;
-(define* (px-core-os os-config #:key
- (kernel 'libre)
+(define* (px-core-os os-config
+ #:key (kernel 'libre)
(templates '())
(open-ports #f)
(authorized-keys '()))
@@ -95,15 +96,15 @@
;;; DESKTOP
;;;
-(define* (px-desktop-os os-config #:key
- (kernel 'nonlibre)
+(define* (px-desktop-os os-config
+ #:key (kernel 'nonlibre)
(templates '())
(open-ports #f)
(authorized-keys '()))
(make-os (operating-system
- (inherit os-config)
- (swap-devices
- (prepare-swap-devices os-config %px-desktop-swap-devices)))
+ (inherit os-config)
+ (swap-devices (prepare-swap-devices os-config
+ %px-desktop-swap-devices)))
#:kernel kernel
#:open-ports open-ports
#:authorized-keys authorized-keys
@@ -111,15 +112,15 @@
#:default-packages %px-desktop-packages
#:default-services %px-desktop-services))
-(define* (px-desktop-ee-os os-config #:key
- (kernel 'nonlibre)
+(define* (px-desktop-ee-os os-config
+ #:key (kernel 'nonlibre)
(templates '())
(open-ports #f)
(authorized-keys '()))
(make-os (operating-system
- (inherit os-config)
- (swap-devices
- (prepare-swap-devices os-config %px-desktop-swap-devices)))
+ (inherit os-config)
+ (swap-devices (prepare-swap-devices os-config
+ %px-desktop-swap-devices)))
#:kernel kernel
#:open-ports open-ports
#:authorized-keys authorized-keys
@@ -127,8 +128,8 @@
#:default-packages %px-desktop-ee-packages
#:default-services %px-desktop-ee-services))
-(define* (px-new-desktop os-config #:key
- (kernel 'nonlibre)
+(define* (px-new-desktop os-config
+ #:key (kernel 'nonlibre)
(open-ports #f)
(authorized-keys '())
(templates '()))
@@ -144,8 +145,8 @@
;;; SERVER
;;;
-(define* (px-server-os os-config #:key
- (kernel 'libre)
+(define* (px-server-os os-config
+ #:key (kernel 'libre)
(templates '())
(open-ports %px-server-open-ports-common)
(authorized-keys '()))
@@ -157,8 +158,8 @@
#:default-packages %px-server-packages
#:default-services %px-server-services))
-(define* (px-server-ee-os os-config #:key
- (kernel 'libre)
+(define* (px-server-ee-os os-config
+ #:key (kernel 'libre)
(templates '())
(open-ports %px-server-open-ports-common)
(authorized-keys '()))
@@ -170,7 +171,6 @@
#:default-packages %px-server-ee-packages
#:default-services %px-server-ee-services))
-
;;;
;;; ARM
;;;
@@ -180,28 +180,27 @@
(host-name "pantherx")
(timezone "Europe/Berlin")
(locale "en_US.utf8")
-
+
(bootloader (bootloader-configuration
- (bootloader u-boot-bootloader)
- (targets '("/dev/vda"))))
-
+ (bootloader u-boot-bootloader)
+ (targets '("/dev/vda"))))
+
(file-systems (cons (file-system
(device "/dev/sda1")
(mount-point "/")
- (type "ext4"))
- %base-file-systems))
-
+ (type "ext4")) %base-file-systems))
+
(users (cons* (user-account
(name "panther")
(comment "default user")
(group "users")
(password (crypt "pantherx" "$6$abc"))
- (supplementary-groups '("wheel" "netdev" "lp"
- "video" "audio")))
- %base-user-accounts))
+ (supplementary-groups '("wheel" "netdev" "lp" "video"
+ "audio"))) %base-user-accounts))
(packages %px-core-arm-packages)
- (services %px-core-arm-services)
+ (services
+ %px-core-arm-services)
(name-service-switch %mdns-host-lookup-nss)))
(define px-gui-arm-os
@@ -209,15 +208,19 @@
(inherit px-core-arm-os)
(host-name "pantherx")
(packages %px-gui-arm-packages)
- (services %px-gui-arm-services)))
+ (services
+ %px-gui-arm-services)))
(define (px-desktop-arm-os os-config)
- (let ((selected-packages (prepare-packages os-config %px-desktop-arm-packages))
- (selected-services (prepare-services os-config %px-desktop-arm-services)))
+ (let ((selected-packages (prepare-packages os-config
+ %px-desktop-arm-packages))
+ (selected-services (prepare-services os-config
+ %px-desktop-arm-services)))
(operating-system
- (inherit os-config)
+ (inherit os-config)
- (packages selected-packages)
- (services selected-services)
+ (packages selected-packages)
+ (services
+ selected-services)
- (name-service-switch %mdns-host-lookup-nss)))) \ No newline at end of file
+ (name-service-switch %mdns-host-lookup-nss))))
diff --git a/px/system/install.scm b/px/system/install.scm
index 76e855b..bbabcab 100644
--- a/px/system/install.scm
+++ b/px/system/install.scm
@@ -1,9 +1,5 @@
-;;; PantherX disk image configuration file
-;;;
-;;; Author: Reza Alizadeh Majd <r.majd@PantherX.org>
-;;; Version: 1.0.0
-;;; Time-stamp: <2022-02-09 21:33:50 reza>
-
+;; PantherX disk image configuration file
+;; Reza Alizadeh Majd <r.majd@PantherX.org>
;; Generate a bootable image (e.g. for USB sticks, etc.) with:
;; $ guix system disk-image path/to/px-install.scm
;; Using Guix time-machine
diff --git a/px/system/os.scm b/px/system/os.scm
index f397fbd..fec1984 100644
--- a/px/system/os.scm
+++ b/px/system/os.scm
@@ -19,7 +19,6 @@
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (make-os
-
os-template
os-template-service
@@ -34,87 +33,82 @@
;; This is not used anywhere
;; %px-artwork-repository
;; %px-grub-theme
-
+
;; %px-substitute-server-url
;; %px-substitute-server-key
- apply-px-substitute-server
- ))
+ apply-px-substitute-server))
;;;
;;; Templates
;;;
-(define-record-type* <os-template-service>
- os-template-service make-os-template-service
+(define-record-type* <os-template-service> os-template-service
+ make-os-template-service
os-template-service?
- (type os-template-service-type) ; type of modification required: 'add 'edit 'delete
- (kind os-template-service-kind) ; service-kind that needs to be matched
- (action os-template-service-action ; action to be applied on service
+ (type os-template-service-type) ;type of modification required: 'add 'edit 'delete
+ (kind os-template-service-kind) ;service-kind that needs to be matched
+ (action os-template-service-action ;action to be applied on service
(default #f)))
-(define-record-type* <os-template>
- os-template make-os-template
+(define-record-type* <os-template> os-template make-os-template
os-template?
- (title os-template-title)
- (firmwares os-template-firmwares ; list of firmwares to be installed
+ (title os-template-title)
+ (firmwares os-template-firmwares ;list of firmwares to be installed
(default '()))
- (packages os-template-packages ; list of <package> to be installed
- (default '()))
- (services os-template-services ; list of <os-template-service>
- (default '())))
+ (packages os-template-packages ;list of <package> to be installed
+ (default '()))
+ (services os-template-services ;list of <os-template-service>
+ (default '())))
(define (apply-template-firmwares initial-firmwares template-firmwares)
(fold (lambda (firmware result)
- (if (memq firmware result)
- result
- (cons firmware result)))
- initial-firmwares
- template-firmwares))
+ (if (memq firmware result) result
+ (cons firmware result))) initial-firmwares template-firmwares))
(define (apply-template-package-imports initial-packages template-packages)
(fold (lambda (pkg result)
- (if (memq pkg result)
- result
- (cons pkg result)))
- initial-packages
- template-packages))
+ (if (memq pkg result) result
+ (cons pkg result))) initial-packages template-packages))
-(define (apply-template-service-modifications initial-services template-services)
+(define (apply-template-service-modifications initial-services
+ template-services)
(fold (lambda (svc result)
(match svc
(($ <os-template-service> type kind action)
(case type
- ((add) (cons (if action
- (service kind action)
- (service kind))
- result))
- ((edit) (modify-services result
- (kind config => (action config))))
- ((delete) (remove (lambda (s)
- (eq? (service-kind s) kind))
- result))
- (else result)))))
- initial-services
- template-services))
+ ((add)
+ (cons (if action
+ (service kind action)
+ (service kind)) result))
+ ((edit)
+ (modify-services result
+ (kind config =>
+ (action config))))
+ ((delete)
+ (remove (lambda (s)
+ (eq? (service-kind s) kind)) result))
+ (else result))))) initial-services template-services))
(define (apply-templates os-configuration os-templates)
(fold (lambda (template result)
- (let ((target-firmwares (apply-template-firmwares
- (operating-system-firmware os-configuration)
- (os-template-firmwares template)))
- (target-packages (apply-template-package-imports
- (operating-system-packages result)
- (os-template-packages template)))
- (target-services (apply-template-service-modifications
- (operating-system-user-services result)
- (os-template-services template))))
+ (let ((target-firmwares (apply-template-firmwares (operating-system-firmware
+ os-configuration)
+ (os-template-firmwares
+ template)))
+ (target-packages (apply-template-package-imports (operating-system-packages
+ result)
+ (os-template-packages
+ template)))
+ (target-services (apply-template-service-modifications (operating-system-user-services
+ result)
+ (os-template-services
+ template))))
(operating-system
- (inherit result)
- (firmware target-firmwares)
- (packages target-packages)
- (services target-services))))
- os-configuration
- os-templates))
+ (inherit result)
+ (firmware target-firmwares)
+ (packages target-packages)
+ (services
+ target-services)))) os-configuration os-templates))
;;
;; Firewall customization
@@ -123,38 +117,48 @@
(define (make-firewall-rules open-ports)
(define (make-port-rules open-ports status)
"Generate list of strings each is a port/service rule for nftables"
- (reduce-right append '()
+ (reduce-right append
+ '()
(map (match-lambda
((protocol ports ...)
(map (lambda (port)
- (string-append " " protocol " dport " port " " status))
- ports)))
- open-ports)))
+ (string-append " "
+ protocol
+ " dport "
+ port
+ " "
+ status)) ports))) open-ports)))
(let ((port-rules (make-port-rules open-ports "accept")))
(plain-file "nftables"
- (string-append
- "#PantherX firewall rules\n"
+ (string-append "#PantherX firewall rules\n"
"table inet filter {\n"
" chain input {\n"
- " type filter hook input priority 0; policy drop;\n"
+ " type filter hook input priority 0; policy drop;
+"
" # early drop of invalid connections\n"
" ct state invalid drop\n"
- " # allow established/related connections\n"
- " ct state { established, related } accept\n"
+ " # allow established/related connections
+"
+ " ct state { established, related } accept
+"
" # allow from loopback\n"
" iifname lo accept\n"
" # allow icmp\n"
" ip protocol icmp accept\n"
" ip6 nexthdr icmpv6 accept\n"
- (string-join port-rules "\n" 'suffix)
+ (string-join port-rules "\n"
+ 'suffix)
" # reject everything else\n"
- " reject with icmpx type port-unreachable\n"
+ " reject with icmpx type port-unreachable
+"
" }\n"
" chain forward {\n"
- " type filter hook forward priority 0; policy drop;\n"
+ " type filter hook forward priority 0; policy drop;
+"
" }\n"
" chain output {\n"
- " type filter hook output priority 0; policy accept;\n"
+ " type filter hook output priority 0; policy accept;
+"
" }\n"
"}\n"))))
@@ -165,27 +169,24 @@
(define %px-artwork-repository
(let ((commit "ecfd456e814a59e3b6743bcda83eab5d5c12ae99"))
(origin
- (method git-fetch)
- (uri (git-reference
- (url "https://git.pantherx.org/development/desktop/px-artwork.git")
- (commit commit)))
- (file-name (string-append "px-artwork-" (string-take commit 7)
- "-checkout"))
- (sha256
- (base32
- "06i47c8qp239c9rgkcizk3jd8rld4qbx90s5gg1a1rw1x90p245z")))))
+ (method git-fetch)
+ (uri (git-reference (url
+ "https://git.pantherx.org/development/desktop/px-artwork.git")
+ (commit commit)))
+ (file-name (string-append "px-artwork-"
+ (string-take commit 7) "-checkout"))
+ (sha256 (base32 "06i47c8qp239c9rgkcizk3jd8rld4qbx90s5gg1a1rw1x90p245z")))))
(define %px-grub-theme
- (grub-theme
- (image (file-append %px-artwork-repository
- "/grub/PantherX-4-3.svg"))))
+ (grub-theme (image (file-append %px-artwork-repository
+ "/grub/PantherX-4-3.svg"))))
(define %px-substitute-server-url
"https://packages.pantherx.org")
(define %px-substitute-server-key
(plain-file "packages.pantherx.org.pub"
- "(public-key
+ "(public-key
(ecc
(curve Ed25519)
(q #E8322D13EA02C09F06CB70FDA2ABBFD5E463F2AA34C18C692F5E25858F4E315D#)
@@ -199,50 +200,51 @@
(case (bootloader-name bootloader)
((grub grub-efi)
(bootloader-configuration
- (inherit bootloader-config)
- (theme %px-grub-theme)))
+ (inherit bootloader-config)
+ (theme %px-grub-theme)))
(else bootloader-config))))
(define (prepare-packages config default-packages)
"Check if custom packages provided in system configuration file or not.
return @code{default-packages} if there was no modifications applied."
(let ((package-list (operating-system-packages config)))
- (if (eq? package-list %base-packages)
- default-packages
- package-list)))
+ (if (eq? package-list %base-packages) default-packages package-list)))
(define (prepare-services config default-services)
"Check if custom services provided in system configuration file or not.
return @code{default-services} if there is no modification applied."
(let ((service-list (operating-system-user-services config)))
- (if (eq? service-list %base-services)
- default-services
- service-list)))
+ (if (eq? service-list %base-services) default-services service-list)))
(define (prepare-swap-devices config default-value)
"Check if custom definition provided for swap-devices or not.
return @code{defaule-value} if there is no modification applied."
(let ((devices (operating-system-swap-devices config)))
- (if (eq? devices '())
- default-value
- devices)))
+ (if (eq? devices
+ '()) default-value devices)))
(define (prepare-kernel config kernel)
(case kernel
- ((libre) linux-libre)
- ((nonlibre) linux)
+ ((libre)
+ linux-libre)
+ ((nonlibre)
+ linux)
(else (operating-system-kernel config))))
(define (prepare-initrd config kernel)
(case kernel
- ((libre) base-initrd)
- ((nonlibre) microcode-initrd)
+ ((libre)
+ base-initrd)
+ ((nonlibre)
+ microcode-initrd)
(else (operating-system-initrd config))))
(define (prepare-firmwares config kernel)
(case kernel
- ((libre) %base-firmware)
- ((nonlibre) (list linux-firmware))
+ ((libre)
+ %base-firmware)
+ ((nonlibre)
+ (list linux-firmware))
(else (operating-system-firmware config))))
;;
@@ -252,15 +254,16 @@ return @code{defaule-value} if there is no modification applied."
(define (apply-px-substitute-server guix-config)
(let ((existing-urls (guix-configuration-substitute-urls guix-config))
(existing-keys (guix-configuration-authorized-keys guix-config)))
- (guix-configuration
- (inherit guix-config)
- (substitute-urls (append (list %px-substitute-server-url)
- existing-urls))
- (authorized-keys (append (list %px-substitute-server-key)
- existing-keys)))))
-
-(define* (make-os config #:key
- (kernel 'libre)
+ (guix-configuration (inherit guix-config)
+ (substitute-urls (append (list
+ %px-substitute-server-url)
+ existing-urls))
+ (authorized-keys (append (list
+ %px-substitute-server-key)
+ existing-keys)))))
+
+(define* (make-os config
+ #:key (kernel 'libre)
(open-ports #f)
(authorized-keys '())
(templates '())
@@ -270,50 +273,57 @@ return @code{defaule-value} if there is no modification applied."
packages and services"
(define (apply-firewall-rules config)
- (nftables-configuration
- (inherit config)
- (ruleset (if open-ports
- (make-firewall-rules open-ports)
- (nftables-configuration-ruleset config)))))
+ (nftables-configuration (inherit config)
+ (ruleset (if open-ports
+ (make-firewall-rules open-ports)
+ (nftables-configuration-ruleset
+ config)))))
+
(define (apply-authorized-keys config)
(if (> (length authorized-keys) 0)
- (openssh-configuration
- (inherit config)
- (authorized-keys authorized-keys))
- config))
+ (openssh-configuration (inherit config)
+ (authorized-keys authorized-keys)) config))
+
(define (apply-swap-changes config)
(let ((devices (operating-system-swap-devices config)))
- (if (eq? devices '())
- (list (swap-space (target "/swapfile")))
- devices)))
+ (if (eq? devices
+ '())
+ (list (swap-space
+ (target "/swapfile"))) devices)))
+
(let ((target-kernel (prepare-kernel config kernel))
(target-initrd (prepare-initrd config kernel))
(target-firmwares (prepare-firmwares config kernel))
(target-bootloader (adjust-bootloader-theme config))
(target-packages (prepare-packages config default-packages))
(target-services (prepare-services config default-services)))
- (apply-templates
- (operating-system
- (inherit config)
- (bootloader target-bootloader)
- (kernel target-kernel)
- (initrd target-initrd)
- (firmware target-firmwares)
- (swap-devices (apply-swap-changes config))
-
- (packages target-packages)
- (services (fold (lambda (svc result)
- (let ((type (service-kind svc))
- (value (service-value svc)))
- (cond
- ((eq? type guix-service-type)
- (cons (service guix-service-type (apply-px-substitute-server value)) result))
- ((eq? type nftables-service-type)
- (cons (service nftables-service-type (apply-firewall-rules value)) result))
- ((eq? type openssh-service-type)
- (cons (service openssh-service-type (apply-authorized-keys value)) result))
- (else (cons svc result)))))
- '()
- target-services))
- (name-service-switch %mdns-host-lookup-nss))
- templates)))
+
+ (apply-templates (operating-system
+ (inherit config)
+ (bootloader target-bootloader)
+ (kernel target-kernel)
+ (initrd target-initrd)
+ (firmware target-firmwares)
+ (swap-devices (apply-swap-changes config))
+
+ (packages target-packages)
+ (services
+ (fold (lambda (svc result)
+ (let ((type (service-kind svc))
+ (value (service-value svc)))
+ (cond
+ ((eq? type guix-service-type)
+ (cons (service guix-service-type
+ (apply-px-substitute-server
+ value)) result))
+ ((eq? type nftables-service-type)
+ (cons (service nftables-service-type
+ (apply-firewall-rules
+ value)) result))
+ ((eq? type openssh-service-type)
+ (cons (service openssh-service-type
+ (apply-authorized-keys
+ value)) result))
+ (else (cons svc result)))))
+ '() target-services))
+ (name-service-switch %mdns-host-lookup-nss)) templates)))
diff --git a/px/system/raspberry.scm b/px/system/raspberry.scm
index f63c69c..f9b903d 100644
--- a/px/system/raspberry.scm
+++ b/px/system/raspberry.scm
@@ -38,13 +38,8 @@
%reterminal-gui-services
reterminal-gui-os))
-
(define %raspberrypi-config-params
- (list "enable_uart=1"
- "uart_2ndstage=1"
- "arm_64bit=1"
- "kernel=u-boot.bin"))
-
+ (list "enable_uart=1" "uart_2ndstage=1" "arm_64bit=1" "kernel=u-boot.bin"))
(define %raspberrypi-cmdline-params
(list "root=LABEL=RASPIROOT rw rootwait"
@@ -52,90 +47,89 @@
"selinux=0 plymouth.enable=0 smsc95xx.turbo_mode=N"
"dwc_otg.lpm_enable=0 kgdboc=serial0,115200"))
-
(define (make-raspberrypi-boot-partition config cmdline)
- (partition
- (size (* 128 (expt 2 20)))
- (label "BOOT")
- (file-system "fat32")
- (flags '())
- (initializer
- (gexp (lambda* (root #:key #:allow-other-keys)
- (use-modules (guix build utils))
- (mkdir-p root)
- (copy-recursively #$(file-append u-boot-rpi-arm64 "/libexec/u-boot.bin" )
- (string-append root "/u-boot.bin"))
- (copy-recursively #$(file-append raspberrypi-firmware "/" ) root)
- (copy-recursively #$(file-append seeed-reterminal-dtoverlays "/" )
- (string-append root "/overlays"))
- (copy-recursively #$(plain-file "config.txt"
- (string-join config "\n"))
- (string-append root "/config.txt"))
- (copy-recursively #$(plain-file "cmdline.txt"
- (string-join cmdline " "))
- (string-append root "/cmdline.txt"))
- )))))
+ (partition (size (* 128
+ (expt 2 20)))
+ (label "BOOT")
+ (file-system
+ "fat32")
+ (flags '())
+ (initializer #~(lambda* (root #:key #:allow-other-keys)
+ (use-modules (guix build utils))
+ (mkdir-p root)
+ (copy-recursively #$(file-append
+ u-boot-rpi-arm64
+ "/libexec/u-boot.bin")
+ (string-append root
+ "/u-boot.bin"))
+ (copy-recursively #$(file-append
+ raspberrypi-firmware "/")
+ root)
+ (copy-recursively #$(file-append
+ seeed-reterminal-dtoverlays
+ "/")
+ (string-append root
+ "/overlays"))
+ (copy-recursively #$(plain-file "config.txt"
+ (string-join
+ config "\n"))
+ (string-append root
+ "/config.txt"))
+ (copy-recursively #$(plain-file "cmdline.txt"
+ (string-join
+ cmdline " "))
+ (string-append root
+ "/cmdline.txt"))))))
(define %raspberrypi-boot-partition
(make-raspberrypi-boot-partition %raspberrypi-config-params
%raspberrypi-cmdline-params))
-
(define %raspberrypi-root-partition
- (partition
- (size 'guess)
- (label "RASPIROOT")
- (file-system "ext4")
- (flags '(boot))
- (initializer (gexp initialize-root-partition))))
-
+ (partition (size 'guess)
+ (label "RASPIROOT")
+ (file-system
+ "ext4")
+ (flags '(boot))
+ (initializer #~initialize-root-partition)))
(define raspberrypi-image-type
- (image-type
- (name 'raspberrypi-raw)
- (constructor (cut image-with-os
- (image-without-os
- (format 'disk-image)
- (partitions (list %raspberrypi-boot-partition
- %raspberrypi-root-partition)))
- <>))))
-
+ (image-type (name 'raspberrypi-raw)
+ (constructor (cut image-with-os
+ (image-without-os (format 'disk-image)
+ (partitions (list
+ %raspberrypi-boot-partition
+ %raspberrypi-root-partition)))
+ <>))))
(define raspberrypi-gui-os
(operating-system
(inherit px-gui-arm-os)
-
+
(bootloader (bootloader-configuration
- (bootloader u-boot-rpi-arm64-bootloader)
- (targets '("/dev/vda"))
+ (bootloader u-boot-rpi-arm64-bootloader)
+ (targets '("/dev/vda"))
(device-tree-support? #f)))
(kernel linux-raspberry-5.15)
- (kernel-arguments (cons* "cgroup_enable=memory"
- %default-kernel-arguments))
+ (kernel-arguments (cons* "cgroup_enable=memory" %default-kernel-arguments))
(initrd-modules '())
- (firmware (list raspberrypi-firmware
- brcm80211-firmware
- bluez-firmware))
+ (firmware (list raspberrypi-firmware brcm80211-firmware bluez-firmware))
(file-systems (cons* (file-system
- (device (file-system-label "BOOT"))
- (mount-point "/boot/firmware")
- (type "vfat"))
+ (device (file-system-label "BOOT"))
+ (mount-point "/boot/firmware")
+ (type "vfat"))
(file-system
- (device (file-system-label "RASPIROOT"))
- (mount-point "/")
- (type "ext4"))
- %base-file-systems))
- (services (cons* (service btuart-service-type)
- %px-gui-arm-services))))
-
+ (device (file-system-label "RASPIROOT"))
+ (mount-point "/")
+ (type "ext4")) %base-file-systems))
+ (services
+ (cons* (service btuart-service-type) %px-gui-arm-services))))
(define raspberrypi-gui-image
- (image
- (inherit
- (os+platform->image raspberrypi-gui-os aarch64-linux
- #:type raspberrypi-image-type))
- (partition-table-type 'mbr)
- (name 'raspberrypi-gui-image)))
+ (image (inherit (os+platform->image raspberrypi-gui-os aarch64-linux
+ #:type raspberrypi-image-type))
+ (partition-table-type 'mbr)
+ (name 'raspberrypi-gui-image)))
;;
;; SEEED reTerminal core configurations
@@ -152,7 +146,7 @@
"dtoverlay=reTerminal,tp_rotate=0"
"dtoverlay=reTerminal-bridge"
"dtoverlay=reTerminal,key0=0x043,key1=0x044,key2=0x057,key3=0x058"
- "vt.global_cursor_default=0"
+ "vt.global_cursor_default=0"
%raspberrypi-config-params))
(define %reterminal-cmdline-params
@@ -162,87 +156,74 @@
(make-raspberrypi-boot-partition %reterminal-config-params
%reterminal-cmdline-params))
-
(define reterminal-image-type
- (image-type
- (name 'reterminal-image-raw)
- (constructor (cut image-with-os
- (image-without-os
- (format 'disk-image)
- (partitions (list %reterminal-boot-partition
- %raspberrypi-root-partition)))
- <>))))
+ (image-type (name 'reterminal-image-raw)
+ (constructor (cut image-with-os
+ (image-without-os (format 'disk-image)
+ (partitions (list
+ %reterminal-boot-partition
+ %raspberrypi-root-partition)))
+ <>))))
(define %reterminal-core-packages
%px-core-arm-packages)
-
(define %reterminal-core-services
%px-core-arm-services)
-
(define* (reterminal-core-os #:key (open-ports %px-server-open-ports-common)
- (authorized-keys '()))
- (make-os
- (operating-system
- (host-name "reterminal-core")
- (timezone "Europe/Berlin")
- (locale "en_US.utf8")
-
- (bootloader (bootloader-configuration
- (bootloader u-boot-rpi-arm64-bootloader)
- (targets '("/dev/vda"))
- (device-tree-support? #f)))
- (initrd-modules '())
- (kernel linux-raspberry-5.15)
- (kernel-loadable-modules %reterminal-kernel-modules)
- (kernel-arguments (cons* "cgroup_enable=memory"
- %default-kernel-arguments))
- (file-systems (cons* (file-system
- (device (file-system-label "BOOT"))
- (mount-point "/boot/firmware")
- (type "vfat"))
- (file-system
- (device (file-system-label "RASPIBOOT"))
- (mount-point "/")
- (type "ext4"))
- %base-file-systems))
- (users (cons (user-account
- (name "panther")
- (comment "panther's account")
- (group "users")
- (password (crypt "pantherx" "$6$abc"))
- (supplementary-groups '("wheel"
- "audio" "video"))
- (home-directory "/home/panther"))
- %base-user-accounts))
- (name-service-switch %mdns-host-lookup-nss))
- #:kernel 'custom
- #:open-ports open-ports
- #:authorized-keys authorized-keys
- #:templates (list %raspberry-pi-4-template
- %seeed-reterminal-template)
- #:default-packages %reterminal-core-packages
- #:default-services %reterminal-core-services)
- )
+ (authorized-keys '()))
+ (make-os (operating-system
+ (host-name "reterminal-core")
+ (timezone "Europe/Berlin")
+ (locale "en_US.utf8")
+
+ (bootloader (bootloader-configuration
+ (bootloader u-boot-rpi-arm64-bootloader)
+ (targets '("/dev/vda"))
+ (device-tree-support? #f)))
+ (initrd-modules '())
+ (kernel linux-raspberry-5.15)
+ (kernel-loadable-modules %reterminal-kernel-modules)
+ (kernel-arguments (cons* "cgroup_enable=memory"
+ %default-kernel-arguments))
+ (file-systems (cons* (file-system
+ (device (file-system-label "BOOT"))
+ (mount-point "/boot/firmware")
+ (type "vfat"))
+ (file-system
+ (device (file-system-label "RASPIBOOT"))
+ (mount-point "/")
+ (type "ext4")) %base-file-systems))
+ (users (cons (user-account
+ (name "panther")
+ (comment "panther's account")
+ (group "users")
+ (password (crypt "pantherx" "$6$abc"))
+ (supplementary-groups '("wheel" "audio" "video"))
+ (home-directory "/home/panther"))
+ %base-user-accounts))
+ (name-service-switch %mdns-host-lookup-nss))
+ #:kernel 'custom
+ #:open-ports open-ports
+ #:authorized-keys authorized-keys
+ #:templates (list %raspberry-pi-4-template
+ %seeed-reterminal-template)
+ #:default-packages %reterminal-core-packages
+ #:default-services %reterminal-core-services))
(define reterminal-core-image
- (image
- (inherit
- (os+platform->image (reterminal-core-os)
- aarch64-linux
- #:type reterminal-image-type))
- (partition-table-type 'mbr)
- (name 'reterminal-core-image)))
+ (image (inherit (os+platform->image (reterminal-core-os) aarch64-linux
+ #:type reterminal-image-type))
+ (partition-table-type 'mbr)
+ (name 'reterminal-core-image)))
;;
;; SEEED reTerminal GUI configuration
;;
-
(define %reterminal-gui-packages
- (cons* seeed-reterminal-dtoverlays
- %px-gui-arm-packages))
+ (cons* seeed-reterminal-dtoverlays %px-gui-arm-packages))
(define %reterminal-gui-services
%px-gui-arm-services)
@@ -252,4 +233,5 @@
(inherit raspberrypi-gui-os)
(kernel-loadable-modules %reterminal-kernel-modules)
(packages %reterminal-gui-packages)
- (services %reterminal-gui-services)))
+ (services
+ %reterminal-gui-services)))
generated by cgit v1.2.3 (git 2.49.0) at 2025-07-05 12:42:00 +0000