From 3b5db2c77598961b0b60c901a9bbed8f0524a93f Mon Sep 17 00:00:00 2001 From: Brendan Tildesley Date: Sun, 22 Mar 2020 22:40:18 +1100 Subject: [PATCH] WRAPSCRIPT --- gnu/packages/gnome.scm | 131 ++++++++++++++++++++++++++++++++- my-wrap.scm | 162 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 292 insertions(+), 1 deletion(-) create mode 100644 my-wrap.scm diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index a08cd00d72..d614677214 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -27,7 +27,7 @@ ;;; Copyright © 2017, 2018 nee ;;; Copyright © 2017 Chris Marusich ;;; Copyright © 2017 Mohammed Sadiq -;;; Copyright © 2017 Brendan Tildesley +;;; Copyright © 2017, 2020 Brendan Tildesley ;;; Copyright © 2017, 2018 Rutger Helling ;;; Copyright © 2018 Jovany Leandro G.C ;;; Copyright © 2018 Vasile Dumitrascu @@ -158,12 +158,14 @@ #:use-module (gnu packages spice) #:use-module (gnu packages sqlite) #:use-module (gnu packages ssh) + #:use-module (gnu packages swig) #:use-module (gnu packages tex) #:use-module (gnu packages time) #:use-module (gnu packages tls) #:use-module (gnu packages version-control) #:use-module (gnu packages video) #:use-module (gnu packages virtualization) + #:use-module (gnu packages valgrind) #:use-module (gnu packages vpn) #:use-module (gnu packages web) #:use-module (gnu packages webkit) @@ -186,6 +188,10 @@ #:use-module (guix utils) #:use-module (guix gexp) #:use-module (guix monads) + #:use-module (guix) + + #:use-module (my-wrap) + #:use-module (guix store) #:use-module (ice-9 match) #:use-module (srfi srfi-1)) @@ -9956,3 +9962,126 @@ manage remote and virtual systems.") license:cc-by2.0 ;; For all others. license:lgpl2.0+)))) + + +(define-public python-evdev + (package + (name "python-evdev") + (version "1.3.0") + (source + (origin + (method url-fetch) + (uri (pypi-uri "evdev" version)) + (sha256 + (base32 + "0kb3636yaw9l8xi8s184w0r0n9ic5dw3b8hx048jf9fpzss4kimi")))) + (build-system python-build-system) + (native-inputs + `(("kernel-headers" ,linux-libre-headers))) + (arguments + `(#:tests? #f + #:phases + (modify-phases %standard-phases + (add-before 'build 'patch-patch + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "setup.py" + (("/usr/include/linux") + (string-append + (assoc-ref inputs "kernel-headers") "/include/linux"))) + #t))))) + (home-page + "https://github.com/gvalkov/python-evdev") + (synopsis + "Bindings to the Linux input handling subsystem") + (description + "Bindings to the Linux input handling subsystem") + (license license:lgpl2.1))) + +(define-public libratbag + (package + (name "libratbag") + (version "0.13") + (source (origin + (method url-fetch) + (uri + (string-append + "https://github.com/libratbag/libratbag/archive/v" version ".tar.gz")) + (file-name (string-append name "-" version ".tar.gz")) + (sha256 + (base32 + "1j8ryzrljqcp0c1wqzzpgr5fqdmwqr5z99avkxwfs7kqwm8ii9xh")))) + (build-system meson-build-system) + (native-inputs `(("pkg-config" ,pkg-config) + ("check" ,check) + ("swing" ,swig) + ("valgrind" ,valgrind))) + (inputs `(("guile" ,guile-3.0) ;;; for wrap-script + ("glib" ,glib) + ("json-glib" ,json-glib) + ("libevdev" ,libevdev) + ("udev" ,eudev) + ;("gobject-introspection" ,gobject-introspection) + ("python-pygobject" ,python-pygobject) + ("python-evdev" ,python-evdev) + ("libsystemd" ,elogind) + + )) + (arguments + `(#:imported-modules ((my-wrap) + (guix build meson-build-system) + (guix build gnu-build-system) + (guix build utils) + (guix build glib-or-gtk-build-system) + (guix build gremlin) + (guix elf)) + ;;#:modules ((wrap)) + #:configure-flags + (list "-Dsystemd=false" + "-Dlogind-provider=elogind") + #:phases + (modify-phases %standard-phases + (add-after 'install 'wrap + (lambda* (#:key inputs outputs #:allow-other-keys) + + (use-modules (my-wrap)) + + + (let* + ((out (assoc-ref outputs "out" )) + (site "/lib/python3.7/site-packages/") + (out-site (string-append (assoc-ref outputs "out" ) site)) + (evdev (string-append (assoc-ref inputs "python-evdev") site)) + (pygo (string-append (assoc-ref inputs "python-pygobject") site)) + + (python-wrap + `("PYTHONPATH" = (,out-site ,evdev ,pygo))) + + (gi-wrap ;; wraps json-glibs girepository directory. doesnt seem to matter at all?? + `("GI_TYPELIB_PATH" = (,(getenv "GI_TYPELIB_PATH"))))) + + ;; Do we even need to wrap the daemon? + ;; (wrap-program (string-append out "/bin/" "ratbagd") + ;; python-wrap ;; gi-wrap + ;; ) + ;; TODO: switch to wrap-script when it's fixed + (wrap-script** (string-append out "/bin/" "ratbagctl") + python-wrap ;; gi-wrap + ) + + #t)))))) + (home-page "https://github.com/libratbag/libratbag") + (synopsis "DBus daemon for configuring gaming mice") + (description "libratbag provides ratbagd, a DBus daemon to configure input +devices, mainly gaming mice. The daemon provides a generic way to access the +various features exposed by these mice and abstracts away hardware-specific +and kernel-specific quirks. There is also the ratbagctl command line interface +for configuring devices. + +libratbag currently supports devices from Logitech, Etekcity, GSkill, Roccat, +Steelseries. + +ratbagd can be enabled by adding the following service to your +operating-system definition: +(simple-service 'ratbagd dbus-root-service-type (list libratbag)) +") + (license license:expat))) diff --git a/my-wrap.scm b/my-wrap.scm new file mode 100644 index 0000000000..f47ea210f6 --- /dev/null +++ b/my-wrap.scm @@ -0,0 +1,162 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2013 Nikita Karetnikov +;;; Copyright © 2015, 2018 Mark H Weaver +;;; Copyright © 2018 Arun Isaac +;;; Copyright © 2018, 2019 Ricardo Wurmus +;;; +;;; 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 . + +(define-module (my-wrap) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (srfi srfi-60) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 format) + #:use-module (ice-9 threads) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (guix build utils) + #:export ( wrap-script**)) + + +;;; +;;; Guile 2.0 compatibility later. +;;; + +;; The bootstrap Guile is Guile 2.0, so provide a compatibility layer. + +(define wrap-script** + (let ((interpreter-regex + (make-regexp + (string-append "^#! ?(/[^ ]+/bin/(" + (string-join '("python[^ ]*" + "Rscript" + "perl" + "ruby" + "bash" + "sh") "|") + "))( ?.*)"))) + (coding-line-regex + (make-regexp + ".*#.*coding[=:][[:space:]]*([-a-zA-Z_0-9.]+)"))) + (lambda* (prog #:key (guile (which "guile")) #:rest vars) + "Wrap the script PROG such that VARS are set first. The format of VARS +is the same as in the WRAP-PROGRAM procedure. This procedure differs from +WRAP-PROGRAM in that it does not create a separate shell script. Instead, +PROG is modified directly by prepending a Guile script, which is interpreted +as a comment in the script's language. + +Special encoding comments as supported by Python are recreated on the second +line. + +Note that this procedure can only be used once per file as Guile scripts are +not supported." + (define update-env + (match-lambda + ((var sep '= rest) + `(setenv ,var ,(string-join rest sep))) + ((var sep 'prefix rest) + `(let ((current (getenv ,var))) + (setenv ,var (if current + (string-append ,(string-join rest sep) + ,sep current) + ,(string-join rest sep))))) + ((var sep 'suffix rest) + `(let ((current (getenv ,var))) + (setenv ,var (if current + (string-append current ,sep + ,(string-join rest sep)) + ,(string-join rest sep))))) + ((var '= rest) + `(setenv ,var ,(string-join rest ":"))) + ((var 'prefix rest) + `(let ((current (getenv ,var))) + (setenv ,var (if current + (string-append ,(string-join rest ":") + ":" current) + ,(string-join rest ":"))))) + ((var 'suffix rest) + `(let ((current (getenv ,var))) + (setenv ,var (if current + (string-append current ":" + ,(string-join rest ":")) + ,(string-join rest ":"))))))) + (let-values (((interpreter args coding-line) + (call-with-ascii-input-file prog + (lambda (p) + (let ((first-match + (false-if-exception + (regexp-exec interpreter-regex (read-line p))))) + (values (and first-match (match:substring first-match 1)) + (and first-match (match:substring first-match 3)) + (false-if-exception + (and=> (regexp-exec coding-line-regex (read-line p)) + (lambda (m) (match:substring m 0)))))))))) + (if interpreter + (let* ((header (format #f "\ +#!~a --no-auto-compile +#!#; ~a +#\\-~s +#\\-~s +" + guile + (or coding-line "Guix wrapper") + (cons 'begin (map update-env + (match vars + ((#:guile _ . vars) vars) + (_ vars)))) + `(let ((cl (command-line))) + (apply execl ,interpreter + (car cl) + (cons (car cl) + (append + ',(string-tokenize args) + cl)))))) + (template (string-append prog ".XXXXXX")) + (out (mkstemp! template)) + (st (stat prog)) + (mode (stat:mode st))) + (with-throw-handler #t + (lambda () + (call-with-ascii-input-file prog + (lambda (p) + (format out header) + (dump-port p out) + (close out) + (chmod template mode) + (rename-file template prog) + (set-file-time prog st)))) + (lambda (key . args) + (format (current-error-port) + "wrap-script: ~a: error: ~a ~s~%" + prog key args) + (false-if-exception (delete-file template)) + (raise (condition + (&wrap-error (program prog) + (type key)))) + #f))) + (raise (condition + (&wrap-error (program prog) + (type 'no-interpreter-found))))))))) + -- 2.25.1