6c9c45c97c
* nongnu/system/images/quartz64a-desktop.scm (quartz64a-desktop-raw-image): New variable.
292 lines
11 KiB
Scheme
292 lines
11 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2022 Petr Hodina <phodina@protonmail.com>
|
||
;;;
|
||
;;; 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 (nongnu system images quartz64a-desktop)
|
||
#:use-module (gnu bootloader)
|
||
#:use-module (gnu bootloader u-boot)
|
||
#:use-module (gnu image)
|
||
#:use-module (nongnu packages linux)
|
||
#:use-module (nongnu packages bootloaders)
|
||
#:use-module (gnu packages)
|
||
#:use-module (gnu packages glib)
|
||
#:use-module (gnu packages compression)
|
||
#:use-module (gnu packages certs)
|
||
#:use-module (gnu packages gnome)
|
||
#:use-module (gnu packages vim)
|
||
#:use-module (gnu packages ssh)
|
||
#:use-module (gnu packages bison)
|
||
#:use-module (gnu packages libffi)
|
||
#:use-module (gnu packages xorg)
|
||
#:use-module (gnu packages flex)
|
||
#:use-module (gnu packages pkg-config)
|
||
#:use-module (gnu packages python)
|
||
#:use-module (guix platforms arm)
|
||
#:use-module (guix download)
|
||
#:use-module (guix packages)
|
||
#:use-module (guix gexp)
|
||
#:use-module (guix utils)
|
||
#:use-module (guix build utils)
|
||
#:use-module ((guix licenses) #:prefix license:)
|
||
#:use-module (guix build emacs-build-system)
|
||
#:use-module (guix build-system gnu)
|
||
#:use-module (guix build-system meson)
|
||
#:use-module (gnu services)
|
||
#:use-module (gnu services desktop)
|
||
#:use-module (gnu services sddm)
|
||
#:use-module (gnu services ssh)
|
||
#:use-module (gnu services xorg)
|
||
#:use-module (gnu services base)
|
||
#:use-module (gnu system)
|
||
#:use-module (gnu system accounts)
|
||
#:use-module (gnu system file-systems)
|
||
#:use-module (gnu system image)
|
||
#:use-module (gnu system keyboard)
|
||
#:use-module (gnu system nss)
|
||
#:use-module (gnu system shadow)
|
||
#:use-module (srfi srfi-26)
|
||
#:use-module (srfi srfi-1) ;for the remove function
|
||
#:export (quartz64-a-raw-image
|
||
quartz64-image-type
|
||
quartz64-desktop-raw-image))
|
||
|
||
(define (python-extension-suffix python triplet)
|
||
"Determine the suffix for C extensions for PYTHON when compiled
|
||
for TRIPLET."
|
||
;; python uses strings like 'x86_64-linux-gnu' instead of
|
||
;; 'x86_64-unknown-linux-gnu'.
|
||
(define normalised-system
|
||
(string-replace-substring triplet "-unknown-" "-"))
|
||
(define major.minor (version-major+minor (package-version python)))
|
||
(define majorminor (string-delete #\. major.minor))
|
||
(string-append
|
||
;; If guix' python package used "--with-pydebug", a #\d would
|
||
;; need to be added, likewise "--with-pymalloc" and "--with-wide-unicode"
|
||
;; would require a #\m and #\u, see cpython's configure.ac.
|
||
".cpython-" majorminor "-" normalised-system
|
||
(if (target-mingw? triplet)
|
||
".dll"
|
||
".so")))
|
||
|
||
(define (correct-library-name-phase python name)
|
||
"Return a G-exp evaluating to a phase renaming the python extension NAME
|
||
from what Meson thinks its name should be to what python expects its name
|
||
to be. NAME must not include the platform-specific suffix. This can only
|
||
be used when cross-compiling."
|
||
#~(lambda _
|
||
(define name #$name)
|
||
(define native-suffix
|
||
#$(python-extension-suffix python
|
||
(nix-system->gnu-triplet (%current-system))))
|
||
(define target-suffix
|
||
#$(python-extension-suffix python (%current-target-system)))
|
||
(define native-name
|
||
(string-append name native-suffix))
|
||
(define target-name
|
||
(string-append name target-suffix))
|
||
(rename-file native-name target-name)))
|
||
|
||
(define gobject-introspection
|
||
(package
|
||
(name "gobject-introspection")
|
||
(version "1.66.1")
|
||
(source (origin
|
||
(method url-fetch)
|
||
(uri (string-append "mirror://gnome/sources/"
|
||
"gobject-introspection/" (version-major+minor version)
|
||
"/gobject-introspection-" version ".tar.xz"))
|
||
(sha256
|
||
(base32 "078n0q7b6z682mf4irclrksm73cyixq295mqnqifl9plwmgaai6x"))
|
||
(patches (search-patches
|
||
"gobject-introspection-cc.patch"
|
||
"gobject-introspection-girepository.patch"
|
||
"gobject-introspection-absolute-shlib-path.patch"))))
|
||
(build-system meson-build-system)
|
||
(arguments
|
||
`(,@(if (%current-target-system)
|
||
`(#:configure-flags
|
||
'("-Dgi_cross_use_prebuilt_gi=true"
|
||
;; Building introspection data requires running binaries
|
||
;; for ‘host’ on ‘build’, so don't do that.
|
||
;;
|
||
;; TODO: it would be nice to have introspection data anyways
|
||
;; as discussed here: https://issues.guix.gnu.org/50201#60.
|
||
"-Dbuild_introspection_data=false"))
|
||
'())
|
||
#:phases
|
||
,#~
|
||
(modify-phases %standard-phases
|
||
#$@(if (%current-target-system)
|
||
;; 'typelibs' is undefined.
|
||
`((add-after 'unpack 'set-typelibs
|
||
(lambda _
|
||
(substitute* "meson.build"
|
||
; (("python3") "python")
|
||
(("\\bsources: typelibs\\b")
|
||
"sources: []")))))
|
||
'())
|
||
(add-after 'unpack 'do-not-use-/usr/bin/env
|
||
(lambda _
|
||
(substitute* "tools/g-ir-tool-template.in"
|
||
(("#!@PYTHON_CMD@")
|
||
(string-append "#!" #$(this-package-input "python")
|
||
"/bin/python3")))))
|
||
#$@(if (%current-target-system)
|
||
;; Meson gives python extensions an incorrect name, see
|
||
;; <https://github.com/mesonbuild/meson/issues/7049>.
|
||
#~((add-after 'install 'rename-library
|
||
#$(correct-library-name-phase
|
||
(this-package-input "python")
|
||
#~(string-append #$output
|
||
"/lib/gobject-introspection/giscanner"
|
||
"/_giscanner"))))
|
||
#~()))))
|
||
(native-inputs
|
||
(list `(,glib "bin")
|
||
pkg-config
|
||
bison
|
||
flex))
|
||
(inputs
|
||
(list ;,@(if (%current-target-system)
|
||
python
|
||
bison
|
||
flex
|
||
zlib))
|
||
(propagated-inputs
|
||
(list glib
|
||
;; In practice, GIR users will need libffi when using
|
||
;; gobject-introspection.
|
||
libffi))
|
||
(native-search-paths
|
||
(list
|
||
(search-path-specification
|
||
(variable "GI_TYPELIB_PATH")
|
||
(files '("lib/girepository-1.0")))))
|
||
(search-paths native-search-paths)
|
||
(synopsis "GObject introspection tools and libraries")
|
||
(description "GObject introspection is a middleware layer between
|
||
C libraries (using GObject) and language bindings. The C library can be scanned
|
||
at compile time and generate metadata files, in addition to the actual native
|
||
C library. Then language bindings can read this metadata and automatically
|
||
provide bindings to call into the C library.")
|
||
(home-page "https://wiki.gnome.org/Projects/GObjectIntrospection")
|
||
(license
|
||
(list
|
||
;; For library.
|
||
license:lgpl2.0+
|
||
;; For tools.
|
||
license:gpl2+))))
|
||
;; Fails to cross-compile - rewrite using gexp
|
||
(define-public slock
|
||
(package
|
||
(name "slock")
|
||
(version "1.4")
|
||
(source (origin
|
||
(method url-fetch)
|
||
(uri (string-append "https://dl.suckless.org/tools/slock-"
|
||
version ".tar.gz"))
|
||
(sha256
|
||
(base32
|
||
"0sif752303dg33f14k6pgwq2jp1hjyhqv6x4sy3sj281qvdljf5m"))))
|
||
(build-system gnu-build-system)
|
||
(arguments
|
||
(list #:tests? #f ; no tests
|
||
#:make-flags
|
||
#~(list (string-append "CC=" #$(cc-for-target))
|
||
(string-append "PREFIX=" #$output))
|
||
#:phases #~(modify-phases %standard-phases (delete 'configure))))
|
||
(inputs
|
||
(list libx11 libxext libxinerama libxrandr))
|
||
(home-page "https://tools.suckless.org/slock/")
|
||
(synopsis "Simple X session lock")
|
||
(description
|
||
"Simple X session lock with trivial feedback on password entry.")
|
||
(license license:x11)))
|
||
|
||
(define quartz64a-desktop-os
|
||
(operating-system
|
||
(host-name "quartz64a")
|
||
(timezone "Europe/Prague")
|
||
(locale "en_US.utf8")
|
||
|
||
(bootloader (bootloader-configuration
|
||
(bootloader u-boot-quartz64a-rk3566-bootloader)
|
||
(targets '("/dev/vda"))))
|
||
(initrd-modules '())
|
||
(kernel linux-quartz64)
|
||
(file-systems (append (list
|
||
(file-system
|
||
(device (file-system-label "EFI"))
|
||
(mount-point "/boot/efi")
|
||
(type "vfat"))
|
||
(file-system
|
||
(device (file-system-label "root"))
|
||
(mount-point "/")
|
||
(type "ext4")))
|
||
%base-file-systems))
|
||
|
||
(swap-devices (list (swap-space
|
||
(target "/run/swapfile"))))
|
||
|
||
(users (cons* (user-account
|
||
(name "pine")
|
||
(group "users")
|
||
(supplementary-groups '("wheel" "netdev" "audio" "video"))
|
||
(password (crypt "quartz64" "$6$abc"))
|
||
(home-directory "/home/pine"))
|
||
%base-user-accounts))
|
||
|
||
;; Add GNOME desktop
|
||
(services
|
||
(append (list (service mate-desktop-service-type)
|
||
(service xfce-desktop-service-type)
|
||
(service openssh-service-type)
|
||
(service agetty-service-type
|
||
(agetty-configuration
|
||
(extra-options '("-L")) ; no carrier detect
|
||
(baud-rate "1500000")
|
||
(term "vt100")
|
||
(tty "ttyS2"))))
|
||
%desktop-services))
|
||
|
||
(packages (cons* nss-certs
|
||
openssh
|
||
gvfs
|
||
%base-packages))
|
||
|
||
(name-service-switch %mdns-host-lookup-nss)))
|
||
|
||
(define quartz64-image-type
|
||
(image-type
|
||
(name 'quartz-raw)
|
||
(constructor (lambda (os)
|
||
(image
|
||
(inherit
|
||
(raw-with-offset-disk-image (* 32 (expt 2 20)))) ; 32MiB
|
||
(operating-system os)
|
||
(platform aarch64-linux))))))
|
||
|
||
(define quartz64-desktop-raw-image
|
||
(image
|
||
(inherit
|
||
(os+platform->image quartz64a-desktop-os aarch64-linux
|
||
#:type quartz64-image-type))
|
||
(name 'quartz-desktop-raw-image)))
|
||
|
||
;; Return the default image.
|
||
quartz64-desktop-raw-image
|