Merge branch 'master' into staging
This commit is contained in:
		
						commit
						622545de6c
					
				
					 59 changed files with 1748 additions and 1412 deletions
				
			
		| 
						 | 
				
			
			@ -96,10 +96,9 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
 | 
			
		|||
Copyright @copyright{} 2021 Hui Lu@*
 | 
			
		||||
Copyright @copyright{} 2021 pukkamustard@*
 | 
			
		||||
Copyright @copyright{} 2021 Alice Brenon@*
 | 
			
		||||
Copyright @copyright{} 2021 Josselin Poiret@*
 | 
			
		||||
Copyright @copyright{} 2021, 2022 Josselin Poiret@*
 | 
			
		||||
Copyright @copyright{} 2021 Andrew Tropin@*
 | 
			
		||||
Copyright @copyright{} 2021 Sarah Morgensen@*
 | 
			
		||||
Copyright @copyright{} 2021 Josselin Poiret@*
 | 
			
		||||
Copyright @copyright{} 2022 Remco van 't Veer@*
 | 
			
		||||
Copyright @copyright{} 2022 Aleksandr Vityazev@*
 | 
			
		||||
Copyright @copyright{} 2022 Philip M@sup{c}Grath@*
 | 
			
		||||
| 
						 | 
				
			
			@ -339,7 +338,7 @@ System Configuration
 | 
			
		|||
* Keyboard Layout::             How the system interprets key strokes.
 | 
			
		||||
* Locales::                     Language and cultural convention settings.
 | 
			
		||||
* Services::                    Specifying system services.
 | 
			
		||||
* Setuid Programs::             Programs running with root privileges.
 | 
			
		||||
* Setuid Programs::             Programs running with elevated privileges.
 | 
			
		||||
* X.509 Certificates::          Authenticating HTTPS servers.
 | 
			
		||||
* Name Service Switch::         Configuring libc's name service switch.
 | 
			
		||||
* Initial RAM Disk::            Linux-Libre bootstrapping.
 | 
			
		||||
| 
						 | 
				
			
			@ -15414,7 +15413,7 @@ instance to support new system services.
 | 
			
		|||
* Keyboard Layout::             How the system interprets key strokes.
 | 
			
		||||
* Locales::                     Language and cultural convention settings.
 | 
			
		||||
* Services::                    Specifying system services.
 | 
			
		||||
* Setuid Programs::             Programs running with root privileges.
 | 
			
		||||
* Setuid Programs::             Programs running with elevated privileges.
 | 
			
		||||
* X.509 Certificates::          Authenticating HTTPS servers.
 | 
			
		||||
* Name Service Switch::         Configuring libc's name service switch.
 | 
			
		||||
* Initial RAM Disk::            Linux-Libre bootstrapping.
 | 
			
		||||
| 
						 | 
				
			
			@ -25543,10 +25542,10 @@ The complete set of available configuration options is detailed below.
 | 
			
		|||
Available @code{jami-configuration} fields are:
 | 
			
		||||
 | 
			
		||||
@table @asis
 | 
			
		||||
@item @code{jamid} (default: @code{libjami}) (type: package)
 | 
			
		||||
@item @code{libjami} (default: @code{libjami}) (type: package)
 | 
			
		||||
The Jami daemon package to use.
 | 
			
		||||
 | 
			
		||||
@item @code{dbus} (default: @code{dbus}) (type: package)
 | 
			
		||||
@item @code{dbus} (default: @code{dbus-for-jami}) (type: package)
 | 
			
		||||
The D-Bus package to use to start the required D-Bus session.
 | 
			
		||||
 | 
			
		||||
@item @code{nss-certs} (default: @code{nss-certs}) (type: package)
 | 
			
		||||
| 
						 | 
				
			
			@ -35202,11 +35201,11 @@ that compression will be 2:1, it is possible that uncompressable data
 | 
			
		|||
can be written to swap and this is a method to limit how much memory can
 | 
			
		||||
be used.  It accepts a string and can be a number of bytes or use a
 | 
			
		||||
suffix, eg.: @code{"2G"}.
 | 
			
		||||
@item @code{priority} (default @code{-1})
 | 
			
		||||
@item @code{priority} (default @code{#f})
 | 
			
		||||
This is the priority of the swap device created from the zram device.
 | 
			
		||||
@code{swapon} accepts values between -1 and 32767, with higher values
 | 
			
		||||
indicating higher priority.  Higher priority swap will generally be used
 | 
			
		||||
first.
 | 
			
		||||
@xref{Swap Space} for a description of swap priorities.  You might want
 | 
			
		||||
to set a specific priority for the zram device, otherwise it could end
 | 
			
		||||
up not being used much for the reasons described there.
 | 
			
		||||
@end table
 | 
			
		||||
 | 
			
		||||
@end deftp
 | 
			
		||||
| 
						 | 
				
			
			@ -35755,22 +35754,23 @@ Extra command line options for @code{nix-service-type}.
 | 
			
		|||
@section Setuid Programs
 | 
			
		||||
 | 
			
		||||
@cindex setuid programs
 | 
			
		||||
Some programs need to run with ``root'' privileges, even when they are
 | 
			
		||||
@cindex setgid programs
 | 
			
		||||
Some programs need to run with elevated privileges, even when they are
 | 
			
		||||
launched by unprivileged users.  A notorious example is the
 | 
			
		||||
@command{passwd} program, which users can run to change their
 | 
			
		||||
password, and which needs to access the @file{/etc/passwd} and
 | 
			
		||||
@file{/etc/shadow} files---something normally restricted to root, for
 | 
			
		||||
obvious security reasons.  To address that, these executables are
 | 
			
		||||
@dfn{setuid-root}, meaning that they always run with root privileges
 | 
			
		||||
obvious security reasons.  To address that, @command{passwd} should be
 | 
			
		||||
@dfn{setuid-root}, meaning that it always runs with root privileges
 | 
			
		||||
(@pxref{How Change Persona,,, libc, The GNU C Library Reference Manual},
 | 
			
		||||
for more info about the setuid mechanism).
 | 
			
		||||
 | 
			
		||||
The store itself @emph{cannot} contain setuid programs: that would be a
 | 
			
		||||
security issue since any user on the system can write derivations that
 | 
			
		||||
populate the store (@pxref{The Store}).  Thus, a different mechanism is
 | 
			
		||||
used: instead of changing the setuid bit directly on files that are in
 | 
			
		||||
the store, we let the system administrator @emph{declare} which programs
 | 
			
		||||
should be setuid root.
 | 
			
		||||
used: instead of changing the setuid or setgid bits directly on files that
 | 
			
		||||
are in the store, we let the system administrator @emph{declare} which
 | 
			
		||||
programs should be entrusted with these additional privileges.
 | 
			
		||||
 | 
			
		||||
The @code{setuid-programs} field of an @code{operating-system}
 | 
			
		||||
declaration contains a list of @code{<setuid-program>} denoting the
 | 
			
		||||
| 
						 | 
				
			
			@ -38000,7 +38000,7 @@ pointing to the given file.
 | 
			
		|||
@defvr {Scheme Variable} setuid-program-service-type
 | 
			
		||||
Type for the ``setuid-program service''.  This service collects lists of
 | 
			
		||||
executable file names, passed as gexps, and adds them to the set of
 | 
			
		||||
setuid-root programs on the system (@pxref{Setuid Programs}).
 | 
			
		||||
setuid and setgid programs on the system (@pxref{Setuid Programs}).
 | 
			
		||||
@end defvr
 | 
			
		||||
 | 
			
		||||
@defvr {Scheme Variable} profile-service-type
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -13,12 +13,13 @@
 | 
			
		|||
   (service home-bash-service-type
 | 
			
		||||
            (home-bash-configuration
 | 
			
		||||
             (guix-defaults? #t)
 | 
			
		||||
             (bash-profile '("\
 | 
			
		||||
export HISTFILE=$XDG_CACHE_HOME/.bash_history"))))
 | 
			
		||||
             (bash-profile (list (plain-file "bash-profile" "\
 | 
			
		||||
export HISTFILE=$XDG_CACHE_HOME/.bash_history")))))
 | 
			
		||||
 | 
			
		||||
   (simple-service 'test-config
 | 
			
		||||
                   home-files-service-type
 | 
			
		||||
                   (list `("config/test.conf"
 | 
			
		||||
                   home-xdg-configuration-files-service-type
 | 
			
		||||
                   (list `("test.conf"
 | 
			
		||||
                           ,(plain-file "tmp-file.txt"
 | 
			
		||||
                                        "the content of ~/.config/test.conf")))))))
 | 
			
		||||
                                        "the content of
 | 
			
		||||
                                          ~/.config/test.conf")))))))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										213
									
								
								gnu/build/dbus-service.scm
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										213
									
								
								gnu/build/dbus-service.scm
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -0,0 +1,213 @@
 | 
			
		|||
;;; GNU Guix --- Functional package management for GNU
 | 
			
		||||
;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.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/>.
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
;;;
 | 
			
		||||
;;; This module contains procedures to interact with D-Bus via the 'dbus-send'
 | 
			
		||||
;;; command line utility.  Before using any public procedure
 | 
			
		||||
;;;
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(define-module (gnu build dbus-service)
 | 
			
		||||
  #:use-module (ice-9 match)
 | 
			
		||||
  #:use-module (srfi srfi-1)
 | 
			
		||||
  #:use-module (srfi srfi-19)
 | 
			
		||||
  #:use-module (srfi srfi-26)
 | 
			
		||||
  #:autoload (d-bus protocol connections) (d-bus-conn?
 | 
			
		||||
                                           d-bus-conn-flush
 | 
			
		||||
                                           d-bus-connect
 | 
			
		||||
                                           d-bus-disconnect
 | 
			
		||||
                                           d-bus-session-bus-address
 | 
			
		||||
                                           d-bus-system-bus-address)
 | 
			
		||||
  #:autoload (d-bus protocol messages) (MESSAGE_TYPE_METHOD_CALL
 | 
			
		||||
                                        d-bus-headers-ref
 | 
			
		||||
                                        d-bus-message-body
 | 
			
		||||
                                        d-bus-message-headers
 | 
			
		||||
                                        d-bus-read-message
 | 
			
		||||
                                        d-bus-write-message
 | 
			
		||||
                                        header-PATH
 | 
			
		||||
                                        header-DESTINATION
 | 
			
		||||
                                        header-INTERFACE
 | 
			
		||||
                                        header-MEMBER
 | 
			
		||||
                                        header-SIGNATURE
 | 
			
		||||
                                        make-d-bus-message)
 | 
			
		||||
  #:export (%dbus-query-timeout
 | 
			
		||||
 | 
			
		||||
            initialize-dbus-connection!
 | 
			
		||||
            %current-dbus-connection
 | 
			
		||||
            send-dbus
 | 
			
		||||
            call-dbus-method
 | 
			
		||||
 | 
			
		||||
            dbus-available-services
 | 
			
		||||
            dbus-service-available?
 | 
			
		||||
 | 
			
		||||
            with-retries))
 | 
			
		||||
 | 
			
		||||
(define %dbus-query-timeout 2)          ;in seconds
 | 
			
		||||
 | 
			
		||||
;;; Use Fibers' sleep to enable cooperative scheduling in Shepherd >= 0.9.0,
 | 
			
		||||
;;; which is required at least for the Jami service.
 | 
			
		||||
(define sleep*
 | 
			
		||||
  (lambda ()                            ;delay execution
 | 
			
		||||
    (if (resolve-module '(fibers) #f)
 | 
			
		||||
        (module-ref (resolve-interface '(fibers)) 'sleep)
 | 
			
		||||
        (begin
 | 
			
		||||
          (format #f "fibers not available -- blocking 'sleep' in use")
 | 
			
		||||
          sleep))))
 | 
			
		||||
 | 
			
		||||
;;;
 | 
			
		||||
;;; Utilities.
 | 
			
		||||
;;;
 | 
			
		||||
 | 
			
		||||
(define-syntax-rule (with-retries n delay body ...)
 | 
			
		||||
  "Retry the code in BODY up to N times until it doesn't raise an exception nor
 | 
			
		||||
return #f, else raise an error.  A delay of DELAY seconds is inserted before
 | 
			
		||||
each retry."
 | 
			
		||||
  (let loop ((attempts 0))
 | 
			
		||||
    (catch #t
 | 
			
		||||
      (lambda ()
 | 
			
		||||
        (let ((result (begin body ...)))
 | 
			
		||||
          (if (not result)
 | 
			
		||||
              (error "failed attempt" attempts)
 | 
			
		||||
              result)))
 | 
			
		||||
      (lambda args
 | 
			
		||||
        (if (< attempts n)
 | 
			
		||||
            (begin
 | 
			
		||||
              ((sleep*) delay)            ;else wait and retry
 | 
			
		||||
              (loop (+ 1 attempts)))
 | 
			
		||||
            (error "maximum number of retry attempts reached"
 | 
			
		||||
                   body ... args))))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;;
 | 
			
		||||
;;; Low level wrappers above AC/D-Bus.
 | 
			
		||||
;;;
 | 
			
		||||
 | 
			
		||||
;; The active D-Bus connection (a parameter) used by the other procedures.
 | 
			
		||||
(define %current-dbus-connection (make-parameter #f))
 | 
			
		||||
 | 
			
		||||
(define* (initialize-dbus-connection!
 | 
			
		||||
          #:key (address (or (d-bus-session-bus-address)
 | 
			
		||||
                             (d-bus-system-bus-address))))
 | 
			
		||||
  "Initialize the D-Bus connection.  ADDRESS should be the address of the D-Bus
 | 
			
		||||
session, e.g. \"unix:path=/var/run/dbus/system_bus_socket\", the default value
 | 
			
		||||
if ADDRESS is not provided and DBUS_SESSION_BUS_ADDRESS is not set.  Return
 | 
			
		||||
the initialized D-Bus connection."
 | 
			
		||||
  ;; Clear current correction if already active.
 | 
			
		||||
  (when (d-bus-conn? (%current-dbus-connection))
 | 
			
		||||
    (d-bus-disconnect (%current-dbus-connection)))
 | 
			
		||||
 | 
			
		||||
  (let ((connection (d-bus-connect address)))
 | 
			
		||||
    (%current-dbus-connection connection) ;update connection parameter
 | 
			
		||||
    (call-dbus-method "Hello"))           ;initial handshake
 | 
			
		||||
 | 
			
		||||
  (%current-dbus-connection))
 | 
			
		||||
 | 
			
		||||
(define* (send-dbus message #:key
 | 
			
		||||
                    (connection (%current-dbus-connection))
 | 
			
		||||
                    timeout)
 | 
			
		||||
  "Send a D-Bus MESSAGE to CONNECTION and return the body of its reply.  Up to
 | 
			
		||||
READ-RETRIES replies are read until a matching reply is found, else an error
 | 
			
		||||
is raised.  MESSAGE is to be constructed with `make-d-bus-message'.  When the
 | 
			
		||||
body contains a single element, it is returned directly, else the body
 | 
			
		||||
elements are returned as a list.  TIMEOUT is a timeout value in seconds."
 | 
			
		||||
  (let ((serial     (d-bus-write-message connection message))
 | 
			
		||||
        (start-time (current-time time-monotonic))
 | 
			
		||||
        (timeout* (or timeout %dbus-query-timeout)))
 | 
			
		||||
    (d-bus-conn-flush connection)
 | 
			
		||||
    (let retry ()
 | 
			
		||||
      (when (> (time-second (time-difference (current-time time-monotonic)
 | 
			
		||||
                                             start-time))
 | 
			
		||||
               timeout*)
 | 
			
		||||
        (error 'dbus "fail to get reply in timeout" timeout*))
 | 
			
		||||
      (let* ((reply (d-bus-read-message connection))
 | 
			
		||||
             (reply-headers (d-bus-message-headers reply))
 | 
			
		||||
             (reply-serial (d-bus-headers-ref reply-headers 'REPLY_SERIAL))
 | 
			
		||||
             (error-name (d-bus-headers-ref reply-headers 'ERROR_NAME))
 | 
			
		||||
             (body (d-bus-message-body reply)))
 | 
			
		||||
        ;; Validate the reply matches the message.
 | 
			
		||||
        (when error-name
 | 
			
		||||
          (error 'dbus "method failed with error" error-name body))
 | 
			
		||||
        ;; Some replies do not include a serial header, such as the for the
 | 
			
		||||
        ;; org.freedesktop.DBus NameAcquired one.
 | 
			
		||||
        (if (and reply-serial (= serial reply-serial))
 | 
			
		||||
            (match body
 | 
			
		||||
              ((x x* ..1)               ;contains 2 ore more elements
 | 
			
		||||
               body)
 | 
			
		||||
              ((x)
 | 
			
		||||
               x)                       ;single element; return it directly
 | 
			
		||||
              (#f #f))
 | 
			
		||||
            (retry))))))
 | 
			
		||||
 | 
			
		||||
(define (argument->signature-type argument)
 | 
			
		||||
  "Infer the D-Bus signature type from ARGUMENT."
 | 
			
		||||
  ;; XXX: avoid ..1 when using vectors due to a bug (?) in (ice-9 match).
 | 
			
		||||
  (match argument
 | 
			
		||||
    ((? boolean?) "b")
 | 
			
		||||
    ((? string?) "s")
 | 
			
		||||
    (#((? string?) (? string?) ...) "as")
 | 
			
		||||
    (#(((? string?) . (? string?))
 | 
			
		||||
       ((? string?) . (? string?)) ...) "a{ss}")
 | 
			
		||||
    (_ (error 'dbus "no rule to infer type from argument" argument))))
 | 
			
		||||
 | 
			
		||||
(define* (call-dbus-method method
 | 
			
		||||
                           #:key
 | 
			
		||||
                           (path "/org/freedesktop/DBus")
 | 
			
		||||
                           (destination "org.freedesktop.DBus")
 | 
			
		||||
                           (interface "org.freedesktop.DBus")
 | 
			
		||||
                           (connection (%current-dbus-connection))
 | 
			
		||||
                           arguments
 | 
			
		||||
                           timeout)
 | 
			
		||||
  "Call the D-Bus method specified by METHOD, PATH, DESTINATION and INTERFACE.
 | 
			
		||||
The currently active D-Bus CONNECTION is used unless explicitly provided.
 | 
			
		||||
Method arguments may be provided via ARGUMENTS sent as the message body.
 | 
			
		||||
TIMEOUT limit the maximum time to allow for the reply.  Return the body of the
 | 
			
		||||
reply."
 | 
			
		||||
  (let ((message (make-d-bus-message
 | 
			
		||||
                  MESSAGE_TYPE_METHOD_CALL 0 #f '()
 | 
			
		||||
                  `#(,(header-PATH        path)
 | 
			
		||||
                     ,(header-DESTINATION destination)
 | 
			
		||||
                     ,(header-INTERFACE   interface)
 | 
			
		||||
                     ,(header-MEMBER      method)
 | 
			
		||||
                     ,@(if arguments
 | 
			
		||||
                           (list (header-SIGNATURE
 | 
			
		||||
                                  (string-join
 | 
			
		||||
                                   (map argument->signature-type arguments)
 | 
			
		||||
                                   "")))
 | 
			
		||||
                           '()))
 | 
			
		||||
                  arguments)))
 | 
			
		||||
    (send-dbus message #:connection connection #:timeout timeout)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;;
 | 
			
		||||
;;; Higher-level, D-Bus procedures.
 | 
			
		||||
;;;
 | 
			
		||||
 | 
			
		||||
(define (dbus-available-services)
 | 
			
		||||
  "Return the list of available (acquired) D-Bus services."
 | 
			
		||||
  (let ((names (vector->list (call-dbus-method "ListNames"))))
 | 
			
		||||
    ;; Remove entries such as ":1.7".
 | 
			
		||||
    (remove (cut string-prefix? ":" <>) names)))
 | 
			
		||||
 | 
			
		||||
(define (dbus-service-available? service)
 | 
			
		||||
  "Predicate to check for the D-Bus SERVICE availability."
 | 
			
		||||
  (member service (dbus-available-services)))
 | 
			
		||||
 | 
			
		||||
;; Local Variables:
 | 
			
		||||
;; eval: (put 'with-retries 'scheme-indent-function 2)
 | 
			
		||||
;; End:
 | 
			
		||||
| 
						 | 
				
			
			@ -1,5 +1,5 @@
 | 
			
		|||
;;; GNU Guix --- Functional package management for GNU
 | 
			
		||||
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 | 
			
		||||
;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 | 
			
		||||
;;;
 | 
			
		||||
;;; This file is part of GNU Guix.
 | 
			
		||||
;;;
 | 
			
		||||
| 
						 | 
				
			
			@ -24,16 +24,16 @@
 | 
			
		|||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(define-module (gnu build jami-service)
 | 
			
		||||
  #:use-module (gnu build dbus-service)
 | 
			
		||||
  #:use-module (ice-9 format)
 | 
			
		||||
  #:use-module (ice-9 match)
 | 
			
		||||
  #:use-module (ice-9 peg)
 | 
			
		||||
  #:use-module (ice-9 rdelim)
 | 
			
		||||
  #:use-module (ice-9 regex)
 | 
			
		||||
  #:use-module (rnrs io ports)
 | 
			
		||||
  #:autoload (shepherd service) (fork+exec-command)
 | 
			
		||||
  #:use-module (srfi srfi-1)
 | 
			
		||||
  #:use-module (srfi srfi-26)
 | 
			
		||||
  #:export (account-fingerprint?
 | 
			
		||||
  #:export (jami-service-available?
 | 
			
		||||
 | 
			
		||||
            account-fingerprint?
 | 
			
		||||
            account-details->recutil
 | 
			
		||||
            get-accounts
 | 
			
		||||
            get-usernames
 | 
			
		||||
| 
						 | 
				
			
			@ -51,43 +51,12 @@
 | 
			
		|||
            set-all-moderators
 | 
			
		||||
            set-moderator
 | 
			
		||||
            username->all-moderators?
 | 
			
		||||
            username->moderators
 | 
			
		||||
 | 
			
		||||
            dbus-available-services
 | 
			
		||||
            dbus-service-available?
 | 
			
		||||
 | 
			
		||||
            %send-dbus-binary
 | 
			
		||||
            %send-dbus-bus
 | 
			
		||||
            %send-dbus-user
 | 
			
		||||
            %send-dbus-group
 | 
			
		||||
            %send-dbus-debug
 | 
			
		||||
            send-dbus
 | 
			
		||||
 | 
			
		||||
            with-retries))
 | 
			
		||||
            username->moderators))
 | 
			
		||||
 | 
			
		||||
;;;
 | 
			
		||||
;;; Utilities.
 | 
			
		||||
;;;
 | 
			
		||||
 | 
			
		||||
(define-syntax-rule (with-retries n delay body ...)
 | 
			
		||||
  "Retry the code in BODY up to N times until it doesn't raise an exception
 | 
			
		||||
nor return #f, else raise an error.  A delay of DELAY seconds is inserted
 | 
			
		||||
before each retry."
 | 
			
		||||
  (let loop ((attempts 0))
 | 
			
		||||
    (catch #t
 | 
			
		||||
      (lambda ()
 | 
			
		||||
        (let ((result (begin body ...)))
 | 
			
		||||
          (if (not result)
 | 
			
		||||
              (error "failed attempt" attempts)
 | 
			
		||||
              result)))
 | 
			
		||||
      (lambda args
 | 
			
		||||
        (if (< attempts n)
 | 
			
		||||
            (begin
 | 
			
		||||
              (sleep delay)             ;else wait and retry
 | 
			
		||||
              (loop (+ 1 attempts)))
 | 
			
		||||
            (error "maximum number of retry attempts reached"
 | 
			
		||||
                   body ... args))))))
 | 
			
		||||
 | 
			
		||||
(define (alist->list alist)
 | 
			
		||||
  "Flatten ALIST into a list."
 | 
			
		||||
  (append-map (match-lambda
 | 
			
		||||
| 
						 | 
				
			
			@ -104,212 +73,34 @@ hexadecimal characters."
 | 
			
		|||
  (and (string? val)
 | 
			
		||||
       (regexp-exec account-fingerprint-rx val)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;;
 | 
			
		||||
;;; D-Bus reply parser.
 | 
			
		||||
;;;
 | 
			
		||||
 | 
			
		||||
(define (parse-dbus-reply reply)
 | 
			
		||||
  "Return the parse tree of REPLY, a string returned by the 'dbus-send'
 | 
			
		||||
command."
 | 
			
		||||
  ;; Refer to 'man 1 dbus-send' for the grammar reference.  Note that the
 | 
			
		||||
  ;; format of the replies doesn't match the format of the input, which is the
 | 
			
		||||
  ;; one documented, but it gives an idea.  For an even better reference, see
 | 
			
		||||
  ;; the `print_iter' procedure of the 'dbus-print-message.c' file from the
 | 
			
		||||
  ;; 'dbus' package sources.
 | 
			
		||||
  (define-peg-string-patterns
 | 
			
		||||
    "contents <- header (item / container (item / container*)?)
 | 
			
		||||
     item <-- WS type WS value NL
 | 
			
		||||
     container <- array / dict / variant
 | 
			
		||||
     array <-- array-start (item / container)* array-end
 | 
			
		||||
     dict <-- array-start dict-entry* array-end
 | 
			
		||||
     dict-entry <-- dict-entry-start item item dict-entry-end
 | 
			
		||||
     variant <-- variant-start item
 | 
			
		||||
     type <-- 'string' / 'int16' / 'uint16' / 'int32' / 'uint32' / 'int64' /
 | 
			
		||||
              'uint64' / 'double' / 'byte' / 'boolean' / 'objpath'
 | 
			
		||||
     value <-- (!NL .)* NL
 | 
			
		||||
     header < (!NL .)* NL
 | 
			
		||||
     variant-start < WS 'variant'
 | 
			
		||||
     array-start < WS 'array [' NL
 | 
			
		||||
     array-end < WS ']' NL
 | 
			
		||||
     dict-entry-start < WS 'dict entry(' NL
 | 
			
		||||
     dict-entry-end < WS ')' NL
 | 
			
		||||
     DQ < '\"'
 | 
			
		||||
     WS < ' '*
 | 
			
		||||
     NL < '\n'*")
 | 
			
		||||
 | 
			
		||||
  (peg:tree (match-pattern contents reply)))
 | 
			
		||||
 | 
			
		||||
(define (strip-quotes text)
 | 
			
		||||
  "Strip the leading and trailing double quotes (\") characters from TEXT."
 | 
			
		||||
  (let* ((text* (if (string-prefix? "\"" text)
 | 
			
		||||
                    (string-drop text 1)
 | 
			
		||||
                    text))
 | 
			
		||||
         (text** (if (string-suffix? "\"" text*)
 | 
			
		||||
                     (string-drop-right text* 1)
 | 
			
		||||
                     text*)))
 | 
			
		||||
    text**))
 | 
			
		||||
 | 
			
		||||
(define (deserialize-item item)
 | 
			
		||||
  "Return the value described by the ITEM parse tree as a Guile object."
 | 
			
		||||
  ;; Strings are printed wrapped in double quotes (see the print_iter
 | 
			
		||||
  ;; procedure in dbus-print-message.c).
 | 
			
		||||
  (match item
 | 
			
		||||
    (('item ('type "string") ('value value))
 | 
			
		||||
     (strip-quotes value))
 | 
			
		||||
    (('item ('type "boolean") ('value value))
 | 
			
		||||
     (if (string=? "true" value)
 | 
			
		||||
         #t
 | 
			
		||||
         #f))
 | 
			
		||||
    (('item _ ('value value))
 | 
			
		||||
     value)))
 | 
			
		||||
 | 
			
		||||
(define (serialize-boolean bool)
 | 
			
		||||
  "Return the serialized format expected by dbus-send for BOOL."
 | 
			
		||||
  (format #f "boolean:~:[false~;true~]" bool))
 | 
			
		||||
 | 
			
		||||
(define (dict->alist dict-parse-tree)
 | 
			
		||||
  "Translate a dict parse tree to an alist."
 | 
			
		||||
  (define (tuples->alist tuples)
 | 
			
		||||
    (map (lambda (x) (apply cons x)) tuples))
 | 
			
		||||
 | 
			
		||||
  (match dict-parse-tree
 | 
			
		||||
    ('dict
 | 
			
		||||
     '())
 | 
			
		||||
    (('dict ('dict-entry keys values) ...)
 | 
			
		||||
     (let ((keys* (map deserialize-item keys))
 | 
			
		||||
           (values* (map deserialize-item values)))
 | 
			
		||||
       (tuples->alist (zip keys* values*))))))
 | 
			
		||||
 | 
			
		||||
(define (array->list array-parse-tree)
 | 
			
		||||
  "Translate an array parse tree to a list."
 | 
			
		||||
  (match array-parse-tree
 | 
			
		||||
    ('array
 | 
			
		||||
     '())
 | 
			
		||||
    (('array items ...)
 | 
			
		||||
     (map deserialize-item items))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;;
 | 
			
		||||
;;; Low-level, D-Bus-related procedures.
 | 
			
		||||
;;;
 | 
			
		||||
 | 
			
		||||
;;; The following parameters are used in the jami-service-type service
 | 
			
		||||
;;; definition to conveniently customize the behavior of the send-dbus helper,
 | 
			
		||||
;;; even when called indirectly.
 | 
			
		||||
(define %send-dbus-binary (make-parameter "dbus-send"))
 | 
			
		||||
(define %send-dbus-bus (make-parameter #f))
 | 
			
		||||
(define %send-dbus-user (make-parameter #f))
 | 
			
		||||
(define %send-dbus-group (make-parameter #f))
 | 
			
		||||
(define %send-dbus-debug (make-parameter #f))
 | 
			
		||||
 | 
			
		||||
(define* (send-dbus #:key service path interface method
 | 
			
		||||
                    bus
 | 
			
		||||
                    dbus-send
 | 
			
		||||
                    user group
 | 
			
		||||
                    timeout
 | 
			
		||||
                    arguments)
 | 
			
		||||
  "Return the response of DBUS-SEND, else raise an error.  Unless explicitly
 | 
			
		||||
provided, DBUS-SEND takes the value of the %SEND-DBUS-BINARY parameter.  BUS
 | 
			
		||||
can be used to specify the bus address, such as 'unix:path=/var/run/jami/bus'.
 | 
			
		||||
Alternatively, the %SEND-DBUS-BUS parameter can be used.  ARGUMENTS can be
 | 
			
		||||
used to pass input values to a D-Bus method call.  TIMEOUT is the amount of
 | 
			
		||||
time to wait for a reply in milliseconds before giving up with an error.  USER
 | 
			
		||||
and GROUP allow choosing under which user/group the DBUS-SEND command is
 | 
			
		||||
executed.  Alternatively, the %SEND-DBUS-USER and %SEND-DBUS-GROUP parameters
 | 
			
		||||
can be used instead."
 | 
			
		||||
  (let* ((command `(,(if dbus-send
 | 
			
		||||
                         dbus-send
 | 
			
		||||
                         (%send-dbus-binary))
 | 
			
		||||
                    ,@(if (or bus (%send-dbus-bus))
 | 
			
		||||
                          (list (string-append "--bus="
 | 
			
		||||
                                               (or bus (%send-dbus-bus))))
 | 
			
		||||
                          '())
 | 
			
		||||
                    "--print-reply"
 | 
			
		||||
                    ,@(if timeout
 | 
			
		||||
                          (list (format #f "--reply-timeout=~d" timeout))
 | 
			
		||||
                          '())
 | 
			
		||||
                    ,(string-append "--dest=" service) ;e.g., cx.ring.Ring
 | 
			
		||||
                    ,path            ;e.g., /cx/ring/Ring/ConfigurationManager
 | 
			
		||||
                    ,(string-append interface "." method)
 | 
			
		||||
                    ,@(or arguments '())))
 | 
			
		||||
         (temp-port (mkstemp! (string-copy "/tmp/dbus-send-output-XXXXXXX")))
 | 
			
		||||
         (temp-file (port-filename temp-port)))
 | 
			
		||||
    (dynamic-wind
 | 
			
		||||
      (lambda ()
 | 
			
		||||
        (let* ((uid (or (and=> (or user (%send-dbus-user))
 | 
			
		||||
                               (compose passwd:uid getpwnam)) -1))
 | 
			
		||||
               (gid (or (and=> (or group (%send-dbus-group))
 | 
			
		||||
                               (compose group:gid getgrnam)) -1)))
 | 
			
		||||
          (chown temp-port uid gid)))
 | 
			
		||||
      (lambda ()
 | 
			
		||||
        (let ((pid (fork+exec-command command
 | 
			
		||||
                                      #:user (or user (%send-dbus-user))
 | 
			
		||||
                                      #:group (or group (%send-dbus-group))
 | 
			
		||||
                                      #:log-file temp-file)))
 | 
			
		||||
          (match (waitpid pid)
 | 
			
		||||
            ((_ . status)
 | 
			
		||||
             (let ((exit-status (status:exit-val status))
 | 
			
		||||
                   (output (call-with-port temp-port get-string-all)))
 | 
			
		||||
               (if (= 0 exit-status)
 | 
			
		||||
                   output
 | 
			
		||||
                   (error "the send-dbus command exited with: "
 | 
			
		||||
                          command exit-status output)))))))
 | 
			
		||||
      (lambda ()
 | 
			
		||||
        (false-if-exception (delete-file temp-file))))))
 | 
			
		||||
 | 
			
		||||
(define (parse-account-ids reply)
 | 
			
		||||
  "Return the Jami account IDs from REPLY, which is assumed to be the output
 | 
			
		||||
of the Jami D-Bus `getAccountList' method."
 | 
			
		||||
  (array->list (parse-dbus-reply reply)))
 | 
			
		||||
 | 
			
		||||
(define (parse-account-details reply)
 | 
			
		||||
  "Parse REPLY, which is assumed to be the output of the Jami D-Bus
 | 
			
		||||
`getAccountDetails' method, and return its content as an alist."
 | 
			
		||||
  (dict->alist (parse-dbus-reply reply)))
 | 
			
		||||
 | 
			
		||||
(define (parse-contacts reply)
 | 
			
		||||
  "Parse REPLY, which is assumed to be the output of the Jamid D-Bus
 | 
			
		||||
`getContacts' method, and return its content as an alist."
 | 
			
		||||
  (match (parse-dbus-reply reply)
 | 
			
		||||
    ('array
 | 
			
		||||
     '())
 | 
			
		||||
    (('array dicts ...)
 | 
			
		||||
     (map dict->alist dicts))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;;
 | 
			
		||||
;;; Higher-level, D-Bus-related procedures.
 | 
			
		||||
;;;
 | 
			
		||||
 | 
			
		||||
(define (validate-fingerprint fingerprint)
 | 
			
		||||
  "Validate that fingerprint is 40 characters long."
 | 
			
		||||
  (unless (account-fingerprint? fingerprint)
 | 
			
		||||
    (error "Account fingerprint is not valid:" fingerprint)))
 | 
			
		||||
 | 
			
		||||
(define (dbus-available-services)
 | 
			
		||||
  "Return the list of available (acquired) D-Bus services."
 | 
			
		||||
  (let ((reply (parse-dbus-reply
 | 
			
		||||
                (send-dbus #:service "org.freedesktop.DBus"
 | 
			
		||||
                           #:path "/org/freedesktop/DBus"
 | 
			
		||||
                           #:interface "org.freedesktop.DBus"
 | 
			
		||||
                           #:method "ListNames"))))
 | 
			
		||||
    ;; Remove entries such as ":1.7".
 | 
			
		||||
    (remove (cut string-prefix? ":" <>)
 | 
			
		||||
            (array->list reply))))
 | 
			
		||||
(define (jami-service-available?)
 | 
			
		||||
  "Whether the Jami D-Bus service was acquired by the D-Bus daemon."
 | 
			
		||||
  (unless (%current-dbus-connection)
 | 
			
		||||
    (initialize-dbus-connection!))
 | 
			
		||||
  (dbus-service-available? "cx.ring.Ring"))
 | 
			
		||||
 | 
			
		||||
(define (dbus-service-available? service)
 | 
			
		||||
  "Predicate to check for the D-Bus SERVICE availability."
 | 
			
		||||
  (member service (dbus-available-services)))
 | 
			
		||||
 | 
			
		||||
;;;
 | 
			
		||||
;;; Bindings for the Jami D-Bus API.
 | 
			
		||||
;;;
 | 
			
		||||
 | 
			
		||||
(define* (send-dbus/configuration-manager #:key method arguments timeout)
 | 
			
		||||
  "Query the Jami D-Bus ConfigurationManager service."
 | 
			
		||||
  (send-dbus #:service "cx.ring.Ring"
 | 
			
		||||
             #:path "/cx/ring/Ring/ConfigurationManager"
 | 
			
		||||
             #:interface "cx.ring.Ring.ConfigurationManager"
 | 
			
		||||
             #:method method
 | 
			
		||||
             #:arguments arguments
 | 
			
		||||
             #:timeout timeout))
 | 
			
		||||
(define* (call-configuration-manager-method method #:optional arguments
 | 
			
		||||
                                            #:key timeout)
 | 
			
		||||
  "Query the Jami D-Bus ConfigurationManager interface with METHOD applied to
 | 
			
		||||
ARGUMENTS.  TIMEOUT can optionally be provided as a value in seconds."
 | 
			
		||||
  (unless (%current-dbus-connection)
 | 
			
		||||
    (initialize-dbus-connection!))
 | 
			
		||||
  (call-dbus-method method
 | 
			
		||||
                    #:path "/cx/ring/Ring/ConfigurationManager"
 | 
			
		||||
                    #:destination "cx.ring.Ring"
 | 
			
		||||
                    #:interface "cx.ring.Ring.ConfigurationManager"
 | 
			
		||||
                    #:arguments arguments
 | 
			
		||||
                    #:timeout timeout))
 | 
			
		||||
 | 
			
		||||
;;; The following methods are for internal use; they make use of the account
 | 
			
		||||
;;; ID, an implementation detail of Jami the user should not need to be
 | 
			
		||||
| 
						 | 
				
			
			@ -317,22 +108,17 @@ of the Jami D-Bus `getAccountList' method."
 | 
			
		|||
(define (get-account-ids)
 | 
			
		||||
  "Return the available Jami account identifiers (IDs).  Account IDs are an
 | 
			
		||||
implementation detail used to identify the accounts in Jami."
 | 
			
		||||
  (parse-account-ids
 | 
			
		||||
   (send-dbus/configuration-manager #:method "getAccountList")))
 | 
			
		||||
  (vector->list (call-configuration-manager-method "getAccountList")))
 | 
			
		||||
 | 
			
		||||
(define (id->account-details id)
 | 
			
		||||
  "Retrieve the account data associated with the given account ID."
 | 
			
		||||
  (parse-account-details
 | 
			
		||||
   (send-dbus/configuration-manager
 | 
			
		||||
    #:method "getAccountDetails"
 | 
			
		||||
    #:arguments (list (string-append "string:" id)))))
 | 
			
		||||
  (vector->list (call-configuration-manager-method "getAccountDetails"
 | 
			
		||||
                                                   (list id))))
 | 
			
		||||
 | 
			
		||||
(define (id->volatile-account-details id)
 | 
			
		||||
  "Retrieve the account data associated with the given account ID."
 | 
			
		||||
  (parse-account-details
 | 
			
		||||
   (send-dbus/configuration-manager
 | 
			
		||||
    #:method "getVolatileAccountDetails"
 | 
			
		||||
    #:arguments (list (string-append "string:" id)))))
 | 
			
		||||
  (vector->list (call-configuration-manager-method "getVolatileAccountDetails"
 | 
			
		||||
                                                   (list id))))
 | 
			
		||||
 | 
			
		||||
(define (id->account id)
 | 
			
		||||
  "Retrieve the complete account data associated with the given account ID."
 | 
			
		||||
| 
						 | 
				
			
			@ -362,8 +148,8 @@ implementation detail used to identify the accounts in Jami."
 | 
			
		|||
                       '()))))
 | 
			
		||||
           (get-account-ids))))
 | 
			
		||||
  (or (assoc-ref %username-to-id-cache username)
 | 
			
		||||
      (let ((message (format #f "Could not retrieve a local account ID\
 | 
			
		||||
 for ~:[username~;fingerprint~]" (account-fingerprint? username))))
 | 
			
		||||
      (let ((message (format #f "no account ID for ~:[username~;fingerprint~]"
 | 
			
		||||
                             (account-fingerprint? username))))
 | 
			
		||||
        (error message username))))
 | 
			
		||||
 | 
			
		||||
(define (account->username account)
 | 
			
		||||
| 
						 | 
				
			
			@ -400,27 +186,21 @@ registered username."
 | 
			
		|||
should *not* be encrypted with a password.  Return the username associated
 | 
			
		||||
with the account."
 | 
			
		||||
  (invalidate-username-to-id-cache!)
 | 
			
		||||
  (let ((reply (send-dbus/configuration-manager
 | 
			
		||||
                #:method "addAccount"
 | 
			
		||||
                #:arguments (list (string-append
 | 
			
		||||
                                   "dict:string:string:Account.archivePath,"
 | 
			
		||||
                                   archive
 | 
			
		||||
                                   ",Account.type,RING")))))
 | 
			
		||||
  (let ((id (call-configuration-manager-method
 | 
			
		||||
             "addAccount" (list `#(("Account.archivePath" . ,archive)
 | 
			
		||||
                                   ("Account.type" . "RING"))))))
 | 
			
		||||
    ;; The account information takes some time to be populated.
 | 
			
		||||
    (let ((id (deserialize-item (parse-dbus-reply reply))))
 | 
			
		||||
      (with-retries 20 1
 | 
			
		||||
        (let ((username (id->username id)))
 | 
			
		||||
          (if (string-null? username)
 | 
			
		||||
              #f
 | 
			
		||||
              username))))))
 | 
			
		||||
    (with-retries 20 1
 | 
			
		||||
      (let ((username (id->username id)))
 | 
			
		||||
        (if (and=> username (negate string-null?))
 | 
			
		||||
            username
 | 
			
		||||
            #f)))))
 | 
			
		||||
 | 
			
		||||
(define (remove-account username)
 | 
			
		||||
  "Delete the Jami account associated with USERNAME, the account 40 characters
 | 
			
		||||
fingerprint or a registered username."
 | 
			
		||||
  (let ((id (username->id username)))
 | 
			
		||||
    (send-dbus/configuration-manager
 | 
			
		||||
     #:method "removeAccount"
 | 
			
		||||
     #:arguments (list (string-append "string:" id))))
 | 
			
		||||
    (call-configuration-manager-method "removeAccount" (list id)))
 | 
			
		||||
  (invalidate-username-to-id-cache!))
 | 
			
		||||
 | 
			
		||||
(define* (username->contacts username)
 | 
			
		||||
| 
						 | 
				
			
			@ -430,15 +210,16 @@ contacts.  USERNAME can be either the account 40 characters public key
 | 
			
		|||
fingerprint or a registered username.  The contacts returned are represented
 | 
			
		||||
using their 40 characters fingerprint."
 | 
			
		||||
  (let* ((id (username->id username))
 | 
			
		||||
         (reply (send-dbus/configuration-manager
 | 
			
		||||
                 #:method "getContacts"
 | 
			
		||||
                 #:arguments (list (string-append "string:" id))))
 | 
			
		||||
         (all-contacts (parse-contacts reply))
 | 
			
		||||
         ;; The contacts are returned as "aa{ss}", that is, an array of arrays
 | 
			
		||||
         ;; containing (string . string) pairs.
 | 
			
		||||
         (contacts (map vector->list
 | 
			
		||||
                        (vector->list (call-configuration-manager-method
 | 
			
		||||
                                       "getContacts" (list id)))))
 | 
			
		||||
         (banned? (lambda (contact)
 | 
			
		||||
                    (and=> (assoc-ref contact "banned")
 | 
			
		||||
                           (cut string=? "true" <>))))
 | 
			
		||||
         (banned (filter banned? all-contacts))
 | 
			
		||||
         (not-banned (filter (negate banned?) all-contacts))
 | 
			
		||||
         (banned (filter banned? contacts))
 | 
			
		||||
         (not-banned (filter (negate banned?) contacts))
 | 
			
		||||
         (fingerprint (cut assoc-ref <> "id")))
 | 
			
		||||
    (values (map fingerprint not-banned)
 | 
			
		||||
            (map fingerprint banned))))
 | 
			
		||||
| 
						 | 
				
			
			@ -449,27 +230,20 @@ the account associated with USERNAME (either a fingerprint or a registered
 | 
			
		|||
username).  When BAN? is true, also mark the contact as banned."
 | 
			
		||||
  (validate-fingerprint contact)
 | 
			
		||||
  (let ((id (username->id username)))
 | 
			
		||||
    (send-dbus/configuration-manager
 | 
			
		||||
     #:method "removeContact"
 | 
			
		||||
     #:arguments (list (string-append "string:" id)
 | 
			
		||||
                       (string-append "string:" contact)
 | 
			
		||||
                       (serialize-boolean ban?)))))
 | 
			
		||||
    (call-configuration-manager-method "removeContact" (list id contact ban?))))
 | 
			
		||||
 | 
			
		||||
(define (add-contact contact username)
 | 
			
		||||
  "Add CONTACT, the 40 characters public key fingerprint of a contact, to the
 | 
			
		||||
account of USERNAME (either a fingerprint or a registered username)."
 | 
			
		||||
  (validate-fingerprint contact)
 | 
			
		||||
  (let ((id (username->id username)))
 | 
			
		||||
    (send-dbus/configuration-manager
 | 
			
		||||
     #:method "addContact"
 | 
			
		||||
     #:arguments (list (string-append "string:" id)
 | 
			
		||||
                       (string-append "string:" contact)))))
 | 
			
		||||
    (call-configuration-manager-method "addContact" (list id contact))))
 | 
			
		||||
 | 
			
		||||
(define* (set-account-details details username #:key timeout)
 | 
			
		||||
  "Set DETAILS, an alist containing the key value pairs to set for the account
 | 
			
		||||
of USERNAME, a registered username or account fingerprint.  The value of the
 | 
			
		||||
parameters not provided are unchanged.  TIMEOUT is a value in milliseconds to
 | 
			
		||||
pass to the `send-dbus/configuration-manager' procedure."
 | 
			
		||||
pass to the `call-configuration-manager-method' procedure."
 | 
			
		||||
  (let* ((id (username->id username))
 | 
			
		||||
         (current-details (id->account-details id))
 | 
			
		||||
         (updated-details (map (match-lambda
 | 
			
		||||
| 
						 | 
				
			
			@ -477,52 +251,29 @@ pass to the `send-dbus/configuration-manager' procedure."
 | 
			
		|||
                                  (or (and=> (assoc-ref details key)
 | 
			
		||||
                                             (cut cons key <>))
 | 
			
		||||
                                      (cons key value))))
 | 
			
		||||
                               current-details))
 | 
			
		||||
         ;; dbus-send does not permit sending null strings (it throws a
 | 
			
		||||
         ;; "malformed dictionary" error).  Luckily they seem to have the
 | 
			
		||||
         ;; semantic of "default account value" in Jami; so simply drop them.
 | 
			
		||||
         (updated-details* (remove (match-lambda
 | 
			
		||||
                                     ((_ . value)
 | 
			
		||||
                                      (string-null? value)))
 | 
			
		||||
                                   updated-details)))
 | 
			
		||||
    (send-dbus/configuration-manager
 | 
			
		||||
     #:timeout timeout
 | 
			
		||||
     #:method "setAccountDetails"
 | 
			
		||||
     #:arguments
 | 
			
		||||
     (list (string-append "string:" id)
 | 
			
		||||
           (string-append "dict:string:string:"
 | 
			
		||||
                          (string-join (alist->list updated-details*)
 | 
			
		||||
                                       ","))))))
 | 
			
		||||
                               current-details)))
 | 
			
		||||
    (call-configuration-manager-method
 | 
			
		||||
     "setAccountDetails" (list id (list->vector updated-details))
 | 
			
		||||
     #:timeout timeout)))
 | 
			
		||||
 | 
			
		||||
(define (set-all-moderators enabled? username)
 | 
			
		||||
  "Set the 'AllModerators' property to enabled? for the account of USERNAME, a
 | 
			
		||||
registered username or account fingerprint."
 | 
			
		||||
  (let ((id (username->id username)))
 | 
			
		||||
    (send-dbus/configuration-manager
 | 
			
		||||
     #:method "setAllModerators"
 | 
			
		||||
     #:arguments
 | 
			
		||||
     (list (string-append "string:" id)
 | 
			
		||||
           (serialize-boolean enabled?)))))
 | 
			
		||||
    (call-configuration-manager-method "setAllModerators" (list id enabled?))))
 | 
			
		||||
 | 
			
		||||
(define (username->all-moderators? username)
 | 
			
		||||
  "Return the 'AllModerators' property for the account of USERNAME, a
 | 
			
		||||
registered username or account fingerprint."
 | 
			
		||||
  (let* ((id (username->id username))
 | 
			
		||||
         (reply (send-dbus/configuration-manager
 | 
			
		||||
                 #:method "isAllModerators"
 | 
			
		||||
                 #:arguments
 | 
			
		||||
                 (list (string-append "string:" id)))))
 | 
			
		||||
    (deserialize-item (parse-dbus-reply reply))))
 | 
			
		||||
  (let ((id (username->id username)))
 | 
			
		||||
    (call-configuration-manager-method "isAllModerators" (list id))))
 | 
			
		||||
 | 
			
		||||
(define (username->moderators username)
 | 
			
		||||
  "Return the moderators for the account of USERNAME, a registered username or
 | 
			
		||||
account fingerprint."
 | 
			
		||||
  (let* ((id (username->id username))
 | 
			
		||||
         (reply (send-dbus/configuration-manager
 | 
			
		||||
                 #:method "getDefaultModerators"
 | 
			
		||||
                 #:arguments
 | 
			
		||||
                 (list (string-append "string:" id)))))
 | 
			
		||||
    (array->list (parse-dbus-reply reply))))
 | 
			
		||||
  (let* ((id (username->id username)))
 | 
			
		||||
    (vector->list (call-configuration-manager-method "getDefaultModerators"
 | 
			
		||||
                                                     (list id)))))
 | 
			
		||||
 | 
			
		||||
(define (set-moderator contact enabled? username)
 | 
			
		||||
  "Set the moderator flag to ENABLED? for CONTACT, the 40 characters public
 | 
			
		||||
| 
						 | 
				
			
			@ -530,11 +281,8 @@ key fingerprint of a contact for the account of USERNAME, a registered
 | 
			
		|||
username or account fingerprint."
 | 
			
		||||
  (validate-fingerprint contact)
 | 
			
		||||
  (let* ((id (username->id username)))
 | 
			
		||||
    (send-dbus/configuration-manager #:method "setDefaultModerator"
 | 
			
		||||
                                     #:arguments
 | 
			
		||||
                                     (list (string-append "string:" id)
 | 
			
		||||
                                           (string-append "string:" contact)
 | 
			
		||||
                                           (serialize-boolean enabled?)))))
 | 
			
		||||
    (call-configuration-manager-method "setDefaultModerator"
 | 
			
		||||
                                       (list id contact enabled?))))
 | 
			
		||||
 | 
			
		||||
(define (disable-account username)
 | 
			
		||||
  "Disable the account known by USERNAME, a registered username or account
 | 
			
		||||
| 
						 | 
				
			
			@ -543,7 +291,7 @@ fingerprint."
 | 
			
		|||
                       ;; Waiting for the reply on this command takes a very
 | 
			
		||||
                       ;; long time that trips the default D-Bus timeout value
 | 
			
		||||
                       ;; (25 s), for some reason.
 | 
			
		||||
                        #:timeout 60000))
 | 
			
		||||
                        #:timeout 60))
 | 
			
		||||
 | 
			
		||||
(define (enable-account username)
 | 
			
		||||
  "Enable the account known by USERNAME, a registered username or account
 | 
			
		||||
| 
						 | 
				
			
			@ -581,7 +329,3 @@ requirements."
 | 
			
		|||
              (fold alist-delete account-details first-items))))
 | 
			
		||||
 | 
			
		||||
  (string-join (map pair->recutil-property sorted-account-details) "\n"))
 | 
			
		||||
 | 
			
		||||
;; Local Variables:
 | 
			
		||||
;; eval: (put 'with-retries 'scheme-indent-function 2)
 | 
			
		||||
;; End:
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -715,6 +715,7 @@ GNU_SYSTEM_MODULES =				\
 | 
			
		|||
  %D%/build/bootloader.scm			\
 | 
			
		||||
  %D%/build/chromium-extension.scm		\
 | 
			
		||||
  %D%/build/cross-toolchain.scm			\
 | 
			
		||||
  %D%/build/dbus-service.scm			\
 | 
			
		||||
  %D%/build/image.scm				\
 | 
			
		||||
  %D%/build/jami-service.scm			\
 | 
			
		||||
  %D%/build/file-systems.scm			\
 | 
			
		||||
| 
						 | 
				
			
			@ -848,7 +849,6 @@ dist_patch_DATA =						\
 | 
			
		|||
  %D%/packages/patches/akonadi-not-relocatable.patch		\
 | 
			
		||||
  %D%/packages/patches/akonadi-timestamps.patch		\
 | 
			
		||||
  %D%/packages/patches/allegro-mesa-18.2.5-and-later.patch	\
 | 
			
		||||
  %D%/packages/patches/alpine-fix-privacy-policy-crash.patch	\
 | 
			
		||||
  %D%/packages/patches/anki-mpv-args.patch			\
 | 
			
		||||
  %D%/packages/patches/antiword-CVE-2014-8123.patch			\
 | 
			
		||||
  %D%/packages/patches/antlr3-3_1-fix-java8-compilation.patch	\
 | 
			
		||||
| 
						 | 
				
			
			@ -1039,7 +1039,6 @@ dist_patch_DATA =						\
 | 
			
		|||
  %D%/packages/patches/enjarify-setup-py.patch			\
 | 
			
		||||
  %D%/packages/patches/enlightenment-fix-setuid-path.patch	\
 | 
			
		||||
  %D%/packages/patches/eog-update-libportal-usage.patch		\
 | 
			
		||||
  %D%/packages/patches/epiphany-update-libportal-usage.patch	\
 | 
			
		||||
  %D%/packages/patches/erlang-man-path.patch			\
 | 
			
		||||
  %D%/packages/patches/esmtp-add-lesmtp.patch		\
 | 
			
		||||
  %D%/packages/patches/eudev-rules-directory.patch		\
 | 
			
		||||
| 
						 | 
				
			
			@ -1527,7 +1526,6 @@ dist_patch_DATA =						\
 | 
			
		|||
  %D%/packages/patches/netsurf-system-utf8proc.patch		\
 | 
			
		||||
  %D%/packages/patches/netsurf-y2038-tests.patch		\
 | 
			
		||||
  %D%/packages/patches/netsurf-longer-test-timeout.patch	\
 | 
			
		||||
  %D%/packages/patches/nftables-fix-makefile.patch		\
 | 
			
		||||
  %D%/packages/patches/nhc98-c-update.patch			\
 | 
			
		||||
  %D%/packages/patches/nix-dont-build-html-doc.diff		\
 | 
			
		||||
  %D%/packages/patches/nfs4-acl-tools-0.3.7-fixpaths.patch	\
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1127,6 +1127,77 @@ IPv6, proxies, and Unix sockets.")
 | 
			
		|||
    (license (list license:bsd-3
 | 
			
		||||
                   license:bsd-2))))  ; atomicio.*, socks.c
 | 
			
		||||
 | 
			
		||||
(define-public nmon
 | 
			
		||||
  (package
 | 
			
		||||
    (name "nmon")
 | 
			
		||||
    (version "16n")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append "mirror://sourceforge/nmon/lmon" version ".c"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1wpm2f30414b87kpbr9hbidblr5cmfby5skwqd0fkpi5v712q0f0"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list #:tests? #f                  ; no test suite
 | 
			
		||||
           #:phases
 | 
			
		||||
           #~(modify-phases %standard-phases
 | 
			
		||||
               (replace 'unpack
 | 
			
		||||
                 (lambda _
 | 
			
		||||
                   (copy-file #$(package-source this-package) "lmon.c")))
 | 
			
		||||
               (delete 'configure)      ; no build system
 | 
			
		||||
               (replace 'build
 | 
			
		||||
                 ;; There is an example ‘Makefile’ in the .c file.
 | 
			
		||||
                 (lambda _
 | 
			
		||||
                   ;; These #defines aren't well-documented and, e.g., POWER was
 | 
			
		||||
                   ;; not actually tested on every possible TARGET-POWERPC?.
 | 
			
		||||
                   (let* ((system #$(cond ((target-x86-32?) "X86")
 | 
			
		||||
                                          ((target-x86-64?) "X86")
 | 
			
		||||
                                          ((target-arm?) "ARM")
 | 
			
		||||
                                          ((target-powerpc?) "POWER")
 | 
			
		||||
                                          (else "CROSS_FINGERS"))))
 | 
			
		||||
                     (format #t "Building for ~a~%" system)
 | 
			
		||||
                     (invoke #$(cc-for-target) "-o" "nmon" "lmon.c"
 | 
			
		||||
                             "-g" "-Wall" "-D" system
 | 
			
		||||
                             "-lncurses" "-lm"))))
 | 
			
		||||
               (replace 'install
 | 
			
		||||
                 (lambda _
 | 
			
		||||
                   (let ((bin (string-append #$output "/bin"))
 | 
			
		||||
                         (man1 (string-append #$output "/share/man/man1")))
 | 
			
		||||
                     (install-file "nmon" bin)
 | 
			
		||||
                     (mkdir-p man1)
 | 
			
		||||
                     (copy-file #$(this-package-native-input "man-page")
 | 
			
		||||
                                (string-append man1 "/nmon.1"))))))))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list `("man-page"
 | 
			
		||||
             ,(origin
 | 
			
		||||
                ;; There is no man page upstream, so install Debian's.
 | 
			
		||||
                (method url-fetch)
 | 
			
		||||
                (uri (string-append "https://salsa.debian.org/carnil/nmon/"
 | 
			
		||||
                                    "-/raw/debian/" version "+debian-1/"
 | 
			
		||||
                                    "debian/nmon.1"))
 | 
			
		||||
                (sha256
 | 
			
		||||
                 (base32
 | 
			
		||||
                  "1gpvd2kjyhs18sh6sga5bk9wj8s78blfd4c0m38r0wl92jx2yv1b"))))))
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list ncurses))
 | 
			
		||||
    (home-page "http://nmon.sourceforge.net/")
 | 
			
		||||
    (synopsis
 | 
			
		||||
     "Monitor system performance in a terminal or to a @file{.csv} log file")
 | 
			
		||||
    (description
 | 
			
		||||
     "@acronym{Nmon, Nigel's performance monitor} is yet another system monitor
 | 
			
		||||
useful in systems administration, debugging, tuning, and benchmarking.
 | 
			
		||||
 | 
			
		||||
The configurable ncurses interface displays all the classic resource usage
 | 
			
		||||
statistics (CPU, memory, network, disk, ...) as real-time graphs or numbers.
 | 
			
		||||
It can also list the processes responsible in a @command{top}-like table.
 | 
			
		||||
 | 
			
		||||
A less common nmon feature is its ability to create highly detailed log files
 | 
			
		||||
in @acronym{CSV, comma-separated values} format.  These can be imported into
 | 
			
		||||
spreadsheets or fed straight into an @acronym{RRD, round-robin database} using
 | 
			
		||||
@command{rrdtool} for further analyisis, or to create colourful graphs.")
 | 
			
		||||
    (license license:gpl3+)))
 | 
			
		||||
 | 
			
		||||
(define-public sipcalc
 | 
			
		||||
  (package
 | 
			
		||||
    (name "sipcalc")
 | 
			
		||||
| 
						 | 
				
			
			@ -1769,7 +1840,7 @@ system administrator.")
 | 
			
		|||
(define-public sudo
 | 
			
		||||
  (package
 | 
			
		||||
    (name "sudo")
 | 
			
		||||
    (version "1.9.11")
 | 
			
		||||
    (version "1.9.11p1")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri
 | 
			
		||||
| 
						 | 
				
			
			@ -1779,7 +1850,7 @@ system administrator.")
 | 
			
		|||
                                    version ".tar.gz")))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1gjingc1h7d6p17m0nn87yiwh8gbdchg4w4kv8s4g89wv0q6wixm"))
 | 
			
		||||
                "0jr52rmig9h367j0n6h3lp5xf54jsycnvdih42wg9bd9d4d6r2zb"))
 | 
			
		||||
              (modules '((guix build utils)))
 | 
			
		||||
              (snippet
 | 
			
		||||
               '(begin
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -2232,13 +2232,13 @@ targeted by a kinase.")
 | 
			
		|||
(define-public r-deepsnv
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-deepsnv")
 | 
			
		||||
    (version "1.42.0")
 | 
			
		||||
    (version "1.42.1")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (bioconductor-uri "deepSNV" version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0si1x2bi5pff1dicpqg7hv4ziq46vm7lic72724ljsclpz9bfv6q"))))
 | 
			
		||||
                "0bgj1grv3a5bqhcdsw445x49kl3pz367svy6fnrzfsk9bmj46kgn"))))
 | 
			
		||||
    (properties `((upstream-name . "deepSNV")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
| 
						 | 
				
			
			@ -3103,13 +3103,13 @@ powerful online queries from gene annotation to database mining.")
 | 
			
		|||
(define-public r-biocparallel
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-biocparallel")
 | 
			
		||||
    (version "1.30.2")
 | 
			
		||||
    (version "1.30.3")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (bioconductor-uri "BiocParallel" version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0rqvwhs6d8ls1rq7j5ywl5k0qgblxpzimilyw335bi1yad5s10h3"))))
 | 
			
		||||
                "1rs3wmasl9mx7f399iclvm0bnvggvjj2a88zbi294r5m8wxqlc92"))))
 | 
			
		||||
    (properties
 | 
			
		||||
     `((upstream-name . "BiocParallel")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
| 
						 | 
				
			
			@ -3142,7 +3142,7 @@ powerful online queries from gene annotation to database mining.")
 | 
			
		|||
                (string-append
 | 
			
		||||
                 m "; if (!is.na(Sys.getenv(\"SOURCE_DATE_EPOCH\"))) {set.seed(100)}\n"))))))))
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
     (list r-futile-logger r-snow r-bh))
 | 
			
		||||
     (list r-bh r-codetools r-futile-logger r-snow))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list r-knitr))
 | 
			
		||||
    (home-page "https://bioconductor.org/packages/BiocParallel")
 | 
			
		||||
| 
						 | 
				
			
			@ -3934,13 +3934,13 @@ alignments.")
 | 
			
		|||
(define-public r-genomicfeatures
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-genomicfeatures")
 | 
			
		||||
    (version "1.48.1")
 | 
			
		||||
    (version "1.48.3")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (bioconductor-uri "GenomicFeatures" version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "18ain5s0ry6w0ki4c0czvwax2ncigrldyac30a6mlbzyaga6i54h"))))
 | 
			
		||||
                "0f14p1ma2y8l60p9sxmh5j0axws9by1cznczb2jxipphpb4slpl1"))))
 | 
			
		||||
    (properties
 | 
			
		||||
     `((upstream-name . "GenomicFeatures")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
| 
						 | 
				
			
			@ -4193,14 +4193,14 @@ Shiny-based display methods for Bioconductor objects.")
 | 
			
		|||
(define-public r-keggrest
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-keggrest")
 | 
			
		||||
    (version "1.36.0")
 | 
			
		||||
    (version "1.36.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (bioconductor-uri "KEGGREST" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "0hzlm6nzmx0iyjh063512a3ghc1xqb58g5z2bnd2wl4y42iww7bg"))))
 | 
			
		||||
         "1rn03w8y80prbvzahkvf8275haiymnjj1ijcgn55p3d0sb54yzgw"))))
 | 
			
		||||
    (properties `((upstream-name . "KEGGREST")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
| 
						 | 
				
			
			@ -5909,13 +5909,13 @@ libraries for systems that do not have these available via other means.")
 | 
			
		|||
(define-public r-zellkonverter
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-zellkonverter")
 | 
			
		||||
    (version "1.6.1")
 | 
			
		||||
    (version "1.6.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (bioconductor-uri "zellkonverter" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1w3qi35vk289cpky1pb0wgg1hr55s5kdw7np98i9c1vmwi3gvwr7"))))
 | 
			
		||||
        (base32 "0s1n3impm4k55pac8mr18czylsc30yqcvdfdki4sawk74b2rkx8c"))))
 | 
			
		||||
    (properties `((upstream-name . "zellkonverter")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
| 
						 | 
				
			
			@ -6383,14 +6383,14 @@ determining dependencies between variables, code improvement suggestions.")
 | 
			
		|||
(define-public r-chippeakanno
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-chippeakanno")
 | 
			
		||||
    (version "3.30.0")
 | 
			
		||||
    (version "3.30.1")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (bioconductor-uri "ChIPpeakAnno" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "1ch636j3zd6hcfnl455vjs36wffrdhwzyvkbikcwjg7idiknjdkf"))))
 | 
			
		||||
         "0a26glldxczcfymjvd45gv5m4hympziivm6wwx4ab9wld7n43l8y"))))
 | 
			
		||||
    (properties `((upstream-name . "ChIPpeakAnno")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
| 
						 | 
				
			
			@ -7652,14 +7652,14 @@ single cell assay data.")
 | 
			
		|||
(define-public r-monocle
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-monocle")
 | 
			
		||||
    (version "2.24.0")
 | 
			
		||||
    (version "2.24.1")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (bioconductor-uri "monocle" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "1fyqd7qhij2iyx9vdmgnx2qf0w3kwbkmg805539zrmxry8cwfldb"))))
 | 
			
		||||
         "11g1wx0f1yzhg3x1aa3d5l7pqlzxj16s0gha21skxkgld8k2x8xn"))))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
     (list r-biobase
 | 
			
		||||
| 
						 | 
				
			
			@ -8699,14 +8699,14 @@ All the visualization methods are developed based on ggplot2 graphics.")
 | 
			
		|||
(define-public r-clusterprofiler
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-clusterprofiler")
 | 
			
		||||
    (version "4.4.1")
 | 
			
		||||
    (version "4.4.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (bioconductor-uri "clusterProfiler" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "03bg3agisrm4q10gg57dksvd1ws37if6a1gwcxaybb4c50zadm8p"))))
 | 
			
		||||
         "07fbc3d06990qy1qcaqqgm5ma2l0h08bwfkqrnlfd9f2xcppdywd"))))
 | 
			
		||||
    (properties
 | 
			
		||||
     `((upstream-name . "clusterProfiler")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
| 
						 | 
				
			
			@ -10768,14 +10768,14 @@ annotations.")
 | 
			
		|||
(define-public r-rsubread
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-rsubread")
 | 
			
		||||
    (version "2.10.1")
 | 
			
		||||
    (version "2.10.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (bioconductor-uri "Rsubread" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "1cf80gmzz4c1pvif3350ifsmsbfplyl2na39n8g3x0zkwpl6ijdc"))))
 | 
			
		||||
         "1pvyx8nxv10s816hgxrnw60hp9rlqjdgjq3ajpzqxgxmmlhnk0v0"))))
 | 
			
		||||
    (properties `((upstream-name . "Rsubread")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
    (inputs (list zlib))
 | 
			
		||||
| 
						 | 
				
			
			@ -12235,14 +12235,14 @@ data.")
 | 
			
		|||
(define-public r-universalmotif
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-universalmotif")
 | 
			
		||||
    (version "1.14.0")
 | 
			
		||||
    (version "1.14.1")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (bioconductor-uri "universalmotif" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "0n2msyyy1xhapkd66j4xwabg4qfd62l01p1nmafjwifnjsx45xvp"))))
 | 
			
		||||
         "1sm54z8aq3534qjsa19wychhwcvwnjlkydmiqqvidiiwcxwqpjsr"))))
 | 
			
		||||
    (properties
 | 
			
		||||
     `((upstream-name . "universalmotif")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
| 
						 | 
				
			
			@ -13806,14 +13806,14 @@ provided.")
 | 
			
		|||
(define-public r-hdf5array
 | 
			
		||||
  (package
 | 
			
		||||
    (name "r-hdf5array")
 | 
			
		||||
    (version "1.24.0")
 | 
			
		||||
    (version "1.24.1")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (bioconductor-uri "HDF5Array" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "0s9vj74359ckmwl8r951jxrzkidslwdl9qamkhz8ilw8b5awxyw4"))))
 | 
			
		||||
         "1r1lg7k60qgb489xkypd4gvm1fmdlihvylb5va6xj58ipndbfday"))))
 | 
			
		||||
    (properties `((upstream-name . "HDF5Array")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -830,13 +830,13 @@ servers supporting the protocol.")
 | 
			
		|||
(define-public python-pybedtools
 | 
			
		||||
  (package
 | 
			
		||||
    (name "python-pybedtools")
 | 
			
		||||
    (version "0.8.2")
 | 
			
		||||
    (version "0.9.0")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (pypi-uri "pybedtools" version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0wc7z8g8prgdx7n5chjva2fdq03wiwhqisjjxzkjg1j5k5ha7151"))))
 | 
			
		||||
                "18rhzk08d3rpxhi5xh6pqg64x6v5q3daw6y3v54k85v4swncjrwj"))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:modules ((srfi srfi-26)
 | 
			
		||||
| 
						 | 
				
			
			@ -896,11 +896,16 @@ servers supporting the protocol.")
 | 
			
		|||
    (home-page "https://pythonhosted.org/pybedtools/")
 | 
			
		||||
    (synopsis "Python wrapper for BEDtools programs")
 | 
			
		||||
    (description
 | 
			
		||||
     "pybedtools is a Python wrapper for Aaron Quinlan's BEDtools programs,
 | 
			
		||||
     "This package is a Python wrapper for Aaron Quinlan's BEDtools programs,
 | 
			
		||||
which are widely used for genomic interval manipulation or \"genome algebra\".
 | 
			
		||||
pybedtools extends BEDTools by offering feature-level manipulations from with
 | 
			
		||||
Python.")
 | 
			
		||||
    (license license:gpl2+)))
 | 
			
		||||
    ;; pypi lists GPLv2 in the PKG-INFO and website, but was relicensed in
 | 
			
		||||
    ;; version 0.9.0 and the LICENSE.txt is consistant with the source code.
 | 
			
		||||
    ;;
 | 
			
		||||
    ;; pybedtools/include/gzstream.cpp and pybedtools/include/gzstream.h are
 | 
			
		||||
    ;; licensed lgpl2.1+
 | 
			
		||||
    (license (list license:expat license:lgpl2.1+))))
 | 
			
		||||
 | 
			
		||||
(define-public python-biom-format
 | 
			
		||||
  (package
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -3,7 +3,7 @@
 | 
			
		|||
;;; Copyright © 2016, 2017, 2018, 2019, 2021 Ricardo Wurmus <rekado@elephly.net>
 | 
			
		||||
;;; Copyright © 2018, 2020–2022 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz>
 | 
			
		||||
;;; Copyright © 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;; Copyright © 2019, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;; Copyright © 2019, 2021 Guillaume Le Vaillant <glv@posteo.net>
 | 
			
		||||
;;; Copyright © 2019 Andreas Enge <andreas@enge.fr>
 | 
			
		||||
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 | 
			
		||||
| 
						 | 
				
			
			@ -399,7 +399,7 @@ as dictionaries, skip lists, and memory pools.")
 | 
			
		|||
(define-public packcc
 | 
			
		||||
  (package
 | 
			
		||||
    (name "packcc")
 | 
			
		||||
    (version "1.5.0")
 | 
			
		||||
    (version "1.7.2")
 | 
			
		||||
    (home-page "https://github.com/arithy/packcc")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -409,7 +409,7 @@ as dictionaries, skip lists, and memory pools.")
 | 
			
		|||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1n9ivsa6b9ps2jbh34bycjqjpbwbk85l4jjg46pfhqxzz96793wy"))))
 | 
			
		||||
                "1mb6ys5ylvjz0xpq6769ir98s80p98s9ahd0c9k8p2ra1w20vz33"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     '(#:phases (modify-phases %standard-phases
 | 
			
		||||
| 
						 | 
				
			
			@ -433,8 +433,7 @@ as dictionaries, skip lists, and memory pools.")
 | 
			
		|||
                        (install-file "release/bin/packcc"
 | 
			
		||||
                                      (string-append out "/bin"))
 | 
			
		||||
                        (install-file "../../README.md"
 | 
			
		||||
                                      (string-append out "/share/doc/packcc"))
 | 
			
		||||
                        #t))))))
 | 
			
		||||
                                      (string-append out "/share/doc/packcc"))))))))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list bats))
 | 
			
		||||
    (synopsis "Packrat parser generator for C")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -390,7 +390,7 @@ features that are not supported by the standard @code{stdio} implementation.")
 | 
			
		|||
(define-public universal-ctags
 | 
			
		||||
  (package
 | 
			
		||||
    (name "universal-ctags")
 | 
			
		||||
    (version "5.9.20210509.0")
 | 
			
		||||
    (version "5.9.20220605.0")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -400,14 +400,14 @@ features that are not supported by the standard @code{stdio} implementation.")
 | 
			
		|||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "1sq94bnbzr40zwihfnsna759bbak0lw27j0yn12iwpg4xgb4hhwp"))
 | 
			
		||||
         "0mri7m2qsw5pyq1ajapawvxn2cdrzg1vi4w2bdq0z4ws4q03lj7k"))
 | 
			
		||||
       (modules '((guix build utils)))
 | 
			
		||||
       (snippet
 | 
			
		||||
        '(begin
 | 
			
		||||
           ;; Remove the bundled PackCC and associated build rules.
 | 
			
		||||
           (substitute* "Makefile.am"
 | 
			
		||||
             (("^PACKCC = .*")
 | 
			
		||||
              "PACKCC = packcc")
 | 
			
		||||
              "PACKCC = packcc\n")
 | 
			
		||||
             (("\\$\\(PACKCC_FILES\\)")
 | 
			
		||||
              "")
 | 
			
		||||
             (("\\$\\(PEG_SRCS\\) \\$\\(PEG_HEADS\\): \\$\\(PACKCC\\)")
 | 
			
		||||
| 
						 | 
				
			
			@ -437,7 +437,7 @@ features that are not supported by the standard @code{stdio} implementation.")
 | 
			
		|||
    (native-inputs
 | 
			
		||||
     (list autoconf automake packcc perl pkg-config))
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list jansson libseccomp libxml2 libyaml))
 | 
			
		||||
     (list jansson libseccomp libxml2 libyaml pcre2))
 | 
			
		||||
    (home-page "https://ctags.io/")
 | 
			
		||||
    (synopsis "Generate tag files for source code")
 | 
			
		||||
    (description
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -2575,29 +2575,30 @@ chunks.")
 | 
			
		|||
(define-public c-blosc
 | 
			
		||||
  (package
 | 
			
		||||
    (name "c-blosc")
 | 
			
		||||
    (version "1.18.1")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
                    (url "https://github.com/Blosc/c-blosc")
 | 
			
		||||
                    (commit (string-append "v" version))))
 | 
			
		||||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1ywq8j70149859vvs19wgjq89d6xsvvmvm2n1dmkzpchxgrvnw70"))))
 | 
			
		||||
    (version "1.21.1")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
       (uri (git-reference
 | 
			
		||||
             (url "https://github.com/Blosc/c-blosc")
 | 
			
		||||
             (commit (string-append "v" version))))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0gy9a7wp7x71x5l3rprx8wpb3c5cn7wqc77gdiffq35hr34q88p9"))
 | 
			
		||||
       (modules '((guix build utils)))
 | 
			
		||||
       (snippet
 | 
			
		||||
        ;; In a rare victory, we may delete all bundled libs to no ill effect.
 | 
			
		||||
        '(delete-file-recursively "internal-complibs"))))
 | 
			
		||||
    (build-system cmake-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:configure-flags
 | 
			
		||||
       '("-DDEACTIVATE_AVX2=ON"
 | 
			
		||||
       '("-DBUILD_STATIC=OFF"
 | 
			
		||||
         "-DDEACTIVATE_AVX2=ON"
 | 
			
		||||
         "-DPREFER_EXTERNAL_LZ4=ON"
 | 
			
		||||
         "-DPREFER_EXTERNAL_SNAPPY=ON"
 | 
			
		||||
         "-DPREFER_EXTERNAL_ZLIB=ON"
 | 
			
		||||
         "-DPREFER_EXTERNAL_ZSTD=ON")))
 | 
			
		||||
    (inputs
 | 
			
		||||
     `(("lz4" ,lz4)
 | 
			
		||||
       ("snappy" ,snappy)
 | 
			
		||||
       ("zlib" ,zlib)
 | 
			
		||||
       ("zstd:lib" ,zstd "lib")))
 | 
			
		||||
     (list lz4 snappy zlib `(,zstd "lib")))
 | 
			
		||||
    (home-page "https://blosc.org")
 | 
			
		||||
    (synopsis "Blocking, shuffling and lossless compression library")
 | 
			
		||||
    (description
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -886,7 +886,7 @@ and make @code{cpplint} usable in wider contexts.")
 | 
			
		|||
(define-public reproc
 | 
			
		||||
  (package
 | 
			
		||||
    (name "reproc")
 | 
			
		||||
    (version "14.1.0")
 | 
			
		||||
    (version "14.2.4")
 | 
			
		||||
    (source
 | 
			
		||||
      (origin
 | 
			
		||||
        (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -895,13 +895,12 @@ and make @code{cpplint} usable in wider contexts.")
 | 
			
		|||
               (commit (string-append "v" version))))
 | 
			
		||||
        (file-name (git-file-name name version))
 | 
			
		||||
        (sha256
 | 
			
		||||
          (base32
 | 
			
		||||
            "1n71wb50qv2dmhjgw7azx5gigbrp19l2n3d41g9p05l5l0y1qg0q"))))
 | 
			
		||||
          (base32 "09xnf8hmld1fk8j33zwlz1qcxnjdx1ncbg62csic9va4m1wc2v1d"))))
 | 
			
		||||
   (build-system cmake-build-system)
 | 
			
		||||
   (arguments
 | 
			
		||||
      ;; No tests.
 | 
			
		||||
    `(#:tests? #f
 | 
			
		||||
      ;; Enable building of shared library.
 | 
			
		||||
      ;; Build the shared library instead of a static one.
 | 
			
		||||
      #:configure-flags `("-DBUILD_SHARED_LIBS=1")))
 | 
			
		||||
   (native-inputs
 | 
			
		||||
    (list pkg-config))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -104,6 +104,7 @@
 | 
			
		|||
  #:use-module (gnu packages sqlite)
 | 
			
		||||
  #:use-module (gnu packages statistics)
 | 
			
		||||
  #:use-module (gnu packages tcl)
 | 
			
		||||
  #:use-module (gnu packages tex)
 | 
			
		||||
  #:use-module (gnu packages textutils)
 | 
			
		||||
  #:use-module (gnu packages tls)
 | 
			
		||||
  #:use-module (gnu packages uglifyjs)
 | 
			
		||||
| 
						 | 
				
			
			@ -30466,7 +30467,26 @@ package online.")
 | 
			
		|||
    (properties `((upstream-name . "prereg")))
 | 
			
		||||
    (build-system r-build-system)
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
      (list r-rmarkdown))
 | 
			
		||||
      (list r-rmarkdown
 | 
			
		||||
            ;; The package provides a custom LaTex template in
 | 
			
		||||
            ;; inst/rmd/prereg_form.tex, which depends on these packages:
 | 
			
		||||
            texlive-amsmath
 | 
			
		||||
            texlive-booktabs
 | 
			
		||||
            texlive-etoolbox
 | 
			
		||||
            texlive-generic-iftex
 | 
			
		||||
            texlive-latex-fancyhdr
 | 
			
		||||
            texlive-latex-fancyvrb
 | 
			
		||||
            texlive-latex-geometry
 | 
			
		||||
            texlive-latex-graphics
 | 
			
		||||
            texlive-latex-threeparttable
 | 
			
		||||
            texlive-latex-titlesec
 | 
			
		||||
            texlive-latex-upquote
 | 
			
		||||
            texlive-listings
 | 
			
		||||
            texlive-polyglossia
 | 
			
		||||
            texlive-titling
 | 
			
		||||
            texlive-tools
 | 
			
		||||
            texlive-ulem
 | 
			
		||||
            (texlive-updmap.cfg (list texlive-amsfonts texlive-lm))))
 | 
			
		||||
    (home-page "https://github.com/crsh/prereg")
 | 
			
		||||
    (synopsis
 | 
			
		||||
      "R Markdown Templates to preregister Scientific Studies")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1160,7 +1160,7 @@ developed in C/C++ to MariaDB and MySQL databases.")
 | 
			
		|||
(define-public galera
 | 
			
		||||
  (package
 | 
			
		||||
    (name "galera")
 | 
			
		||||
    (version "26.4.10")
 | 
			
		||||
    (version "26.4.12")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
| 
						 | 
				
			
			@ -1169,7 +1169,7 @@ developed in C/C++ to MariaDB and MySQL databases.")
 | 
			
		|||
                    (recursive? #t)))
 | 
			
		||||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32 "1n6zhzwj713ixyqvcjn4ldlq0y9fxqgvmqv3cj3h4207v9lwlxxz"))))
 | 
			
		||||
               (base32 "0n4272mvr8a6h5prbhvl376asdp89ipix5yx5n6i1iiw9bs3v76l"))))
 | 
			
		||||
    (build-system cmake-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list check boost openssl))
 | 
			
		||||
| 
						 | 
				
			
			@ -1384,7 +1384,7 @@ pictures, sounds, or video.")
 | 
			
		|||
    (home-page "https://www.timescale.com/")
 | 
			
		||||
    (synopsis "Time-series extension for PostgreSQL")
 | 
			
		||||
    (description
 | 
			
		||||
     "TimescaleDB is an database designed to make SQL scalable for
 | 
			
		||||
     "TimescaleDB is a database designed to make SQL scalable for
 | 
			
		||||
time-series data.  It is engineered up from PostgreSQL and packaged as a
 | 
			
		||||
PostgreSQL extension, providing automatic partitioning across time and space
 | 
			
		||||
(partitioning key), as well as full SQL support.")
 | 
			
		||||
| 
						 | 
				
			
			@ -1889,7 +1889,7 @@ extremely small.")
 | 
			
		|||
                "1yinx39960y241vf2sknxj0dfz82a5m9gvklq5rw78k0nlyrjawa"))))
 | 
			
		||||
    (build-system perl-build-system)
 | 
			
		||||
    (synopsis "Database independent interface for Perl")
 | 
			
		||||
    (description "This package provides an database interface for Perl.")
 | 
			
		||||
    (description "This package provides a database interface for Perl.")
 | 
			
		||||
    (home-page "https://metacpan.org/release/DBI")
 | 
			
		||||
    (license license:perl-license)))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -3025,44 +3025,58 @@ development.")
 | 
			
		|||
(define-public python-pyodbc-c
 | 
			
		||||
  (package
 | 
			
		||||
    (name "python-pyodbc-c")
 | 
			
		||||
    (version "3.1.4")
 | 
			
		||||
    (version "3.1.5")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append "https://gitlab.com/daym/pyodbc-c/repository/"
 | 
			
		||||
                           "archive.tar.gz?ref=v" version))
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
       (uri (git-reference
 | 
			
		||||
             (url "https://gitlab.com/daym/pyodbc-c/")
 | 
			
		||||
             (commit (string-append "v" version))))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "05aq2297k779xidmxcwkrrxjvj1bh2q7d9a1rcjv6zr15y764ga9"))
 | 
			
		||||
       (file-name (string-append name "-" version ".tar.gz"))))
 | 
			
		||||
        (base32 "08y60c5sx0k953zfx0s2a155l8py968sb17ap9a9fg8bjnj783k8"))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list unixodbc))
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(;; No unit tests exist.
 | 
			
		||||
     `(;; The tests require a running SQL server that they don't help set up.
 | 
			
		||||
       #:tests? #f))
 | 
			
		||||
    (home-page "https://github.com/mkleehammer/pyodbc")
 | 
			
		||||
    (synopsis "Python ODBC Library")
 | 
			
		||||
    (home-page "https://gitlab.com/daym/pyodbc-c")
 | 
			
		||||
    (synopsis "Python ODBC Library written in C")
 | 
			
		||||
    (description "@code{python-pyodbc-c} provides a Python DB-API driver
 | 
			
		||||
for ODBC.")
 | 
			
		||||
for ODBC, similar to python-pyodbc but written in C.
 | 
			
		||||
 | 
			
		||||
It's designed to stand alone and not have other dependencies on other packages
 | 
			
		||||
or languages.  It uses only Python's built-in data types.")
 | 
			
		||||
    (license (license:x11-style "file://LICENSE.TXT"))))
 | 
			
		||||
 | 
			
		||||
(define-public python-pyodbc
 | 
			
		||||
  (package
 | 
			
		||||
    (name "python-pyodbc")
 | 
			
		||||
    (version "4.0.30")
 | 
			
		||||
    (version "4.0.32")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (pypi-uri "pyodbc" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0skjpraar6hcwsy82612bpj8nw016ncyvvq88j5syrikxgp5saw5"))
 | 
			
		||||
       (file-name (string-append name "-" version ".tar.gz"))))
 | 
			
		||||
        (base32 "0sqs0x2l5mk3yv0wwz3ya8yh5f4babihyhc8hjbf2m86b71z1rcv"))
 | 
			
		||||
       (modules '((guix build utils)))
 | 
			
		||||
       (snippet
 | 
			
		||||
        ;; Delete precompiled binaries.  The corresponding source is included.
 | 
			
		||||
        #~(for-each delete-file (find-files "." "\\.pyc$")))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list unixodbc))
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:tests? #f))                    ; no unit tests exist
 | 
			
		||||
     ;; XXX Tests fail with ‘Can't open lib 'SQL Server Native Client 10.0' :
 | 
			
		||||
     ;; file not found (0) (SQLDriverConnect)")’.
 | 
			
		||||
     (list #:tests? #f
 | 
			
		||||
           #:phases
 | 
			
		||||
           #~(modify-phases %standard-phases
 | 
			
		||||
               (replace 'check
 | 
			
		||||
                 (lambda* (#:key tests? #:allow-other-keys)
 | 
			
		||||
                   (when tests?
 | 
			
		||||
                     (invoke "python3" "tests3/test.py")))))))
 | 
			
		||||
    (home-page "https://github.com/mkleehammer/pyodbc")
 | 
			
		||||
    (synopsis "Python ODBC Library")
 | 
			
		||||
    (description "@code{python-pyodbc} provides a Python DB-API driver
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -74,7 +74,7 @@
 | 
			
		|||
(define-public diffoscope
 | 
			
		||||
  (package
 | 
			
		||||
    (name "diffoscope")
 | 
			
		||||
    (version "215")
 | 
			
		||||
    (version "216")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -83,7 +83,7 @@
 | 
			
		|||
             (commit version)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "16pyqbyrfsxjnpmr9913x2brz3mxplhz62rxwix1c0p7afwjw835"))
 | 
			
		||||
        (base32 "066w4mcrjvymwii5j5hylcslpz18wgd5afl11z1n3588j8c1zw15"))
 | 
			
		||||
       (patches
 | 
			
		||||
        (search-patches "diffoscope-fix-llvm-test.patch"))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -93,6 +93,7 @@
 | 
			
		|||
  #:use-module (guix build-system gnu)
 | 
			
		||||
  #:use-module (guix build-system glib-or-gtk)
 | 
			
		||||
  #:use-module (guix build-system go)
 | 
			
		||||
  #:use-module (guix build-system meson)
 | 
			
		||||
  #:use-module (guix build-system python)
 | 
			
		||||
  #:use-module (guix build-system trivial)
 | 
			
		||||
  #:use-module (guix build-system scons)
 | 
			
		||||
| 
						 | 
				
			
			@ -883,7 +884,7 @@ passphrases.")
 | 
			
		|||
(define-public ndctl
 | 
			
		||||
  (package
 | 
			
		||||
    (name "ndctl")
 | 
			
		||||
    (version "72.1")
 | 
			
		||||
    (version "73")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
| 
						 | 
				
			
			@ -892,12 +893,16 @@ passphrases.")
 | 
			
		|||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1lvrhlad5n43bal053ihgbwr1k4ka2kscrjwr9rs5xnf2vy7204v"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
                "19kp1ly74bj7gavs03q7caci0lqr0rsi5y45zx5m8in4h19xk1kb"))))
 | 
			
		||||
    (build-system meson-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list #:configure-flags
 | 
			
		||||
           #~(list "--disable-asciidoctor" ; use docbook-xsl instead
 | 
			
		||||
                   "--without-systemd")
 | 
			
		||||
           #~(list (string-append "-Drootprefix=" #$output)
 | 
			
		||||
                   (string-append "-Dbashcompletiondir=" #$output
 | 
			
		||||
                                  "/share/bash-completion/completions")
 | 
			
		||||
                   (string-append "-Dsysconfdir=" #$output "/etc")
 | 
			
		||||
                   "-Dasciidoctor=disabled" ; use docbook-xsl instead
 | 
			
		||||
                   "-Dsystemd=disabled")
 | 
			
		||||
           #:phases
 | 
			
		||||
           #~(modify-phases %standard-phases
 | 
			
		||||
               (add-after 'unpack 'fix-version
 | 
			
		||||
| 
						 | 
				
			
			@ -910,17 +915,11 @@ passphrases.")
 | 
			
		|||
                   (substitute* "git-version-gen"
 | 
			
		||||
                     (("/bin/sh") (which "sh")))
 | 
			
		||||
                   (substitute* "git-version"
 | 
			
		||||
                     (("/bin/bash") (which "bash"))))))
 | 
			
		||||
           #:make-flags
 | 
			
		||||
           #~(list (string-append "BASH_COMPLETION_DIR=" #$output
 | 
			
		||||
                                  "/share/bash-completion/completions"))))
 | 
			
		||||
                     (("/bin/bash") (which "bash"))))))))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list asciidoc
 | 
			
		||||
           automake
 | 
			
		||||
           autoconf
 | 
			
		||||
           bash-completion
 | 
			
		||||
           docbook-xsl
 | 
			
		||||
           libtool
 | 
			
		||||
           libxml2
 | 
			
		||||
           pkg-config
 | 
			
		||||
           xmlto
 | 
			
		||||
| 
						 | 
				
			
			@ -940,7 +939,7 @@ passphrases.")
 | 
			
		|||
libnvdimm (non-volatile memory device) sub-system in the Linux kernel.")
 | 
			
		||||
    ;; COPYING says LGPL2.1, but many source files are GPL2 so that's
 | 
			
		||||
    ;; the effective license.  Note that some files under ccan/ are
 | 
			
		||||
    ;; covered by BSD-3 or public domain, see the individual folders.
 | 
			
		||||
    ;; covered by BSD-3 or public domain, see the individual directories.
 | 
			
		||||
    (license license:gpl2)))
 | 
			
		||||
 | 
			
		||||
(define-public dmraid
 | 
			
		||||
| 
						 | 
				
			
			@ -1253,7 +1252,7 @@ that support this feature).")
 | 
			
		|||
(define-public memkind
 | 
			
		||||
  (package
 | 
			
		||||
    (name "memkind")
 | 
			
		||||
    (version "1.12.0")
 | 
			
		||||
    (version "1.13.0")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
| 
						 | 
				
			
			@ -1261,7 +1260,7 @@ that support this feature).")
 | 
			
		|||
                    (commit (string-append "v" version))))
 | 
			
		||||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32 "1s52vl2jlrdc8nxnvf993x9mcag56qxcaniiijhmsv42a26hvjk4"))))
 | 
			
		||||
               (base32 "0zbil6xqmsrnh773ihxyfna6pvvxv3kczdb3g863ssflwwvv7h4w"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list ;; memkind patched jemalloc to add je_arenalookupx,
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -323,8 +323,8 @@ experience for your users, your family and yourself")
 | 
			
		|||
             vala                       ;for Vala bindings
 | 
			
		||||
             ;; For tests
 | 
			
		||||
             dbus
 | 
			
		||||
             ;; python-wrapper
 | 
			
		||||
             ;; python-pygobject
 | 
			
		||||
             python-wrapper
 | 
			
		||||
             python-pygobject
 | 
			
		||||
             which
 | 
			
		||||
             yelp-tools))
 | 
			
		||||
      ;; Required by liblightdm-gobject-1.pc.
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -113,6 +113,7 @@
 | 
			
		|||
;;; Copyright © 2022 Peter Polidoro <peter@polidoro.io>
 | 
			
		||||
;;; Copyright © 2022 Luis Felipe López Acevedo <luis.felipe.la@protonmail.com>
 | 
			
		||||
;;; Copyright © 2022 Thomas Albers Raviola <thomas@thomaslabs.org>
 | 
			
		||||
;;; Copyright © 2022 Haider Mirza <haider@haider.gq>
 | 
			
		||||
;;;
 | 
			
		||||
;;; This file is part of GNU Guix.
 | 
			
		||||
;;;
 | 
			
		||||
| 
						 | 
				
			
			@ -247,7 +248,7 @@
 | 
			
		|||
(define-public emacs-geiser
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-geiser")
 | 
			
		||||
    (version "0.23.1")
 | 
			
		||||
    (version "0.23.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -256,7 +257,7 @@
 | 
			
		|||
             (commit version)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1lvnk71fb4qkh8a7h7spsdhmc9nnj1lwgp9wr3c2fgzjqsl62kgr"))))
 | 
			
		||||
        (base32 "0p5cwx0xwva4ajgj8hnrk8bx6n3hv1z7aqs4zivp81crnq4077yw"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     '(#:phases
 | 
			
		||||
| 
						 | 
				
			
			@ -278,7 +279,7 @@
 | 
			
		|||
     (list texinfo))
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
     (list emacs-project emacs-transient))
 | 
			
		||||
    (home-page "https://nongnu.org/geiser/")
 | 
			
		||||
    (home-page "https://www.nongnu.org/geiser/")
 | 
			
		||||
    (synopsis "Collection of Emacs modes for Scheme hacking")
 | 
			
		||||
    (description
 | 
			
		||||
     "Geiser is a collection of Emacs major and minor modes that conspire with
 | 
			
		||||
| 
						 | 
				
			
			@ -296,7 +297,7 @@ e.g. emacs-geiser-guile for Guile.")
 | 
			
		|||
(define-public emacs-geiser-guile
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-geiser-guile")
 | 
			
		||||
    (version "0.23")
 | 
			
		||||
    (version "0.23.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -305,13 +306,19 @@ e.g. emacs-geiser-guile for Guile.")
 | 
			
		|||
             (commit version)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1v9f90smnk41nz1pjy5mwz199y8p4qar3llgaryzxr7s4wg2v9wi"))))
 | 
			
		||||
        (base32 "18m5ldj4r4c2hxgvv5b4azl90r8az1kn5f3s913h971asyv4wx06"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list
 | 
			
		||||
      #:include #~(cons "^src/" %default-include)
 | 
			
		||||
      #:phases
 | 
			
		||||
      #~(modify-phases %standard-phases
 | 
			
		||||
          (add-after 'unpack 'patch-geiser-guile-binary
 | 
			
		||||
            (lambda* (#:key inputs #:allow-other-keys)
 | 
			
		||||
              (substitute* "geiser-guile.el"
 | 
			
		||||
                (("\\(t \"guile\")")
 | 
			
		||||
                 (format #f "(t ~s)"
 | 
			
		||||
                         (search-input-file inputs "bin/guile"))))))
 | 
			
		||||
          (add-after 'make-autoloads 'patch-autoloads
 | 
			
		||||
            (lambda _
 | 
			
		||||
              (substitute* (string-append (elpa-directory #$output)
 | 
			
		||||
| 
						 | 
				
			
			@ -321,11 +328,9 @@ e.g. emacs-geiser-guile for Guile.")
 | 
			
		|||
                (("\\(geiser-activate-implementation .*\\)" all)
 | 
			
		||||
                 (string-append
 | 
			
		||||
                  "(eval-after-load 'geiser-impl '" all ")"))))))))
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list guile-3.0))
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
     (list emacs-geiser))
 | 
			
		||||
    (home-page "https://nongnu.org/geiser/")
 | 
			
		||||
    (inputs (list guile-3.0))
 | 
			
		||||
    (propagated-inputs (list emacs-geiser))
 | 
			
		||||
    (home-page "https://www.nongnu.org/geiser/")
 | 
			
		||||
    (synopsis "Guile Scheme support for Geiser")
 | 
			
		||||
    (description
 | 
			
		||||
     "This package adds support for the Guile Scheme implementation to Geiser,
 | 
			
		||||
| 
						 | 
				
			
			@ -358,34 +363,57 @@ using geiser.")
 | 
			
		|||
      (home-page "https://github.com/xiaohanyu/ac-geiser"))))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-geiser-gauche
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-geiser-gauche")
 | 
			
		||||
    (version "0.0.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
       (uri (git-reference
 | 
			
		||||
             (url "https://gitlab.com/emacs-geiser/gauche.git")
 | 
			
		||||
             (commit version)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0rxncnzx7qgcpvc8nz0sd8r0hwrplazzraahdwhbpq0q6z8ywqgg"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:include (cons "^geiser-gauche\\.scm$" %default-include)))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list emacs-geiser))
 | 
			
		||||
    (home-page "https://gitlab.com/emacs-geiser/gauche")
 | 
			
		||||
    (synopsis "Gauche Scheme support for Geiser")
 | 
			
		||||
    (description
 | 
			
		||||
     "This package adds support for the Gauche Scheme implementation to Geiser,
 | 
			
		||||
  ;; The latest 0.14 release has an unbound variable (geiser-scheme-dir).
 | 
			
		||||
  (let ((commit "96fa06aaeef18cc1b3b519e83dbb7be09eeb0d07")
 | 
			
		||||
        (revision "0"))
 | 
			
		||||
    (package
 | 
			
		||||
      (name "emacs-geiser-gauche")
 | 
			
		||||
      (version (git-version "0.14" revision commit))
 | 
			
		||||
      (source
 | 
			
		||||
       (origin
 | 
			
		||||
         (method git-fetch)
 | 
			
		||||
         (uri (git-reference
 | 
			
		||||
               (url "https://gitlab.com/emacs-geiser/gauche.git")
 | 
			
		||||
               (commit commit)))
 | 
			
		||||
         (file-name (git-file-name name version))
 | 
			
		||||
         (sha256
 | 
			
		||||
          (base32 "1ppracwfl1snq0ifdlyxpdlv7fbn3pbxm1hd1ihgqivii5nbya9r"))))
 | 
			
		||||
      (build-system emacs-build-system)
 | 
			
		||||
      (arguments
 | 
			
		||||
       (list
 | 
			
		||||
        #:include '(cons "^geiser-gauche\\.scm$" %default-include)
 | 
			
		||||
        #:phases
 | 
			
		||||
        #~(modify-phases %standard-phases
 | 
			
		||||
            (add-after 'unpack 'patch-geiser-gauche-binary
 | 
			
		||||
              (lambda* (#:key inputs #:allow-other-keys)
 | 
			
		||||
                (emacs-substitute-sexps "geiser-gauche.el"
 | 
			
		||||
                  ("geiser-custom--defcustom geiser-gauche-binary"
 | 
			
		||||
                   (search-input-file inputs "bin/gosh")))))
 | 
			
		||||
            (add-after 'make-autoloads 'patch-autoloads
 | 
			
		||||
              (lambda _
 | 
			
		||||
                (substitute* (string-append (elpa-directory #$output)
 | 
			
		||||
                                            "/geiser-gauche-autoloads.el")
 | 
			
		||||
                  ;; Activating implementations fails when Geiser is not yet
 | 
			
		||||
                  ;; loaded, so let's defer that until it is.
 | 
			
		||||
                  (("\\(geiser-activate-implementation .*\\)" all)
 | 
			
		||||
                   (string-append
 | 
			
		||||
                    "(eval-after-load 'geiser-impl '" all ")"))
 | 
			
		||||
                  (("\\(geiser-implementation-extension .*\\)" all)
 | 
			
		||||
                   (string-append
 | 
			
		||||
                    "(eval-after-load 'geiser-impl '" all ")"))))))))
 | 
			
		||||
      (inputs (list gauche))
 | 
			
		||||
      (propagated-inputs (list emacs-geiser))
 | 
			
		||||
      (home-page "https://gitlab.com/emacs-geiser/gauche")
 | 
			
		||||
      (synopsis "Gauche Scheme support for Geiser")
 | 
			
		||||
      (description
 | 
			
		||||
       "This package adds support for the Gauche Scheme implementation to Geiser,
 | 
			
		||||
a generic Scheme interaction mode for the GNU Emacs editor.")
 | 
			
		||||
    (license license:expat)))
 | 
			
		||||
      (license license:expat))))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-geiser-racket
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-geiser-racket")
 | 
			
		||||
    (version "0.16")
 | 
			
		||||
    (version "1.0")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -394,13 +422,19 @@ a generic Scheme interaction mode for the GNU Emacs editor.")
 | 
			
		|||
             (commit version)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1aqsvmk1hi7kc3j4h8xlza7c6rwm71v98fv5wpw8kmyj9vsp49wx"))))
 | 
			
		||||
        (base32 "04gwd9qa0785zfr6m9a5443ilgvyz05l06cb1waicf83sgp8xl32"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list
 | 
			
		||||
      #:include #~(cons "^src/" %default-include)
 | 
			
		||||
      #:phases
 | 
			
		||||
      #~(modify-phases %standard-phases
 | 
			
		||||
          (add-after 'unpack 'patch-geiser-racket-binary
 | 
			
		||||
            (lambda* (#:key inputs #:allow-other-keys)
 | 
			
		||||
              (substitute* "geiser-racket.el"
 | 
			
		||||
                (("\\(t \"racket\")")
 | 
			
		||||
                 (format #f "(t ~s)"
 | 
			
		||||
                         (search-input-file inputs "bin/racket"))))))
 | 
			
		||||
          (add-after 'make-autoloads 'patch-autoloads
 | 
			
		||||
            (lambda _
 | 
			
		||||
              (substitute* (string-append (elpa-directory #$output)
 | 
			
		||||
| 
						 | 
				
			
			@ -410,14 +444,12 @@ a generic Scheme interaction mode for the GNU Emacs editor.")
 | 
			
		|||
                (("\\(geiser-activate-implementation .*\\)" all)
 | 
			
		||||
                 (string-append
 | 
			
		||||
                  "(eval-after-load 'geiser-impl '" all ")"))
 | 
			
		||||
	        (("\\(geiser-implementation-extension .*\\)" all)
 | 
			
		||||
                (("\\(geiser-implementation-extension .*\\)" all)
 | 
			
		||||
                 (string-append
 | 
			
		||||
                  "(eval-after-load 'geiser-impl '" all ")"))))))))
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list racket))
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
     (list emacs-geiser))
 | 
			
		||||
    (home-page "https://nongnu.org/geiser/")
 | 
			
		||||
    (inputs (list racket))
 | 
			
		||||
    (propagated-inputs (list emacs-geiser))
 | 
			
		||||
    (home-page "https://www.nongnu.org/geiser/")
 | 
			
		||||
    (synopsis "Racket support for Geiser")
 | 
			
		||||
    (description
 | 
			
		||||
     "This package adds support for the Racket implementation to Geiser,
 | 
			
		||||
| 
						 | 
				
			
			@ -537,6 +569,27 @@ editing @file{.hgignore} files used by the Mercurial version control
 | 
			
		|||
system.")
 | 
			
		||||
      (license license:gpl3+))))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-platformio-mode
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-platformio-mode")
 | 
			
		||||
    (version "0.3.0")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
                    (url "https://github.com/ZachMassia/PlatformIO-Mode")
 | 
			
		||||
                    (commit (string-append "v" version))))
 | 
			
		||||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0ian50v9vaz7kqzn20bhqadq50h0l3zhjkmniinpz4q9klh7drh9"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (propagated-inputs (list emacs-async emacs-projectile))
 | 
			
		||||
    (home-page "https://github.com/zachmassia/platformio-mode")
 | 
			
		||||
    (synopsis "Minor mode for building and uploading PlatformIO projects")
 | 
			
		||||
    (description "This package provices an Emacs minor mode for building and
 | 
			
		||||
uploading PlatformIO projects.")
 | 
			
		||||
    (license license:gpl3+)))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-hyperbole
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-hyperbole")
 | 
			
		||||
| 
						 | 
				
			
			@ -1377,7 +1430,7 @@ organizing remote Go repository clones.")
 | 
			
		|||
(define-public emacs-ghub
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-ghub")
 | 
			
		||||
    (version "3.5.5")
 | 
			
		||||
    (version "3.5.6")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -1386,7 +1439,7 @@ organizing remote Go repository clones.")
 | 
			
		|||
             (commit (string-append "v" version))))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1px27nh4cr3r16qmvig72jdirjzllvm2m4dzm59kfznhg3rf7vj0"))))
 | 
			
		||||
        (base32 "1pw1rjrvvanlcxv3rb64s2p646zfaipp7h7v8djlrrnlgy6mwbqd"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list
 | 
			
		||||
| 
						 | 
				
			
			@ -3916,7 +3969,7 @@ evaluations.  The entry point is @code{M-x build-farm} command.")
 | 
			
		|||
(define-public emacs-d-mode
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-d-mode")
 | 
			
		||||
    (version "2.0.11")
 | 
			
		||||
    (version "2.0.12")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -3925,7 +3978,7 @@ evaluations.  The entry point is @code{M-x build-farm} command.")
 | 
			
		|||
             (commit version)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0vkl470vvmxap8ca773a0jvjvalmvdbbax3qvgjdclp54ml75al4"))))
 | 
			
		||||
        (base32 "0mwd412d2kha8avkyhvvkh8r7an859xk18f7phgx7kj989pr3xkr"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
     (list emacs-undercover))
 | 
			
		||||
| 
						 | 
				
			
			@ -4136,16 +4189,16 @@ in the center.")
 | 
			
		|||
(define-public emacs-undo-tree
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-undo-tree")
 | 
			
		||||
    (version "0.8.1")
 | 
			
		||||
    (version "0.8.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
       (uri (git-reference
 | 
			
		||||
             (url "https://gitlab.com/tsc25/undo-tree")
 | 
			
		||||
             (commit (string-append "release/" version))))
 | 
			
		||||
             (commit "42aab056e37e033816b2d192f9121b89410b958e"))) ; no 0.8.2 tag
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1khkwrrbwaimspc013n4k9mpv8g302r0zkrsqnza2x1d3qznn08y"))))
 | 
			
		||||
        (base32 "1xvkxc078b4z5zqwndz6jcv4ga8yd2ci32v7l8pdvqjmz7fq7bfz"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
     (list emacs-queue))
 | 
			
		||||
| 
						 | 
				
			
			@ -11233,14 +11286,14 @@ of its name.")
 | 
			
		|||
(define-public emacs-rainbow-mode
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-rainbow-mode")
 | 
			
		||||
    (version "1.0.5")
 | 
			
		||||
    (version "1.0.6")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append "https://elpa.gnu.org/packages/"
 | 
			
		||||
                           "rainbow-mode-" version ".el"))
 | 
			
		||||
                           "rainbow-mode-" version ".tar"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "159fps843k5pap9k04a7ll1k3gw6d9c6w08lq4bbc3lqg78aa2l9"))))
 | 
			
		||||
        (base32 "04v73cm1cap19vwc8lqsw0rmfr9v7r3swc4wgxnk9dnzxi9j2527"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (home-page "https://elpa.gnu.org/packages/rainbow-mode.html")
 | 
			
		||||
    (synopsis "Colorize color names in buffers")
 | 
			
		||||
| 
						 | 
				
			
			@ -12826,7 +12879,7 @@ passive voice.")
 | 
			
		|||
(define-public emacs-org
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-org")
 | 
			
		||||
    (version "9.5.3")
 | 
			
		||||
    (version "9.5.4")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -12835,7 +12888,7 @@ passive voice.")
 | 
			
		|||
             (commit (string-append "release_" version))))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0h1n6gqxv3kj3y98n5547rhpw4qnp03lfar79npb4paqgpxf76wb"))))
 | 
			
		||||
        (base32 "1an866kkn5r84933s04agm1c3197kza2pvk8lqp2xzpjd09ba394"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:tests? #t
 | 
			
		||||
| 
						 | 
				
			
			@ -18587,6 +18640,28 @@ files, allowing for actions to be performed based on search criteria.")
 | 
			
		|||
Chinese to English.")
 | 
			
		||||
    (license license:gpl3+)))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-org-auto-tangle
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-org-auto-tangle")
 | 
			
		||||
    (version "0.4.1")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
                    (url "https://github.com/yilkalargaw/org-auto-tangle")
 | 
			
		||||
                    (commit version)))
 | 
			
		||||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1zb7vcmhmjiqpbbhqrqci689rnpn10p985cs5jk9sgg66xsbrgs3"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (propagated-inputs (list emacs-async))
 | 
			
		||||
    (home-page "https://github.com/yilkalargaw/org-auto-tangle")
 | 
			
		||||
    (synopsis "Automatically tangle code blocks on save")
 | 
			
		||||
    (description
 | 
			
		||||
     "@code{org-auto-tangle} allows you to automatically tangle code blocks
 | 
			
		||||
whenever saving an @code{org-mode} file.")
 | 
			
		||||
    (license license:bsd-2)))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-org-auto-expand
 | 
			
		||||
  (let ((commit "4938d5f6460e2f8f051ba9ac000b291bfa43ef62")
 | 
			
		||||
        (revision "1"))
 | 
			
		||||
| 
						 | 
				
			
			@ -19494,16 +19569,14 @@ or expressions with SVG rounded box labels that are fully customizable.")
 | 
			
		|||
(define-public emacs-kind-icon
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-kind-icon")
 | 
			
		||||
    (version "0.1.4")
 | 
			
		||||
    (version "0.1.5")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append
 | 
			
		||||
             "https://elpa.gnu.org/packages/kind-icon-"
 | 
			
		||||
             version
 | 
			
		||||
             ".tar"))
 | 
			
		||||
       (uri (string-append "https://elpa.gnu.org/packages/kind-icon-"
 | 
			
		||||
                           version ".tar"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "00pyvnq4dx51l2wbhvm6k6cx5xmy32j4h1lkr5kr8s3j5w83ip25"))))
 | 
			
		||||
        (base32 "0qajj89vkgc9gbgff6akzll53jy0kgkv6c9jvwpl32rbg8v0wp63"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (propagated-inputs (list emacs-svg-lib))
 | 
			
		||||
    (home-page "https://github.com/jdtsmith/kind-icon")
 | 
			
		||||
| 
						 | 
				
			
			@ -27826,7 +27899,7 @@ Emacs that integrate with major modes like Org-mode.")
 | 
			
		|||
(define-public emacs-modus-themes
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-modus-themes")
 | 
			
		||||
    (version "2.4.0")
 | 
			
		||||
    (version "2.4.1")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -27835,7 +27908,7 @@ Emacs that integrate with major modes like Org-mode.")
 | 
			
		|||
             (commit version)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0ia6r68fqbv64r9jm92vmqypq15nl8yy07n18hqrfbp1fy47zds1"))))
 | 
			
		||||
        (base32 "0b4y8dzyc9qwwaf2ngqiwyfcnhwlr49kxhc96laqk20lvjlfsrnx"))))
 | 
			
		||||
    (native-inputs (list texinfo))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
| 
						 | 
				
			
			@ -27937,28 +28010,30 @@ and it should work well with 256 color terminals.")
 | 
			
		|||
    (license license:gpl3+)))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-dimmer
 | 
			
		||||
  (package
 | 
			
		||||
    (name "emacs-dimmer")
 | 
			
		||||
    (version "0.4.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
       (uri (git-reference
 | 
			
		||||
             (url "https://github.com/gonewest818/dimmer.el")
 | 
			
		||||
             (commit version)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "0dw0qh5hm1x76s5cqxvylvmjgy0jwy11xm258g6kmx6w1k6r1d2l"))))
 | 
			
		||||
    (build-system emacs-build-system)
 | 
			
		||||
    (home-page "https://github.com/gonewest818/dimmer.el")
 | 
			
		||||
    (synopsis "Visually highlights the selected buffer in Emacs")
 | 
			
		||||
    (description "Dimmer provides a minor mode that indicates which buffer is
 | 
			
		||||
  (let ((commit "2f915b100044e09dd647b22085e1696249c4b115")
 | 
			
		||||
        (revision "1"))
 | 
			
		||||
    (package
 | 
			
		||||
      (name "emacs-dimmer")
 | 
			
		||||
      (version (git-version "0.4.2" revision commit))
 | 
			
		||||
      (source
 | 
			
		||||
       (origin
 | 
			
		||||
         (method git-fetch)
 | 
			
		||||
         (uri (git-reference
 | 
			
		||||
               (url "https://github.com/gonewest818/dimmer.el")
 | 
			
		||||
               (commit commit)))
 | 
			
		||||
         (file-name (git-file-name name version))
 | 
			
		||||
         (sha256
 | 
			
		||||
          (base32
 | 
			
		||||
           "00y6645zjary1sz7517qy5pjwfm5ipsc46sypmdygin65hbbc8wg"))))
 | 
			
		||||
      (build-system emacs-build-system)
 | 
			
		||||
      (home-page "https://github.com/gonewest818/dimmer.el")
 | 
			
		||||
      (synopsis "Visually highlights the selected buffer in Emacs")
 | 
			
		||||
      (description "Dimmer provides a minor mode that indicates which buffer is
 | 
			
		||||
currently active by dimming the faces in the other buffers.  It does this
 | 
			
		||||
nondestructively, and computes the dimmed faces dynamically such that your
 | 
			
		||||
overall color scheme is shown in a muted form without requiring you to define
 | 
			
		||||
what is a \"dim\" version of every face.")
 | 
			
		||||
    (license license:gpl3+)))
 | 
			
		||||
      (license license:gpl3+))))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-minibuffer-line
 | 
			
		||||
  (package
 | 
			
		||||
| 
						 | 
				
			
			@ -31512,6 +31587,59 @@ zoomable and moveable map display, display of tracks and POIs from GPX files,
 | 
			
		|||
parallel fetching of tiles with cURL, and more.")
 | 
			
		||||
    (license license:gpl3+)))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-corfu-terminal
 | 
			
		||||
  ;; Upstream does not tag releases, version taken from package header.
 | 
			
		||||
  (let ((commit "7c5a8a1c07b6c1a41b358b083d5bf7773701d26b")
 | 
			
		||||
        (revision "0"))
 | 
			
		||||
    (package
 | 
			
		||||
      (name "emacs-corfu-terminal")
 | 
			
		||||
      (version (git-version "0.4" revision commit))
 | 
			
		||||
      (source
 | 
			
		||||
       (origin
 | 
			
		||||
         (method git-fetch)
 | 
			
		||||
         (uri
 | 
			
		||||
          (git-reference
 | 
			
		||||
           (url "https://codeberg.org/akib/emacs-corfu-terminal")
 | 
			
		||||
           (commit commit)))
 | 
			
		||||
         (file-name (git-file-name name version))
 | 
			
		||||
         (sha256
 | 
			
		||||
          (base32 "0pk5vfcz8w4hiqrwzwpxdjzlbhla0bw7a1h6v0mqxad0j9y7v3nw"))))
 | 
			
		||||
      (build-system emacs-build-system)
 | 
			
		||||
      (propagated-inputs (list emacs-corfu emacs-popon))
 | 
			
		||||
      (home-page "https://codeberg.org/akib/emacs-corfu-terminal/")
 | 
			
		||||
      (synopsis "Replace corfu child frames with popups")
 | 
			
		||||
      (description
 | 
			
		||||
       "This package replaces the child frames @code{emacs-corfu} uses
 | 
			
		||||
with popups, which also work in the terminal.")
 | 
			
		||||
      (license license:gpl3+))))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-corfu-doc-terminal
 | 
			
		||||
  ;; Upstream does not tag releases, version taken from package header.
 | 
			
		||||
  (let ((commit "d8945c64b52d76e864b767b3048674f222daf80b")
 | 
			
		||||
        (revision "0"))
 | 
			
		||||
    (package
 | 
			
		||||
      (name "emacs-corfu-doc-terminal")
 | 
			
		||||
      (version (git-version "0.5" revision commit))
 | 
			
		||||
      (source
 | 
			
		||||
       (origin
 | 
			
		||||
         (method git-fetch)
 | 
			
		||||
         (uri
 | 
			
		||||
          (git-reference
 | 
			
		||||
           (url "https://codeberg.org/akib/emacs-corfu-doc-terminal")
 | 
			
		||||
           (commit commit)))
 | 
			
		||||
         (file-name (git-file-name name version))
 | 
			
		||||
         (sha256
 | 
			
		||||
          (base32 "0j0dd8np5x93wic22bc5i9h7bq2gj700n4fh11dzzgsj14lv2r5k"))))
 | 
			
		||||
      (build-system emacs-build-system)
 | 
			
		||||
      (propagated-inputs
 | 
			
		||||
       (list emacs-corfu emacs-corfu-doc emacs-corfu-terminal emacs-popon))
 | 
			
		||||
      (home-page "https://codeberg.org/akib/emacs-corfu-doc-terminal/")
 | 
			
		||||
      (synopsis "Replace corfu docmentation child frames with popups")
 | 
			
		||||
      (description
 | 
			
		||||
       "This package replaces the child frames @code{emacs-corfu-doc} uses
 | 
			
		||||
with popups, which also work in the terminal.")
 | 
			
		||||
      (license license:gpl3+))))
 | 
			
		||||
 | 
			
		||||
(define-public emacs-popon
 | 
			
		||||
  ;; Upstream does not tag releases.  The commit below matches the version
 | 
			
		||||
  ;; bump.
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1840,7 +1840,8 @@ an embedded event driven algorithm.")
 | 
			
		|||
    (arguments
 | 
			
		||||
     (substitute-keyword-arguments (package-arguments libngspice)
 | 
			
		||||
       ((#:configure-flags flags)
 | 
			
		||||
        `(delete "--with-ngshared" ,flags))
 | 
			
		||||
        `(cons "--with-readline=yes"
 | 
			
		||||
               (delete "--with-ngshared" ,flags)))
 | 
			
		||||
       ((#:phases phases)
 | 
			
		||||
        `(modify-phases ,phases
 | 
			
		||||
           (add-after 'unpack 'delete-include-files
 | 
			
		||||
| 
						 | 
				
			
			@ -2740,21 +2741,19 @@ export filters.")
 | 
			
		|||
(define-public meshlab
 | 
			
		||||
  (package
 | 
			
		||||
    (name "meshlab")
 | 
			
		||||
    (version "2020.06")
 | 
			
		||||
    (version "2022.02")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
                    (url "https://github.com/cnr-isti-vclab/meshlab")
 | 
			
		||||
                    (commit (string-append "Meshlab-" version))
 | 
			
		||||
                    (commit (string-append "MeshLab-" version))
 | 
			
		||||
                    (recursive? #t)))
 | 
			
		||||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32 "1cgx24wxh2ah5pff51rcrk6x8qcdjpkxcdak7s4cfzmxvjlshydd"))))
 | 
			
		||||
               (base32 "0dkh9qw9z2160s6gjiv0a601kp6hvl66cplvi8rfc892zcykgiwd"))))
 | 
			
		||||
    (build-system cmake-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list qtbase-5
 | 
			
		||||
           qtscript
 | 
			
		||||
           qtxmlpatterns
 | 
			
		||||
           mesa
 | 
			
		||||
           glu
 | 
			
		||||
           glew
 | 
			
		||||
| 
						 | 
				
			
			@ -2764,34 +2763,29 @@ export filters.")
 | 
			
		|||
           libfreenect
 | 
			
		||||
           lib3ds
 | 
			
		||||
           openctm
 | 
			
		||||
           ;; FIXME: Compilation fails with system qhull:
 | 
			
		||||
           ;; https://github.com/cnr-isti-vclab/meshlab/issues/678
 | 
			
		||||
           ;; ("qhull" ,qhull)
 | 
			
		||||
           ))
 | 
			
		||||
           qhull))
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:tests? #f                                ; Has no tests
 | 
			
		||||
       #:phases
 | 
			
		||||
       (modify-phases %standard-phases
 | 
			
		||||
         (add-after 'unpack 'go-to-source-dir
 | 
			
		||||
           (lambda _ (chdir "src") #t))
 | 
			
		||||
         (add-after 'install 'move-files
 | 
			
		||||
           (lambda* (#:key outputs #:allow-other-keys)
 | 
			
		||||
             (let ((lib (string-append (assoc-ref outputs "out")
 | 
			
		||||
                                       "/lib")))
 | 
			
		||||
               (rename-file
 | 
			
		||||
                (string-append lib "/meshlab/libmeshlab-common.so")
 | 
			
		||||
                (string-append lib "/libmeshlab-common.so"))
 | 
			
		||||
               #t))))))
 | 
			
		||||
     (list #:tests? #f                  ; Has no tests
 | 
			
		||||
           #:configure-flags
 | 
			
		||||
           #~(list (string-append "-DCMAKE_MODULE_LINKER_FLAGS=-Wl,-rpath="
 | 
			
		||||
                                  #$output "/lib/meshlab")
 | 
			
		||||
                   (string-append "-DCMAKE_SHARED_LINKER_FLAGS=-Wl,-rpath="
 | 
			
		||||
                                  #$output "/lib/meshlab")
 | 
			
		||||
                   (string-append "-DCMAKE_EXE_LINKER_FLAGS=-Wl,-rpath="
 | 
			
		||||
                                  #$output "/lib/meshlab"))
 | 
			
		||||
           #:phases
 | 
			
		||||
           #~(modify-phases %standard-phases
 | 
			
		||||
               (add-after 'unpack 'go-to-source-dir
 | 
			
		||||
                 (lambda _ (chdir "src"))))))
 | 
			
		||||
    (synopsis "3D triangular mesh processing and editing software")
 | 
			
		||||
    (home-page "https://www.meshlab.net/")
 | 
			
		||||
    (description "MeshLab is a system for the processing and
 | 
			
		||||
editing of unstructured large 3D triangular meshes.  It is aimed to help the
 | 
			
		||||
processing of the typical not-so-small unstructured models arising in 3D
 | 
			
		||||
scanning, providing a set of tools for editing, cleaning, healing, inspecting,
 | 
			
		||||
rendering and converting this kind of meshes.  These tools include MeshLab
 | 
			
		||||
proper, a versatile program with a graphical user interface, and meshlabserver,
 | 
			
		||||
a program that can perform mesh processing tasks in batch mode, without a
 | 
			
		||||
GUI.")
 | 
			
		||||
    (description "MeshLab is a system for the processing and editing of large,
 | 
			
		||||
unstructured, 3D triangular meshes.  It is aimed to help the processing of the
 | 
			
		||||
typical, not-so-small unstructured models arising in 3D scanning, providing a
 | 
			
		||||
set of tools for editing, cleaning, healing, inspecting, rendering and
 | 
			
		||||
converting this kind of meshes.  These tools include MeshLab proper, a
 | 
			
		||||
versatile program with a graphical user interface, and @samp{meshlabserver}, a
 | 
			
		||||
program that can perform mesh processing tasks in batch mode, without a GUI.")
 | 
			
		||||
    (license license:gpl3+)))
 | 
			
		||||
 | 
			
		||||
(define-public poke
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -2200,7 +2200,7 @@ Every puzzle has a complete solution, although there may be more than one.")
 | 
			
		|||
   (license license:gpl2+)))
 | 
			
		||||
 | 
			
		||||
(define-public retux
 | 
			
		||||
  (let ((release "1.5")
 | 
			
		||||
  (let ((release "1.6.1")
 | 
			
		||||
        (revision 0))
 | 
			
		||||
    (package
 | 
			
		||||
      (name "retux")
 | 
			
		||||
| 
						 | 
				
			
			@ -2216,7 +2216,7 @@ Every puzzle has a complete solution, although there may be more than one.")
 | 
			
		|||
                                    release "-src.zip"))
 | 
			
		||||
                (sha256
 | 
			
		||||
                 (base32
 | 
			
		||||
                  "1yima7s36hn2kh5h08lczc5iid8jbdxk7x1g5ms6knaznzj7rll3"))))
 | 
			
		||||
                  "1bkyfm0h4kys0x7c1340fnkhgnmcrf4j2xjm250r5w8q6l7v2wj4"))))
 | 
			
		||||
      (build-system python-build-system)
 | 
			
		||||
      (arguments
 | 
			
		||||
       `(#:tests? #f                    ; no check target
 | 
			
		||||
| 
						 | 
				
			
			@ -2237,12 +2237,11 @@ Every puzzle has a complete solution, although there may be more than one.")
 | 
			
		|||
                    (string-append "\"" data "\",")))
 | 
			
		||||
 | 
			
		||||
                 (copy-file "retux.py" (string-append bin "/retux"))
 | 
			
		||||
                 (copy-recursively "data" data)
 | 
			
		||||
                 #t))))))
 | 
			
		||||
                 (copy-recursively "data" data)))))))
 | 
			
		||||
      (native-inputs
 | 
			
		||||
       (list unzip))
 | 
			
		||||
      (inputs
 | 
			
		||||
       (list python-sge python-six python-xsge))
 | 
			
		||||
       (list python-sge python-xsge))
 | 
			
		||||
      (home-page "https://retux-game.github.io/")
 | 
			
		||||
      (synopsis "Action platformer game")
 | 
			
		||||
      (description
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -9,7 +9,7 @@
 | 
			
		|||
;;; Copyright © 2017 Petter <petter@mykolab.ch>
 | 
			
		||||
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
 | 
			
		||||
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 | 
			
		||||
;;; Copyright © 2019, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 | 
			
		||||
;;; Copyright © 2019 Giacomo Leidi <goodoldpaul@autistici.org>
 | 
			
		||||
;;; Copyright © 2019, 2020, 2021 Marius Bakke <marius@gnu.org>
 | 
			
		||||
;;; Copyright © 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
 | 
			
		||||
| 
						 | 
				
			
			@ -176,6 +176,23 @@ or through unencrypted TCP/IP suitable for use behind a firewall with
 | 
			
		|||
shared NFS home directories.")
 | 
			
		||||
    (license license:gpl2+)))                     ; or Academic Free License 2.1
 | 
			
		||||
 | 
			
		||||
;;; This variant is used for the Jami service: it provides an entry point to
 | 
			
		||||
;;; further customize the configuration of the D-Bus instance run by the
 | 
			
		||||
;;; jami-dbus-session service.
 | 
			
		||||
(define-public dbus-for-jami
 | 
			
		||||
  (hidden-package
 | 
			
		||||
   (package/inherit dbus
 | 
			
		||||
     (name "dbus-for-jami")
 | 
			
		||||
     (arguments
 | 
			
		||||
      (substitute-keyword-arguments (package-arguments dbus)
 | 
			
		||||
        ((#:phases phases)
 | 
			
		||||
         `(modify-phases ,phases
 | 
			
		||||
            (add-after 'unpack 'customize-config
 | 
			
		||||
              (lambda _
 | 
			
		||||
                (substitute* "bus/session.conf.in"
 | 
			
		||||
                  (("@SYSCONFDIR_FROM_PKGDATADIR@/dbus-1/session-local.conf")
 | 
			
		||||
                   "/var/run/jami/session-local.conf")))))))))))
 | 
			
		||||
 | 
			
		||||
(define glib
 | 
			
		||||
  (package
 | 
			
		||||
    (name "glib")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -16,6 +16,7 @@
 | 
			
		|||
;;; Copyright © 2021, 2022 Justin Veilleux <terramorpha@cock.li>
 | 
			
		||||
;;; Copyright © 2021 Attila Lendvai <attila@lendvai.name>
 | 
			
		||||
;;; Copyright © 2021 Charles Jackson <charles.b.jackson@protonmail.com>
 | 
			
		||||
;;; Copyright © 2022 Eric Bavier <bavier@posteo.net>
 | 
			
		||||
;;;
 | 
			
		||||
;;; This file is part of GNU Guix.
 | 
			
		||||
;;;
 | 
			
		||||
| 
						 | 
				
			
			@ -37,6 +38,7 @@
 | 
			
		|||
  #:use-module (guix build-system gnu)
 | 
			
		||||
  #:use-module (guix build-system copy)
 | 
			
		||||
  #:use-module (guix build-system meson)
 | 
			
		||||
  #:use-module (guix build-system python)
 | 
			
		||||
  #:use-module (guix gexp)
 | 
			
		||||
  #:use-module (guix git-download)
 | 
			
		||||
  #:use-module (guix packages)
 | 
			
		||||
| 
						 | 
				
			
			@ -50,6 +52,7 @@
 | 
			
		|||
  #:use-module (gnu packages base)
 | 
			
		||||
  #:use-module (gnu packages bash)
 | 
			
		||||
  #:use-module (gnu packages build-tools)
 | 
			
		||||
  #:use-module (gnu packages check)
 | 
			
		||||
  #:use-module (gnu packages gettext)
 | 
			
		||||
  #:use-module (gnu packages glib)
 | 
			
		||||
  #:use-module (gnu packages gnome)
 | 
			
		||||
| 
						 | 
				
			
			@ -58,6 +61,7 @@
 | 
			
		|||
  #:use-module (gnu packages image)
 | 
			
		||||
  #:use-module (gnu packages pkg-config)
 | 
			
		||||
  #:use-module (gnu packages python)
 | 
			
		||||
  #:use-module (gnu packages python-science)
 | 
			
		||||
  #:use-module (gnu packages python-xyz)
 | 
			
		||||
  #:use-module (gnu packages ssh)
 | 
			
		||||
  #:use-module (gnu packages tls)
 | 
			
		||||
| 
						 | 
				
			
			@ -217,6 +221,86 @@ simple and consistent.")
 | 
			
		|||
and a few extra features.")
 | 
			
		||||
    (license license:gpl3)))
 | 
			
		||||
 | 
			
		||||
(define-public gnome-plots
 | 
			
		||||
  (package
 | 
			
		||||
    (name "gnome-plots")
 | 
			
		||||
    (version "0.6.2")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
                    (url "https://github.com/alexhuntley/Plots")
 | 
			
		||||
                    (commit (string-append "v" version))))
 | 
			
		||||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "168wcsrkmvq79xmwvbq615msd4q0rg7f57xqicidnr78jx4x37rd"))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list bash-minimal                 ; for wrap-program
 | 
			
		||||
           gtk+
 | 
			
		||||
           pango
 | 
			
		||||
           python-freetype-py
 | 
			
		||||
           python-jinja2
 | 
			
		||||
           python-lark-parser
 | 
			
		||||
           python-numpy
 | 
			
		||||
           python-pycairo
 | 
			
		||||
           python-pyglm
 | 
			
		||||
           python-pygobject
 | 
			
		||||
           python-pyopengl))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list python-pytest))
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list
 | 
			
		||||
      #:imported-modules `((guix build glib-or-gtk-build-system)
 | 
			
		||||
                           ,@%python-build-system-modules)
 | 
			
		||||
      #:modules '((guix build python-build-system)
 | 
			
		||||
                  ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:)
 | 
			
		||||
                  (guix build utils)
 | 
			
		||||
                  (ice-9 match))
 | 
			
		||||
      #:phases
 | 
			
		||||
      #~(modify-phases %standard-phases
 | 
			
		||||
          (add-before 'build 'adjust-lark-requirement
 | 
			
		||||
            (lambda _
 | 
			
		||||
              (substitute* "setup.py"
 | 
			
		||||
                (("lark") "lark-parser"))))
 | 
			
		||||
          (add-after 'install 'install-more
 | 
			
		||||
            (lambda _
 | 
			
		||||
              (let* ((datadir (string-append #$output "/share"))
 | 
			
		||||
                     (help (string-append datadir "/help"))
 | 
			
		||||
                     (icons (string-append datadir "/icons/hicolor")))
 | 
			
		||||
                (map (lambda (filename)
 | 
			
		||||
                       (match (string-split filename #\/)
 | 
			
		||||
                         ((_ lang dir ... name)
 | 
			
		||||
                          (install-file filename
 | 
			
		||||
                                        (string-join (cons* help lang "plots" dir)
 | 
			
		||||
                                                     "/")))))
 | 
			
		||||
                     (find-files "help"))
 | 
			
		||||
                (install-file "res/com.github.alexhuntley.Plots.desktop"
 | 
			
		||||
                              (string-append datadir "/applications/"))
 | 
			
		||||
                (install-file "res/com.github.alexhuntley.Plots.svg"
 | 
			
		||||
                              (string-append icons "/scalable/apps/"))
 | 
			
		||||
                (install-file "res/com.github.alexhuntley.Plots-symbolic.svg"
 | 
			
		||||
                              (string-append icons "/symbolic/apps/")))))
 | 
			
		||||
          (replace 'check
 | 
			
		||||
            (lambda* (#:key tests? #:allow-other-keys)
 | 
			
		||||
              (when tests?
 | 
			
		||||
                (invoke "pytest" "-vv"))))
 | 
			
		||||
          (add-after 'wrap 'gi-wrap
 | 
			
		||||
            (lambda _
 | 
			
		||||
              (let ((prog (string-append #$output "/bin/plots")))
 | 
			
		||||
                (wrap-program prog
 | 
			
		||||
                  `("GI_TYPELIB_PATH" = (,(getenv "GI_TYPELIB_PATH")))))))
 | 
			
		||||
          (add-after 'wrap 'glib-or-gtk-wrap
 | 
			
		||||
            (assoc-ref glib-or-gtk:%standard-phases 'glib-or-gtk-wrap)))))
 | 
			
		||||
    (home-page "https://apps.gnome.org/app/com.github.alexhuntley.Plots/")
 | 
			
		||||
    (synopsis "Simple graph plotting")
 | 
			
		||||
    (description "Plots makes it easy to visualise mathematical formulae.  In
 | 
			
		||||
addition to basic arithmetic operations, it supports trigonometric,
 | 
			
		||||
hyperbolic, exponential, and logarithmic functions, as well as arbitrary sums
 | 
			
		||||
and products.  Plots is designed to integrate well with the GNOME desktop and
 | 
			
		||||
takes advantage of modern hardware using OpenGL.")
 | 
			
		||||
    (license license:gpl3+)))
 | 
			
		||||
 | 
			
		||||
(define-public gnome-shell-extension-appindicator
 | 
			
		||||
  (package
 | 
			
		||||
    (name "gnome-shell-extension-appindicator")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -6694,7 +6694,7 @@ a secret password store, an adblocker, and a modern UI.")
 | 
			
		|||
(define-public epiphany
 | 
			
		||||
  (package
 | 
			
		||||
    (name "epiphany")
 | 
			
		||||
    (version "41.2")
 | 
			
		||||
    (version "42.2")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (string-append "mirror://gnome/sources/epiphany/"
 | 
			
		||||
| 
						 | 
				
			
			@ -6702,65 +6702,61 @@ a secret password store, an adblocker, and a modern UI.")
 | 
			
		|||
                                  "epiphany-" version ".tar.xz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0k7b22zq3z1kllzqxgwsvwb1lp0j6rjb3k1hvhna3i573wc4mpji"))
 | 
			
		||||
              (patches
 | 
			
		||||
               (search-patches "epiphany-update-libportal-usage.patch"))))
 | 
			
		||||
                "0b8rhns3b58f8dnp83mm1g933aqf88d8wrfyyp7jq3fihvw2rh4j"))))
 | 
			
		||||
    (build-system meson-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:glib-or-gtk? #t
 | 
			
		||||
       #:phases
 | 
			
		||||
       (modify-phases %standard-phases
 | 
			
		||||
         (add-after 'unpack 'skip-gtk-update-icon-cache
 | 
			
		||||
           ;; Don't create 'icon-theme.cache'.
 | 
			
		||||
           (lambda _
 | 
			
		||||
             (substitute* "post_install.py"
 | 
			
		||||
               (("gtk-update-icon-cache") "true"))))
 | 
			
		||||
         (add-after 'unpack 'disable-failing-tests
 | 
			
		||||
           (lambda _
 | 
			
		||||
             (substitute* "tests/meson.build"
 | 
			
		||||
               ;; embed_shell fails, because webkitgtk apparently no longer
 | 
			
		||||
               ;; supports overriding the ftp schema web_app_utils fails due
 | 
			
		||||
               ;; to missing network access.
 | 
			
		||||
               (("(embed_shell|web_app_utils)_test,")
 | 
			
		||||
                "find_program('sh'), args: ['-c', 'exit 77'],"))))
 | 
			
		||||
         (add-before 'check 'pre-check
 | 
			
		||||
           (lambda _
 | 
			
		||||
             ;; Tests require a running X server.
 | 
			
		||||
             (system "Xvfb :1 &")
 | 
			
		||||
             (setenv "DISPLAY" ":1"))))
 | 
			
		||||
       #:configure-flags
 | 
			
		||||
       ;; Otherwise, the RUNPATH will lack the final 'epiphany' path component.
 | 
			
		||||
       (list (string-append "-Dc_link_args=-Wl,-rpath="
 | 
			
		||||
                            (assoc-ref %outputs "out") "/lib/epiphany"))))
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
     (list dconf))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     `(("desktop-file-utils" ,desktop-file-utils) ; for update-desktop-database
 | 
			
		||||
       ("glib:bin" ,glib "bin") ; for glib-mkenums
 | 
			
		||||
       ("intltool" ,intltool)
 | 
			
		||||
       ("itstool" ,itstool)
 | 
			
		||||
       ("pkg-config" ,pkg-config)
 | 
			
		||||
       ("xmllint" ,libxml2)
 | 
			
		||||
       ("xorg-server" ,xorg-server-for-tests)))
 | 
			
		||||
    (inputs
 | 
			
		||||
     `(("avahi" ,avahi)
 | 
			
		||||
       ("gcr" ,gcr)
 | 
			
		||||
       ("librsvg" ,librsvg) ; for loading SVG files
 | 
			
		||||
       ("glib-networking" ,glib-networking)
 | 
			
		||||
       ("gnome-desktop" ,gnome-desktop)
 | 
			
		||||
       ("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
 | 
			
		||||
       ("json-glib" ,json-glib)
 | 
			
		||||
       ("iso-codes" ,iso-codes)
 | 
			
		||||
       ("libarchive" ,libarchive)
 | 
			
		||||
       ("libdazzle" ,libdazzle)
 | 
			
		||||
       ("libhandy" ,libhandy)
 | 
			
		||||
       ("libnotify" ,libnotify)
 | 
			
		||||
       ("libportal" ,libportal)
 | 
			
		||||
       ("libsecret" ,libsecret)
 | 
			
		||||
       ("libxslt" ,libxslt)
 | 
			
		||||
       ("nettle" ,nettle) ; for hogweed
 | 
			
		||||
       ("sqlite" ,sqlite)
 | 
			
		||||
       ("webkitgtk" ,webkitgtk-with-libsoup2)))
 | 
			
		||||
     (list
 | 
			
		||||
      #:glib-or-gtk? #t
 | 
			
		||||
      #:phases
 | 
			
		||||
      #~(modify-phases %standard-phases
 | 
			
		||||
          (add-after 'unpack 'skip-gtk-update-icon-cache
 | 
			
		||||
            ;; Don't create 'icon-theme.cache'.
 | 
			
		||||
            (lambda _
 | 
			
		||||
              (substitute* "post_install.py"
 | 
			
		||||
                (("gtk-update-icon-cache") "true"))))
 | 
			
		||||
          (add-after 'unpack 'disable-failing-tests
 | 
			
		||||
            (lambda _
 | 
			
		||||
              (substitute* "tests/meson.build"
 | 
			
		||||
                ;; embed_shell fails, because webkitgtk apparently no longer
 | 
			
		||||
                ;; supports overriding the ftp schema web_app_utils fails due
 | 
			
		||||
                ;; to missing network access.
 | 
			
		||||
                (("(embed_shell|web_app_utils)_test,")
 | 
			
		||||
                 "find_program('sh'), args: ['-c', 'exit 77'],"))))
 | 
			
		||||
          (add-before 'check 'pre-check
 | 
			
		||||
            (lambda _
 | 
			
		||||
              ;; Tests require a running X server.
 | 
			
		||||
              (system "Xvfb :1 &")
 | 
			
		||||
              (setenv "DISPLAY" ":1"))))
 | 
			
		||||
      #:configure-flags
 | 
			
		||||
      ;; Otherwise, the RUNPATH will lack the final 'epiphany' path component.
 | 
			
		||||
      #~(list (string-append "-Dc_link_args=-Wl,-rpath="
 | 
			
		||||
                             #$output "/lib/epiphany"))))
 | 
			
		||||
    (propagated-inputs (list dconf))
 | 
			
		||||
    (native-inputs (list desktop-file-utils ; for update-desktop-database
 | 
			
		||||
                         `(,glib "bin") ; for glib-mkenums
 | 
			
		||||
                         intltool
 | 
			
		||||
                         itstool
 | 
			
		||||
                         pkg-config
 | 
			
		||||
                         libxml2
 | 
			
		||||
                         xorg-server-for-tests))
 | 
			
		||||
    (inputs (list avahi
 | 
			
		||||
                  gcr
 | 
			
		||||
                  librsvg ; for loading SVG files
 | 
			
		||||
                  glib-networking
 | 
			
		||||
                  gnome-desktop
 | 
			
		||||
                  gsettings-desktop-schemas
 | 
			
		||||
                  json-glib
 | 
			
		||||
                  iso-codes
 | 
			
		||||
                  libarchive
 | 
			
		||||
                  libdazzle
 | 
			
		||||
                  libhandy
 | 
			
		||||
                  libnotify
 | 
			
		||||
                  libportal
 | 
			
		||||
                  libsecret
 | 
			
		||||
                  libxslt
 | 
			
		||||
                  nettle ; for hogweed
 | 
			
		||||
                  sqlite
 | 
			
		||||
                  webkitgtk-with-libsoup2))
 | 
			
		||||
    (home-page "https://wiki.gnome.org/Apps/Web")
 | 
			
		||||
    (synopsis "GNOME web browser")
 | 
			
		||||
    (description
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -9784,3 +9784,62 @@ Features:
 | 
			
		|||
     "@code{go-github-com-go-chi-chi-v5} is an HTTP router that lets the user
 | 
			
		||||
decompose request handling into many smaller layers.")
 | 
			
		||||
    (license license:expat)))
 | 
			
		||||
 | 
			
		||||
(define-public go-sigs-k8s-io-yaml
 | 
			
		||||
  (package
 | 
			
		||||
    (name "go-sigs-k8s-io-yaml")
 | 
			
		||||
    (version "1.3.0")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
                    (url "https://github.com/kubernetes-sigs/yaml")
 | 
			
		||||
                    (commit (string-append "v" version))))
 | 
			
		||||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0qxs0ppqwqrfqs4aywyn1h28xh1qlj5ds4drmygaz1plrxj02dqn"))))
 | 
			
		||||
    (build-system go-build-system)
 | 
			
		||||
    (arguments '(#:import-path "sigs.k8s.io/yaml"))
 | 
			
		||||
    (propagated-inputs (list go-gopkg-in-yaml-v2 go-github-com-davecgh-go-spew))
 | 
			
		||||
    (home-page "https://sigs.k8s.io/yaml")
 | 
			
		||||
    (synopsis "YAML marshaling and unmarshaling support for Go")
 | 
			
		||||
    (description
 | 
			
		||||
     "This package provides a Go library that first converts YAML to JSON
 | 
			
		||||
using @code{go-yaml} and then uses @code{json.Marshal} and
 | 
			
		||||
@code{json.Unmarshal} to convert to or from the struct. This means that
 | 
			
		||||
it effectively reuses the JSON struct tags as well as the custom JSON
 | 
			
		||||
methods @code{MarshalJSON} and @code{UnmarshalJSON} unlike
 | 
			
		||||
@code{go-yaml}.
 | 
			
		||||
 | 
			
		||||
kubernetes-sigs/yaml is a permanent fork of
 | 
			
		||||
@url{https://github.com/ghodss/yaml,ghodss/yaml}.")
 | 
			
		||||
    (license (list license:expat license:bsd-3))))
 | 
			
		||||
 | 
			
		||||
(define-public go-github-com-google-go-jsonnet
 | 
			
		||||
  (package
 | 
			
		||||
    (name "go-github-com-google-go-jsonnet")
 | 
			
		||||
    (version "0.18.0")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
                    (url "https://github.com/google/go-jsonnet")
 | 
			
		||||
                    (commit (string-append "v" version))))
 | 
			
		||||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1dghqygag123zkgh2vrnq82cdag5z0p03v3489pwhs06r5g27wm3"))))
 | 
			
		||||
    (build-system go-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     '(#:import-path "github.com/google/go-jsonnet/cmd/jsonnet"
 | 
			
		||||
       #:unpack-path "github.com/google/go-jsonnet"))
 | 
			
		||||
    (propagated-inputs (list go-sigs-k8s-io-yaml go-gopkg-in-yaml-v2
 | 
			
		||||
                             go-github-com-sergi-go-diff
 | 
			
		||||
                             go-github-com-fatih-color))
 | 
			
		||||
    (home-page "https://github.com/google/go-jsonnet")
 | 
			
		||||
    (synopsis "Go implementation of Jsonnet")
 | 
			
		||||
    (description
 | 
			
		||||
     "This package provides an implementation of the @url{http://jsonnet.org/,
 | 
			
		||||
Jsonnet} data templating language in Go.  It is a feature-complete,
 | 
			
		||||
production-ready implementation, compatible with the original Jsonnet C++
 | 
			
		||||
implementation.")
 | 
			
		||||
    (license license:asl2.0)))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
;;; GNU Guix --- Functional package management for GNU
 | 
			
		||||
;;; Copyright © 2017, 2018, 2019, 2020, 2022 Ricardo Wurmus <rekado@elephly.net>
 | 
			
		||||
;;; Copyright © 2018 Joshua Sierles, Nextjournal <joshua@nextjournal.com>
 | 
			
		||||
;;; Copyright © 2018, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2018, 2020, 2022 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2019, 2021, 2022 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;; Copyright © 2019 Andreas Enge <andreas@enge.fr>
 | 
			
		||||
;;; Copyright © 2020 Alexander Krotov <krotov@iitp.ru>
 | 
			
		||||
| 
						 | 
				
			
			@ -143,7 +143,7 @@ more.")
 | 
			
		|||
  (package
 | 
			
		||||
    (inherit igraph)
 | 
			
		||||
    (name "python-igraph")
 | 
			
		||||
    (version "0.9.10")
 | 
			
		||||
    (version "0.9.11")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              ;; The PyPI archive lacks tests.
 | 
			
		||||
| 
						 | 
				
			
			@ -153,7 +153,7 @@ more.")
 | 
			
		|||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "06qvwmiw2klk3bg8g5af0ppjwrm9kzy4595w5d06qh2v3gq0svbk"))))
 | 
			
		||||
                "1xlr0cnf3a1vs9n2psvgrmjhld4n1xr79kkjqzby4pxxyzk1bydn"))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -15,7 +15,7 @@
 | 
			
		|||
;;; Copyright © 2016 Patrick Hetu <patrick.hetu@auf.org>
 | 
			
		||||
;;; Copyright © 2016 Nikita <nikita@n0.is>
 | 
			
		||||
;;; Copyright © 2017 Roel Janssen <roel@gnu.org>
 | 
			
		||||
;;; Copyright © 2017–2021 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2017–2022 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2017, 2019, 2020 Marius Bakke <mbakke@fastmail.com>
 | 
			
		||||
;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
 | 
			
		||||
;;; Copyright © 2018, 2020 Arun Isaac <arunisaac@systemreboot.net>
 | 
			
		||||
| 
						 | 
				
			
			@ -1563,14 +1563,14 @@ guile-gnome-platform (GNOME developer libraries), and guile-gtksourceview.")
 | 
			
		|||
(define-public cairomm
 | 
			
		||||
  (package
 | 
			
		||||
    (name "cairomm")
 | 
			
		||||
    (version "1.16.0")
 | 
			
		||||
    (version "1.16.1")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (string-append "https://www.cairographics.org/releases/"
 | 
			
		||||
                                  name "-" version ".tar.xz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1ya4y7qa000cjawqwswbqv26y5icfkmhs5iiiil4dxgrqn91923y"))))
 | 
			
		||||
                "1im2yjzvjfx8s7cal9kwq23z936kppfmyag2zsnbim4dx7c60q3g"))))
 | 
			
		||||
    (build-system meson-build-system)
 | 
			
		||||
    (outputs '("out" "doc"))
 | 
			
		||||
    (arguments
 | 
			
		||||
| 
						 | 
				
			
			@ -1588,18 +1588,17 @@ guile-gnome-platform (GNOME developer libraries), and guile-gtksourceview.")
 | 
			
		|||
               (mkdir-p (string-append doc "/share"))
 | 
			
		||||
               (rename-file
 | 
			
		||||
                (string-append out "/share/doc")
 | 
			
		||||
                (string-append doc "/share/doc"))
 | 
			
		||||
               #t))))))
 | 
			
		||||
                (string-append doc "/share/doc"))))))))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     `(("boost" ,boost)
 | 
			
		||||
       ("dot" ,graphviz)
 | 
			
		||||
       ("doxygen" ,doxygen)
 | 
			
		||||
       ("mm-common" ,mm-common)
 | 
			
		||||
       ("perl" ,perl)
 | 
			
		||||
       ("pkg-config" ,pkg-config)
 | 
			
		||||
       ("xsltproc" ,libxslt)))
 | 
			
		||||
     (list boost
 | 
			
		||||
           doxygen
 | 
			
		||||
           graphviz
 | 
			
		||||
           mm-common
 | 
			
		||||
           perl
 | 
			
		||||
           pkg-config
 | 
			
		||||
           libxslt))
 | 
			
		||||
    (inputs
 | 
			
		||||
     `(("fontconfig" ,fontconfig)))
 | 
			
		||||
     (list fontconfig))
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
     (list libsigc++ cairo))
 | 
			
		||||
    (home-page "https://cairographics.org/")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -435,7 +435,16 @@ integrates with various databases on GUI toolkits such as Qt and Tk.")
 | 
			
		|||
       ((#:configure-flags flags)
 | 
			
		||||
        ;; Otherwise, the build would fail with: "error: invalid conversion
 | 
			
		||||
        ;; from ‘const char*’ to ‘char*’ [-fpermissive]".
 | 
			
		||||
        `(cons "-DCMAKE_CXX_FLAGS=-fpermissive" ,flags))))))
 | 
			
		||||
        `(cons "-DCMAKE_CXX_FLAGS=-fpermissive" ,flags))
 | 
			
		||||
       ((#:phases phases)
 | 
			
		||||
        #~(modify-phases #$phases
 | 
			
		||||
            (add-after 'unpack 'remove-kernel-version
 | 
			
		||||
              ;; Avoid embedding the kernel version for reproducible builds
 | 
			
		||||
              (lambda _
 | 
			
		||||
                (substitute*
 | 
			
		||||
                    "ThirdParty/hdf5/vtkhdf5/config/cmake/libhdf5.settings.cmake.in"
 | 
			
		||||
                  (("Host system: \\@CMAKE_HOST_SYSTEM\\@")
 | 
			
		||||
                   "Host system: @CMAKE_SYSTEM_NAME@"))))))))))
 | 
			
		||||
 | 
			
		||||
(define-public opencv
 | 
			
		||||
  (package
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -151,7 +151,7 @@ irssi, but graphical.")
 | 
			
		|||
(define-public irssi
 | 
			
		||||
  (package
 | 
			
		||||
    (name "irssi")
 | 
			
		||||
    (version "1.2.3")
 | 
			
		||||
    (version "1.4.1")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (string-append "https://github.com/irssi/irssi/"
 | 
			
		||||
| 
						 | 
				
			
			@ -159,7 +159,7 @@ irssi, but graphical.")
 | 
			
		|||
                                  version ".tar.xz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "17vninwcdfxw39xl2q55qircckckjk2xlvkvlwgj5lhlxppvyix6"))))
 | 
			
		||||
                "00bmwkpzhqqnsajakk7dviap1i8s89375kwpdyxg65ms3ds94xka"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:phases
 | 
			
		||||
| 
						 | 
				
			
			@ -172,8 +172,7 @@ irssi, but graphical.")
 | 
			
		|||
                       (string-append "--prefix=" out)
 | 
			
		||||
                       (string-append "--enable-true-color")
 | 
			
		||||
                       (string-append "--with-proxy")
 | 
			
		||||
                       (string-append "--with-socks")
 | 
			
		||||
                       (string-append "--with-bot")))))
 | 
			
		||||
                       (string-append "--with-socks")))))
 | 
			
		||||
         (add-before 'check 'set-home
 | 
			
		||||
           (lambda _
 | 
			
		||||
             (setenv "HOME" (getcwd)))))))
 | 
			
		||||
| 
						 | 
				
			
			@ -182,10 +181,14 @@ irssi, but graphical.")
 | 
			
		|||
    (native-inputs
 | 
			
		||||
     (list pkg-config))
 | 
			
		||||
    (home-page "https://irssi.org/")
 | 
			
		||||
    (synopsis "Terminal-based IRC client")
 | 
			
		||||
    (synopsis "Extensible terminal-based IRC client")
 | 
			
		||||
    (description
 | 
			
		||||
     "Irssi is a terminal based IRC client for UNIX systems.  It also supports
 | 
			
		||||
SILC and ICB protocols via plugins.")
 | 
			
		||||
     "Irssi is a text terminal-based @acronym{IRC, Internet relay chat} client.
 | 
			
		||||
It is completely themable and extensible through Perl scripts, of which many
 | 
			
		||||
have already been written by the community.
 | 
			
		||||
 | 
			
		||||
Plug-ins add support for other protocols like @acronym{SILC, Secure Internet Live
 | 
			
		||||
Conferencing} and @acronym{ICB, Internet Citizen's Band}.")
 | 
			
		||||
    (license license:gpl2+)))
 | 
			
		||||
 | 
			
		||||
(define-public weechat
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -3,7 +3,7 @@
 | 
			
		|||
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
 | 
			
		||||
;;; Copyright © 2016, 2017 Roel Janssen <roel@gnu.org>
 | 
			
		||||
;;; Copyright © 2017, 2019, 2021 Carlo Zancanaro <carlo@zancanaro.id.au>
 | 
			
		||||
;;; Copyright © 2017-2021 Julien Lepiller <julien@lepiller.eu>
 | 
			
		||||
;;; Copyright © 2017-2022 Julien Lepiller <julien@lepiller.eu>
 | 
			
		||||
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
 | 
			
		||||
;;; Copyright © 2016, 2017, 2018 Alex Vong <alexvong1995@gmail.com>
 | 
			
		||||
;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
| 
						 | 
				
			
			@ -4371,6 +4371,14 @@ from source tags and class annotations.")))
 | 
			
		|||
             (copy-recursively "src/main/resources"
 | 
			
		||||
                               "build/classes/")
 | 
			
		||||
             #t))
 | 
			
		||||
         (add-before 'build 'fix-jdom
 | 
			
		||||
           (lambda _
 | 
			
		||||
             ;; The newer version of jdom now sets multiple features by default
 | 
			
		||||
             ;; that are not supported.
 | 
			
		||||
             ;; Skip these features
 | 
			
		||||
             (substitute* "src/main/java/org/codehaus/plexus/metadata/merge/MXParser.java"
 | 
			
		||||
               (("throw new XmlPullParserException\\(\"unsupporte feature \"\\+name\\);")
 | 
			
		||||
                "// skip"))))
 | 
			
		||||
         (add-before 'build 'reinstate-cli
 | 
			
		||||
           ;; The CLI was removed in 2.1.0, but we still need it to build some
 | 
			
		||||
           ;; maven dependencies, and some parts of maven itself. We can't use
 | 
			
		||||
| 
						 | 
				
			
			@ -4537,6 +4545,14 @@ from source tags and class annotations.")))
 | 
			
		|||
             (copy-recursively "src/main/resources"
 | 
			
		||||
                               "build/classes/")
 | 
			
		||||
             #t))
 | 
			
		||||
         (add-before 'build 'fix-jdom
 | 
			
		||||
           (lambda _
 | 
			
		||||
             ;; The newer version of jdom now sets multiple features by default
 | 
			
		||||
             ;; that are not supported.
 | 
			
		||||
             ;; Skip these features
 | 
			
		||||
             (substitute* "src/main/java/org/codehaus/plexus/metadata/merge/MXParser.java"
 | 
			
		||||
               (("throw new XmlPullParserException\\(\"unsupporte feature \"\\+name\\);")
 | 
			
		||||
                "// skip"))))
 | 
			
		||||
         (add-before 'check 'fix-test-location
 | 
			
		||||
           (lambda _
 | 
			
		||||
             (substitute* '("src/test/java/org/codehaus/plexus/metadata/DefaultComponentDescriptorWriterTest.java"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -351,17 +351,17 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
 | 
			
		|||
;; The current "stable" kernels. That is, the most recently released major
 | 
			
		||||
;; versions that are still supported upstream.
 | 
			
		||||
 | 
			
		||||
(define-public linux-libre-5.17-version "5.17.12")
 | 
			
		||||
(define-public linux-libre-5.17-version "5.17.14")
 | 
			
		||||
(define-public linux-libre-5.17-gnu-revision "gnu")
 | 
			
		||||
(define deblob-scripts-5.17
 | 
			
		||||
  (linux-libre-deblob-scripts
 | 
			
		||||
   linux-libre-5.17-version
 | 
			
		||||
   linux-libre-5.17-gnu-revision
 | 
			
		||||
   (base32 "08ip5g827f30qzb3j2l19zkbdqv00sij46nbrjg75h5kkasdbfgr")
 | 
			
		||||
   (base32 "1zd4ds6ha4a2acqnalp234r2m9rz9p30qmy1aqri78i06aw7flwn")))
 | 
			
		||||
   (base32 "1654fibbwnbcgnikn1qqa5igd2j90kslbb3pshph5wpj052cvgjy")))
 | 
			
		||||
(define-public linux-libre-5.17-pristine-source
 | 
			
		||||
  (let ((version linux-libre-5.17-version)
 | 
			
		||||
        (hash (base32 "0yr8xfds5l1s3lk8qk67mgy0l4yh2jfvjc7xwrfws3ci020ss9a2")))
 | 
			
		||||
        (hash (base32 "0r2skbgxzw42cn29mr7i9w7fczzxhc1lx3xvri44ljjyfdqn7r0b")))
 | 
			
		||||
   (make-linux-libre-source version
 | 
			
		||||
                            (%upstream-linux-source version hash)
 | 
			
		||||
                            deblob-scripts-5.17)))
 | 
			
		||||
| 
						 | 
				
			
			@ -369,37 +369,37 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
 | 
			
		|||
;; The "longterm" kernels — the older releases with long-term upstream support.
 | 
			
		||||
;; Here are the support timelines:
 | 
			
		||||
;; <https://www.kernel.org/category/releases.html>
 | 
			
		||||
(define-public linux-libre-5.15-version "5.15.44")
 | 
			
		||||
(define-public linux-libre-5.15-version "5.15.46")
 | 
			
		||||
(define-public linux-libre-5.15-gnu-revision "gnu")
 | 
			
		||||
(define deblob-scripts-5.15
 | 
			
		||||
  (linux-libre-deblob-scripts
 | 
			
		||||
   linux-libre-5.15-version
 | 
			
		||||
   linux-libre-5.15-gnu-revision
 | 
			
		||||
   (base32 "1n57mz5agvf1d0ggbg080d7hvx8p9y0iqxkq4ypg10a7n96zy7y5")
 | 
			
		||||
   (base32 "0gs92qbpvirwd02rpwwnja7771z2azbiy9ppy9ynpr14lxmzxnnh")))
 | 
			
		||||
   (base32 "17xsn91h0c2d8igpzgmjm1g58nfpihlhgg9wm8zbfyd5g4airs8f")))
 | 
			
		||||
(define-public linux-libre-5.15-pristine-source
 | 
			
		||||
  (let ((version linux-libre-5.15-version)
 | 
			
		||||
        (hash (base32 "1p1jz0lxmzyj0c51afqghylg9kblk8zmlw92zq6bsn37wlwbrylv")))
 | 
			
		||||
        (hash (base32 "0srp0wypl24gf5yz91mpk1c2kllabq6wvby1wqrrbdwvfx35figb")))
 | 
			
		||||
   (make-linux-libre-source version
 | 
			
		||||
                            (%upstream-linux-source version hash)
 | 
			
		||||
                            deblob-scripts-5.15)))
 | 
			
		||||
 | 
			
		||||
(define-public linux-libre-5.10-version "5.10.119")
 | 
			
		||||
(define-public linux-libre-5.10-version "5.10.121")
 | 
			
		||||
(define-public linux-libre-5.10-gnu-revision "gnu1")
 | 
			
		||||
(define deblob-scripts-5.10
 | 
			
		||||
  (linux-libre-deblob-scripts
 | 
			
		||||
   linux-libre-5.10-version
 | 
			
		||||
   linux-libre-5.10-gnu-revision
 | 
			
		||||
   (base32 "0mw7qn77y9c6wrnw4rjvf75cpm1w6n1aqqhf8cnghcb97p2yxxrf")
 | 
			
		||||
   (base32 "1xyhz0dyrkg2avz382ly3dzpa5v89x49gfzx80c1drpwsk7jg6gp")))
 | 
			
		||||
   (base32 "1ryfc8fppigssrzz5lfbqgli49cgs3lmf0yh46lpi2k0j2x30qcc")))
 | 
			
		||||
(define-public linux-libre-5.10-pristine-source
 | 
			
		||||
  (let ((version linux-libre-5.10-version)
 | 
			
		||||
        (hash (base32 "04952zaz2kfwf7agy4laz50f9sl3mrnpqlbwbj84q1xpl9akwd9y")))
 | 
			
		||||
        (hash (base32 "1iljaaiwqg30rqb9zxrxc4l1p56q75jf0zvsrmn67z2a12sffi4h")))
 | 
			
		||||
   (make-linux-libre-source version
 | 
			
		||||
                            (%upstream-linux-source version hash)
 | 
			
		||||
                            deblob-scripts-5.10)))
 | 
			
		||||
 | 
			
		||||
(define-public linux-libre-5.4-version "5.4.196")
 | 
			
		||||
(define-public linux-libre-5.4-version "5.4.197")
 | 
			
		||||
(define-public linux-libre-5.4-gnu-revision "gnu1")
 | 
			
		||||
(define deblob-scripts-5.4
 | 
			
		||||
  (linux-libre-deblob-scripts
 | 
			
		||||
| 
						 | 
				
			
			@ -409,12 +409,12 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
 | 
			
		|||
   (base32 "05i286d98fm2pdf9724x1dsmfcm7gsd7yyyvxqlpisyj1kx14hda")))
 | 
			
		||||
(define-public linux-libre-5.4-pristine-source
 | 
			
		||||
  (let ((version linux-libre-5.4-version)
 | 
			
		||||
        (hash (base32 "1x5irgki792f21hm5146xary0260cl9r475kvw8vm9w32vyx18ig")))
 | 
			
		||||
        (hash (base32 "1a1nzrx873vwlpm018l6rk19yh59badvwsknw3chbkbhzjrigbf2")))
 | 
			
		||||
   (make-linux-libre-source version
 | 
			
		||||
                            (%upstream-linux-source version hash)
 | 
			
		||||
                            deblob-scripts-5.4)))
 | 
			
		||||
 | 
			
		||||
(define-public linux-libre-4.19-version "4.19.245")
 | 
			
		||||
(define-public linux-libre-4.19-version "4.19.246")
 | 
			
		||||
(define-public linux-libre-4.19-gnu-revision "gnu1")
 | 
			
		||||
(define deblob-scripts-4.19
 | 
			
		||||
  (linux-libre-deblob-scripts
 | 
			
		||||
| 
						 | 
				
			
			@ -424,12 +424,12 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
 | 
			
		|||
   (base32 "1dnjgx1nmawm9gm0yf15nl80nmg7hy7q2vl3jxjbwj6hlrfv5dmx")))
 | 
			
		||||
(define-public linux-libre-4.19-pristine-source
 | 
			
		||||
  (let ((version linux-libre-4.19-version)
 | 
			
		||||
        (hash (base32 "1s58qci6xhmss12glzkqk41kp60pqmzh4d84kyz4m4nf4xhdvzcr")))
 | 
			
		||||
        (hash (base32 "0fmsglkvdgdmrkm53vyi9d4hvdl4py9qn1z0mni224n96rd2zb80")))
 | 
			
		||||
    (make-linux-libre-source version
 | 
			
		||||
                             (%upstream-linux-source version hash)
 | 
			
		||||
                             deblob-scripts-4.19)))
 | 
			
		||||
 | 
			
		||||
(define-public linux-libre-4.14-version "4.14.281")
 | 
			
		||||
(define-public linux-libre-4.14-version "4.14.282")
 | 
			
		||||
(define-public linux-libre-4.14-gnu-revision "gnu1")
 | 
			
		||||
(define deblob-scripts-4.14
 | 
			
		||||
  (linux-libre-deblob-scripts
 | 
			
		||||
| 
						 | 
				
			
			@ -439,12 +439,12 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
 | 
			
		|||
   (base32 "1dnjgx1nmawm9gm0yf15nl80nmg7hy7q2vl3jxjbwj6hlrfv5dmx")))
 | 
			
		||||
(define-public linux-libre-4.14-pristine-source
 | 
			
		||||
  (let ((version linux-libre-4.14-version)
 | 
			
		||||
        (hash (base32 "0pivb1m2cwqnlm8bhd4ccnlq9pwp2r5lmn77gp91k6vbjv3gkqis")))
 | 
			
		||||
        (hash (base32 "18sp2qvk8dkjrlxwf4d470282m9wyvhajvyys9vs94rh1i3whdv6")))
 | 
			
		||||
    (make-linux-libre-source version
 | 
			
		||||
                             (%upstream-linux-source version hash)
 | 
			
		||||
                             deblob-scripts-4.14)))
 | 
			
		||||
 | 
			
		||||
(define-public linux-libre-4.9-version "4.9.316")
 | 
			
		||||
(define-public linux-libre-4.9-version "4.9.317")
 | 
			
		||||
(define-public linux-libre-4.9-gnu-revision "gnu1")
 | 
			
		||||
(define deblob-scripts-4.9
 | 
			
		||||
  (linux-libre-deblob-scripts
 | 
			
		||||
| 
						 | 
				
			
			@ -454,7 +454,7 @@ corresponding UPSTREAM-SOURCE (an origin), using the given DEBLOB-SCRIPTS."
 | 
			
		|||
   (base32 "14jyn2yrbm6ayp0bszs4f9jy3p1qkrj5p5gf5c42spr67aa2lv2v")))
 | 
			
		||||
(define-public linux-libre-4.9-pristine-source
 | 
			
		||||
  (let ((version linux-libre-4.9-version)
 | 
			
		||||
        (hash (base32 "05yd7djm6dcxv3vaylhmj3p0yml421azv8qabmhv4ric1f99idjp")))
 | 
			
		||||
        (hash (base32 "06qdqcplslnp1ncaqvp5yjr294rz3x4qrxnv522v76awj6dkd8vy")))
 | 
			
		||||
    (make-linux-libre-source version
 | 
			
		||||
                             (%upstream-linux-source version hash)
 | 
			
		||||
                             deblob-scripts-4.9)))
 | 
			
		||||
| 
						 | 
				
			
			@ -3693,7 +3693,7 @@ for systems using the Linux kernel.  This includes commands such as
 | 
			
		|||
(define-public inotify-tools
 | 
			
		||||
  (package
 | 
			
		||||
    (name "inotify-tools")
 | 
			
		||||
    (version "3.20.11.0")
 | 
			
		||||
    (version "3.22.6.0")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
| 
						 | 
				
			
			@ -3702,7 +3702,7 @@ for systems using the Linux kernel.  This includes commands such as
 | 
			
		|||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1m8avqccrhm38krlhp88a7v949f3hrzx060bbrr5dp5qw2nmw9j2"))))
 | 
			
		||||
                "1j9j8k5zjp8m4cl53zjncnll9z4dnvzr4ygmfcjk0ci81i59b18i"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list autoconf automake libtool))
 | 
			
		||||
| 
						 | 
				
			
			@ -6362,8 +6362,7 @@ The collection contains a set of bandwidth and latency benchmark such as:
 | 
			
		|||
    (native-inputs
 | 
			
		||||
     (list autoconf automake pkg-config))
 | 
			
		||||
    (inputs
 | 
			
		||||
     `(("libsysfs" ,sysfsutils)
 | 
			
		||||
       ("openssl" ,openssl)))
 | 
			
		||||
     (list sysfsutils openssl))
 | 
			
		||||
    (synopsis "Random number generator daemon")
 | 
			
		||||
    (description
 | 
			
		||||
     "Monitor a hardware random number generator, and supply entropy
 | 
			
		||||
| 
						 | 
				
			
			@ -7246,14 +7245,14 @@ re-use code and to avoid re-inventing the wheel.")
 | 
			
		|||
(define-public libnftnl
 | 
			
		||||
  (package
 | 
			
		||||
    (name "libnftnl")
 | 
			
		||||
    (version "1.2.1")
 | 
			
		||||
    (version "1.2.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append "mirror://netfilter.org/libnftnl/"
 | 
			
		||||
                           "libnftnl-" version ".tar.bz2"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0z4khm2mnys9mcl8ckwf19cw20jgrv8650nfncy3xcgs2k2aa23m"))))
 | 
			
		||||
        (base32 "02kdxp4l1ds5lpkw6rxv6f7icc70am6ik3p9z5l8v48mkm7h1z4y"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list pkg-config))
 | 
			
		||||
| 
						 | 
				
			
			@ -7288,7 +7287,7 @@ used by nftables.")
 | 
			
		|||
(define-public nftables
 | 
			
		||||
  (package
 | 
			
		||||
    (name "nftables")
 | 
			
		||||
    (version "1.0.2")
 | 
			
		||||
    (version "1.0.4")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -7297,9 +7296,7 @@ used by nftables.")
 | 
			
		|||
                  (string-append "https://www.nftables.org/projects/nftables"
 | 
			
		||||
                                 "/files/nftables-" version ".tar.bz2")))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "00jcjn1pl7qyqpg8pd4yhlkys7wbj4vkzgg73n27nmplzips6a0b"))
 | 
			
		||||
       (patches
 | 
			
		||||
        (search-patches "nftables-fix-makefile.patch"))))
 | 
			
		||||
        (base32 "0ddsdj6zs78hndffl3iikpa1wzjxcpmr3xqcq4la71gnl7zb2zwj"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments `(#:configure-flags
 | 
			
		||||
                 '("--disable-static"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -4457,7 +4457,7 @@ addition, removal, and random selection.")
 | 
			
		|||
(define-public sbcl-quri
 | 
			
		||||
  (package
 | 
			
		||||
    (name "sbcl-quri")
 | 
			
		||||
    (version "0.4.0")
 | 
			
		||||
    (version "0.5.0")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -4466,7 +4466,7 @@ addition, removal, and random selection.")
 | 
			
		|||
             (commit version)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0ka5haq3g72hvaz4hdv7y1d6df9ncmx029wwixn4r413gll5yxy7"))))
 | 
			
		||||
        (base32 "0zpwjhs2zz9832wsjs00kbkjjl4bcs96krlnq9y75gi4f34fxj1x"))))
 | 
			
		||||
    (build-system asdf-build-system/sbcl)
 | 
			
		||||
    (arguments
 | 
			
		||||
     ;; Test system must be loaded before, otherwise tests fail with:
 | 
			
		||||
| 
						 | 
				
			
			@ -4481,7 +4481,7 @@ addition, removal, and random selection.")
 | 
			
		|||
    (synopsis "Yet another URI library for Common Lisp")
 | 
			
		||||
    (description
 | 
			
		||||
     "QURI (pronounced \"Q-ree\") is yet another URI library for Common
 | 
			
		||||
Lisp. It is intended to be a replacement of PURI.")
 | 
			
		||||
Lisp.  It is intended to be a replacement of PURI.")
 | 
			
		||||
    (license license:bsd-3)))
 | 
			
		||||
 | 
			
		||||
(define-public cl-quri
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -577,9 +577,9 @@ output), and Binutils.")
 | 
			
		|||
         ;; These options are required for cross-compiling LLVM according
 | 
			
		||||
         ;; to <https://llvm.org/docs/HowToCrossCompileLLVM.html>.
 | 
			
		||||
         #$@(if (%current-target-system)
 | 
			
		||||
                #~(,(string-append "-DLLVM_TABLEGEN="
 | 
			
		||||
                                   #+(file-append this-package
 | 
			
		||||
                                                  "/bin/llvm-tblgen"))
 | 
			
		||||
                #~((string-append "-DLLVM_TABLEGEN="
 | 
			
		||||
                                  #+(file-append this-package
 | 
			
		||||
                                                 "/bin/llvm-tblgen"))
 | 
			
		||||
                   #$(string-append "-DLLVM_DEFAULT_TARGET_TRIPLE="
 | 
			
		||||
                                    (%current-target-system))
 | 
			
		||||
                   #$(string-append "-DLLVM_TARGET_ARCH="
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -3,7 +3,7 @@
 | 
			
		|||
;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 | 
			
		||||
;;; Copyright © 2017 Stefan Reichör <stefan@xsteve.at>
 | 
			
		||||
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
 | 
			
		||||
;;; Copyright © 2018–2021 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2018–2022 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2019 Gábor Boskovits <boskovits@gmail.com>
 | 
			
		||||
;;; Copyright © 2019 Meiyo Peng <meiyo@riseup.net>
 | 
			
		||||
;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
 | 
			
		||||
| 
						 | 
				
			
			@ -164,29 +164,40 @@ commands, displaying the results via a web interface.")
 | 
			
		|||
(define-public multitail
 | 
			
		||||
  (package
 | 
			
		||||
    (name "multitail")
 | 
			
		||||
    (version "6.5.0")
 | 
			
		||||
    (version "6.5.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
      (method url-fetch)
 | 
			
		||||
      (uri (string-append "https://vanheusden.com/multitail/multitail-"
 | 
			
		||||
                          version ".tgz"))
 | 
			
		||||
      (method git-fetch)
 | 
			
		||||
      (uri (git-reference
 | 
			
		||||
            (url "https://github.com/halturin/multitail")
 | 
			
		||||
            (commit (string-append "v" version))))
 | 
			
		||||
      (file-name (git-file-name name version))
 | 
			
		||||
      (sha256
 | 
			
		||||
       (base32 "1vd9vdxyxsccl64ilx542ya5vlw2bpg6gnkq1x8cfqy6vxvmx7dj"))))
 | 
			
		||||
       (base32 "17hg5qpangyx4m7hp2x4h56mp6w3wsaslg1il39qcpwsffh1rihc"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:make-flags
 | 
			
		||||
       (list (string-append "CC=" ,(cc-for-target))
 | 
			
		||||
             (string-append "PREFIX="
 | 
			
		||||
                            (assoc-ref %outputs "out")))
 | 
			
		||||
             (string-append "PREFIX=" (assoc-ref %outputs "out"))
 | 
			
		||||
             "SYSCONFDIR=$(PREFIX)/etc")
 | 
			
		||||
       #:phases
 | 
			
		||||
       (modify-phases %standard-phases
 | 
			
		||||
         (add-after 'unpack 'patch-curses-lib
 | 
			
		||||
           (lambda* (#:key outputs #:allow-other-keys)
 | 
			
		||||
             (let ((out (assoc-ref outputs "out")))
 | 
			
		||||
               (substitute* "mt.h"
 | 
			
		||||
                 (("ncursesw\\/panel.h") "panel.h")
 | 
			
		||||
                 (("ncursesw\\/ncurses.h") "ncurses.h")))
 | 
			
		||||
             #t))
 | 
			
		||||
         (add-after 'unpack 'fix-broken-build
 | 
			
		||||
           ;; With some luck, you might be able to remove this when updating…
 | 
			
		||||
           (lambda _
 | 
			
		||||
             (substitute* "Makefile"
 | 
			
		||||
               ((" \\*\\.txt") "")
 | 
			
		||||
               ((".*CONFIG_DIR.*") "")
 | 
			
		||||
               (("^install: .*" match)
 | 
			
		||||
                (string-append match
 | 
			
		||||
                               "\t$(INSTALL_DIR) $(DESTDIR)$(SYSCONFDIR)\n")))
 | 
			
		||||
             (substitute* "version"
 | 
			
		||||
               (("(VERSION=).*" _ assign)
 | 
			
		||||
                (string-append assign ,version)))))
 | 
			
		||||
         (add-after 'unpack 'patch-curses-headers
 | 
			
		||||
           (lambda _
 | 
			
		||||
             (substitute* "mt.h"
 | 
			
		||||
               (("ncursesw/") ""))))
 | 
			
		||||
         (delete 'configure))           ; no configure script
 | 
			
		||||
       #:tests? #f)) ; no test suite (make check just runs cppcheck)
 | 
			
		||||
    (inputs (list ncurses))
 | 
			
		||||
| 
						 | 
				
			
			@ -229,7 +240,7 @@ library.")
 | 
			
		|||
(define-public rsyslog
 | 
			
		||||
  (package
 | 
			
		||||
    (name "rsyslog")
 | 
			
		||||
    (version "8.2112.0")
 | 
			
		||||
    (version "8.2204.1")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -238,8 +249,7 @@ library.")
 | 
			
		|||
             (commit (string-append "v" version))))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "0bp124w2qv8hix5i0p04d8yvsipy18dhqm7zw8i6cwdgnhdadq96"))))
 | 
			
		||||
        (base32 "0bsd1n3n4hvlkwf4g85g3fg37mnvkdmxsfdmg273gcachhyl5hbx"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list
 | 
			
		||||
| 
						 | 
				
			
			@ -253,9 +263,8 @@ library.")
 | 
			
		|||
      ;; them for a full-featured build.
 | 
			
		||||
      '(list "--enable-kmsg"
 | 
			
		||||
             "--enable-liblogging_stdlog"
 | 
			
		||||
             "--enable-mmanon"
 | 
			
		||||
             "--enable-mmcount"
 | 
			
		||||
             "--enable-unlimited_select"
 | 
			
		||||
             "--enable-usertools"
 | 
			
		||||
         
 | 
			
		||||
             ;; Input plugins
 | 
			
		||||
             "--enable-imbatchreport"
 | 
			
		||||
| 
						 | 
				
			
			@ -297,7 +306,9 @@ library.")
 | 
			
		|||
             "--enable-pmsnare"
 | 
			
		||||
 | 
			
		||||
             ;; Message Modification Modules
 | 
			
		||||
             "--enable-mmanon"
 | 
			
		||||
             "--enable-mmaudit"
 | 
			
		||||
             "--enable-mmcount"
 | 
			
		||||
             "--enable-mmdarwin"
 | 
			
		||||
             "--enable-mmdblookup"
 | 
			
		||||
             "--enable-mmfields"
 | 
			
		||||
| 
						 | 
				
			
			@ -324,9 +335,18 @@ library.")
 | 
			
		|||
             "--enable-snmp"
 | 
			
		||||
 | 
			
		||||
             ;; Function modules
 | 
			
		||||
             "--enable-fmhash_xxhash")))
 | 
			
		||||
             "--enable-fmhash_xxhash"
 | 
			
		||||
 | 
			
		||||
             ;; Needed to build rscryutil.1.gz.
 | 
			
		||||
             "--enable-generate-man-pages")))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list autoconf automake bison flex libtool pkg-config))
 | 
			
		||||
     (list autoconf
 | 
			
		||||
           automake
 | 
			
		||||
           bison
 | 
			
		||||
           flex
 | 
			
		||||
           libtool
 | 
			
		||||
           pkg-config
 | 
			
		||||
           python-docutils))            ; rst2man for man pages
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list curl
 | 
			
		||||
           cyrus-sasl
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1333,14 +1333,14 @@ invoking @command{notifymuch} from the post-new hook.")
 | 
			
		|||
(define-public notmuch
 | 
			
		||||
  (package
 | 
			
		||||
    (name "notmuch")
 | 
			
		||||
    (version "0.35")
 | 
			
		||||
    (version "0.36")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append "https://notmuchmail.org/releases/notmuch-"
 | 
			
		||||
                           version ".tar.xz"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0fdc81m24xrbhfrhw00g12ak4b8hap4961sq7ap6q2pjqhac8cd8"))))
 | 
			
		||||
        (base32 "0h6f6mh9m9vrijm638x5sbsl321b74a25cdasbxhx67x62w320hk"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list
 | 
			
		||||
| 
						 | 
				
			
			@ -1474,8 +1474,7 @@ useful for email address completion.")
 | 
			
		|||
             (let ((notmuch (assoc-ref inputs "notmuch")))
 | 
			
		||||
               (substitute* "notmuch/globals.py"
 | 
			
		||||
                 (("libnotmuch\\.so\\.")
 | 
			
		||||
                  (string-append notmuch "/lib/libnotmuch.so.")))
 | 
			
		||||
               #t))))))
 | 
			
		||||
                  (string-append notmuch "/lib/libnotmuch.so.")))))))))
 | 
			
		||||
    (home-page (package-home-page notmuch))
 | 
			
		||||
    (synopsis "Python bindings of the Notmuch mail indexing library")
 | 
			
		||||
    (description
 | 
			
		||||
| 
						 | 
				
			
			@ -1632,7 +1631,7 @@ compresses it.")
 | 
			
		|||
(define-public claws-mail
 | 
			
		||||
  (package
 | 
			
		||||
    (name "claws-mail")
 | 
			
		||||
    (version "4.0.0")
 | 
			
		||||
    (version "4.1.0")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -1640,7 +1639,7 @@ compresses it.")
 | 
			
		|||
        (string-append "https://www.claws-mail.org/releases/claws-mail-"
 | 
			
		||||
                       version ".tar.xz"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0xg41rxxq2q5vhjzbh8p12s248kcljk6g7y0m6raq7nrllkbvwja"))))
 | 
			
		||||
        (base32 "13ksh4iwr23zi86fwmiwxha94xqrr5zxq373i82rwaldvfh9q6hf"))))
 | 
			
		||||
    (build-system glib-or-gtk-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:configure-flags
 | 
			
		||||
| 
						 | 
				
			
			@ -1670,7 +1669,7 @@ compresses it.")
 | 
			
		|||
                (search-input-file inputs "/share/mime/globs"))))))))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list bison
 | 
			
		||||
           ;;("docbook-utils" ,docbook-utils)
 | 
			
		||||
           ;;docbook-utils
 | 
			
		||||
           flex
 | 
			
		||||
           gettext-minimal
 | 
			
		||||
           gobject-introspection
 | 
			
		||||
| 
						 | 
				
			
			@ -3671,7 +3670,7 @@ operators and scripters.")
 | 
			
		|||
(define-public alpine
 | 
			
		||||
  (package
 | 
			
		||||
    (name "alpine")
 | 
			
		||||
    (version "2.25")
 | 
			
		||||
    (version "2.26")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -3684,14 +3683,12 @@ operators and scripters.")
 | 
			
		|||
             (commit (string-append "v" version))))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0z6dp3cpz1dmbxw41ravsx1bxychafp0ij8gvj96mzz7rm9pdnq3"))
 | 
			
		||||
        (base32 "1padh9kgn9blzjf0016i2f15c615fk17m8vg8kx301jhmc2r973h"))
 | 
			
		||||
       (modules '((guix build utils)))
 | 
			
		||||
       (snippet
 | 
			
		||||
        '(begin
 | 
			
		||||
           ;; Remove pre-built binaries scattered across the source repository.
 | 
			
		||||
           (for-each delete-file (find-files "." "\\.(dll|exe)"))))
 | 
			
		||||
       (patches
 | 
			
		||||
        (search-patches "alpine-fix-privacy-policy-crash.patch"))))
 | 
			
		||||
           (for-each delete-file (find-files "." "\\.(dll|exe)"))))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:make-flags
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1713,7 +1713,7 @@ instant messenger with audio and video chat capabilities.")
 | 
			
		|||
(define-public qtox
 | 
			
		||||
  (package
 | 
			
		||||
    (name "qtox")
 | 
			
		||||
    (version "1.17.4")
 | 
			
		||||
    (version "1.17.6")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (string-append "https://github.com/qTox/qTox/releases"
 | 
			
		||||
| 
						 | 
				
			
			@ -1721,7 +1721,7 @@ instant messenger with audio and video chat capabilities.")
 | 
			
		|||
                                  "/v" version ".tar.gz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "086hvm0q2vl2lq8zlp8s9sivlic6sg7ga5ixz01hbsyrashvil63"))
 | 
			
		||||
                "1ml8z1xpp3qhip4vkr375jf7y5kc18g0apm91n5am6ricx37c01r"))
 | 
			
		||||
              (file-name (string-append name "-" version ".tar.gz"))))
 | 
			
		||||
    (build-system cmake-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -2281,7 +2281,7 @@ perform creative live mixes with digital music files.")
 | 
			
		|||
(define-public synthv1
 | 
			
		||||
  (package
 | 
			
		||||
    (name "synthv1")
 | 
			
		||||
    (version "0.9.25")
 | 
			
		||||
    (version "0.9.26")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri
 | 
			
		||||
| 
						 | 
				
			
			@ -2289,7 +2289,7 @@ perform creative live mixes with digital music files.")
 | 
			
		|||
                              "/synthv1-" version ".tar.gz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1i16036f9wm52c5pxkllq7ir749jcknbh35i9wcxd5n88p6mzw02"))))
 | 
			
		||||
                "1asikh341f3vblrl8l07yakza80ybs8sid3n2qpsrvigaz3iymcd"))))
 | 
			
		||||
    (build-system cmake-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:tests? #f))                    ; there are no tests
 | 
			
		||||
| 
						 | 
				
			
			@ -2299,7 +2299,8 @@ perform creative live mixes with digital music files.")
 | 
			
		|||
           alsa-lib
 | 
			
		||||
           new-session-manager
 | 
			
		||||
           liblo
 | 
			
		||||
           qtbase-5))
 | 
			
		||||
           qtbase-5
 | 
			
		||||
           qtsvg))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list pkg-config qttools))
 | 
			
		||||
    (home-page "https://synthv1.sourceforge.io")
 | 
			
		||||
| 
						 | 
				
			
			@ -2312,7 +2313,7 @@ oscillators and stereo effects.")
 | 
			
		|||
(define-public drumkv1
 | 
			
		||||
  (package
 | 
			
		||||
    (name "drumkv1")
 | 
			
		||||
    (version "0.9.25")
 | 
			
		||||
    (version "0.9.26")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri
 | 
			
		||||
| 
						 | 
				
			
			@ -2320,7 +2321,7 @@ oscillators and stereo effects.")
 | 
			
		|||
                              "/drumkv1-" version ".tar.gz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0p50b4k4zldagiwxs0micmdbqib46ysipdj8lkxqdv0pysmd72fc"))))
 | 
			
		||||
                "0j05xqgcb7kwnnsgl6i7vbdsfq26chzs4zyq6pl0ipcmw4d82j8i"))))
 | 
			
		||||
    (build-system cmake-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:tests? #f))                    ; there are no tests
 | 
			
		||||
| 
						 | 
				
			
			@ -2331,7 +2332,8 @@ oscillators and stereo effects.")
 | 
			
		|||
           alsa-lib
 | 
			
		||||
           new-session-manager
 | 
			
		||||
           liblo
 | 
			
		||||
           qtbase-5))
 | 
			
		||||
           qtbase-5
 | 
			
		||||
           qtsvg))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list pkg-config qttools))
 | 
			
		||||
    (home-page "https://drumkv1.sourceforge.io")
 | 
			
		||||
| 
						 | 
				
			
			@ -2344,7 +2346,7 @@ effects.")
 | 
			
		|||
(define-public samplv1
 | 
			
		||||
  (package
 | 
			
		||||
    (name "samplv1")
 | 
			
		||||
    (version "0.9.25")
 | 
			
		||||
    (version "0.9.26")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri
 | 
			
		||||
| 
						 | 
				
			
			@ -2352,7 +2354,7 @@ effects.")
 | 
			
		|||
                              "/samplv1-" version ".tar.gz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0d05b03knrwh1zr4p0kcyn58scy6a392f0xxm78cqf0gikd3bw5c"))))
 | 
			
		||||
                "1rqz3hf39hk2m15ihrkn8f5cqgbkvz3rq6r2k35rvn7sgvcq1dli"))))
 | 
			
		||||
    (build-system cmake-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:tests? #f))                    ; there are no tests
 | 
			
		||||
| 
						 | 
				
			
			@ -2363,7 +2365,8 @@ effects.")
 | 
			
		|||
           alsa-lib
 | 
			
		||||
           new-session-manager
 | 
			
		||||
           liblo
 | 
			
		||||
           qtbase-5))
 | 
			
		||||
           qtbase-5
 | 
			
		||||
           qtsvg))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list pkg-config qttools))
 | 
			
		||||
    (home-page "https://samplv1.sourceforge.io")
 | 
			
		||||
| 
						 | 
				
			
			@ -2376,7 +2379,7 @@ effects.")
 | 
			
		|||
(define-public padthv1
 | 
			
		||||
  (package
 | 
			
		||||
    (name "padthv1")
 | 
			
		||||
    (version "0.9.25")
 | 
			
		||||
    (version "0.9.26")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri
 | 
			
		||||
| 
						 | 
				
			
			@ -2384,7 +2387,7 @@ effects.")
 | 
			
		|||
                              "/padthv1-" version ".tar.gz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "11fa2794g7dqsiw674wr2m4k0xdw89imqwa8mgms0igskxxbvjka"))))
 | 
			
		||||
                "02pg0g4i65j46hirkc3xn7m2clm8krrafrkwjc1v8rkcdj6q2gw1"))))
 | 
			
		||||
    (build-system cmake-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:tests? #f))                    ; there are no tests
 | 
			
		||||
| 
						 | 
				
			
			@ -2395,7 +2398,8 @@ effects.")
 | 
			
		|||
           new-session-manager
 | 
			
		||||
           liblo
 | 
			
		||||
           fftwf
 | 
			
		||||
           qtbase-5))
 | 
			
		||||
           qtbase-5
 | 
			
		||||
           qtsvg))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list pkg-config qttools))
 | 
			
		||||
    (home-page "https://padthv1.sourceforge.io")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -2772,6 +2772,12 @@ updates to the zebra daemon.")
 | 
			
		|||
         #:tests? #f ; No test suite.
 | 
			
		||||
         #:phases
 | 
			
		||||
         (modify-phases %standard-phases
 | 
			
		||||
           (add-after 'unpack 'use-source-date-epoch-in-manpages
 | 
			
		||||
             ;; For reproducible builds
 | 
			
		||||
             (lambda _
 | 
			
		||||
               (substitute* "Makefile"
 | 
			
		||||
                 (("date --iso-8601")
 | 
			
		||||
                  "date --iso-8601 --utc --date=@$(SOURCE_DATE_EPOCH)"))))
 | 
			
		||||
           (delete 'configure) ; No ./configure script.
 | 
			
		||||
           (add-before 'build 'patch-paths
 | 
			
		||||
             (lambda _
 | 
			
		||||
| 
						 | 
				
			
			@ -3359,7 +3365,7 @@ communication over HTTP.")
 | 
			
		|||
(define-public restinio
 | 
			
		||||
  (package
 | 
			
		||||
    (name "restinio")
 | 
			
		||||
    (version "0.6.14")
 | 
			
		||||
    (version "0.6.15")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
              (uri (git-reference
 | 
			
		||||
| 
						 | 
				
			
			@ -3368,7 +3374,7 @@ communication over HTTP.")
 | 
			
		|||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0j44mglsljwkw49583hcsrl5ck2g56n9srnm10kpbsz2dx5apx98"))))
 | 
			
		||||
                "1f8d5nfm8jqhspzsslwb1b7j4glipz31i9vszrcnkx3clc39nj2n"))))
 | 
			
		||||
    (build-system cmake-build-system)
 | 
			
		||||
    (inputs                             ; TODO: Need to force-keep references on some inputs, e.g. boost.
 | 
			
		||||
     (list zlib
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1650,8 +1650,8 @@ in an isolated environment, in separate namespaces.")
 | 
			
		|||
    (license license:gpl3+)))
 | 
			
		||||
 | 
			
		||||
(define-public nar-herder
 | 
			
		||||
  (let ((commit "a24fbd108f75c8f27d2f68f2d1a051e2f3f3e191")
 | 
			
		||||
        (revision "7"))
 | 
			
		||||
  (let ((commit "042f49e5fb52ea844ed5d29c17b26fbc8ad49f0e")
 | 
			
		||||
        (revision "8"))
 | 
			
		||||
    (package
 | 
			
		||||
      (name "nar-herder")
 | 
			
		||||
      (version (git-version "0" revision commit))
 | 
			
		||||
| 
						 | 
				
			
			@ -1662,7 +1662,7 @@ in an isolated environment, in separate namespaces.")
 | 
			
		|||
                      (commit commit)))
 | 
			
		||||
                (sha256
 | 
			
		||||
                 (base32
 | 
			
		||||
                  "1jm6ks2sjcwih7j4wnp252qd73n8pydg7sd000ismpvg5p21l7fg"))
 | 
			
		||||
                  "1i9vwjdvkchwndjikqq3j73x0mvp3ny63s62ixql70yhpdgz5l69"))
 | 
			
		||||
                (file-name (string-append name "-" version "-checkout"))))
 | 
			
		||||
      (build-system gnu-build-system)
 | 
			
		||||
      (arguments
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -4,7 +4,7 @@
 | 
			
		|||
;;; Copyright © 2015, 2016, 2017, 2018, 2020, 2021, 2022 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;; Copyright © 2016 Pjotr Prins <pjotr.guix@thebird.nl>
 | 
			
		||||
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 | 
			
		||||
;;; Copyright © 2016, 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
 | 
			
		||||
;;; Copyright © 2016, 2020, 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
 | 
			
		||||
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
 | 
			
		||||
;;; Copyright © 2017, 2018 Rutger Helling <rhelling@mykolab.com>
 | 
			
		||||
;;; Copyright © 2018–2022 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
| 
						 | 
				
			
			@ -327,7 +327,7 @@ by managing a queue of pending work.")
 | 
			
		|||
(define-public slurm-drmaa
 | 
			
		||||
  (package
 | 
			
		||||
    (name "slurm-drmaa")
 | 
			
		||||
    (version "1.1.2")
 | 
			
		||||
    (version "1.1.3")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (string-append
 | 
			
		||||
| 
						 | 
				
			
			@ -335,7 +335,7 @@ by managing a queue of pending work.")
 | 
			
		|||
                    version "/slurm-drmaa-" version ".tar.gz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "0dn8ypqxdaq3k4jqwwx7msckxnmr6n2z5j68yffp50yy07ajbzjv"))))
 | 
			
		||||
                "1fn3p4wjj0sgvx0isy3hiwi35vhxa2n2ksq5cn9sq2hg7yyb2phl"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments `(#:tests? #f)) ; The tests require "bats".
 | 
			
		||||
    (inputs
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,39 +0,0 @@
 | 
			
		|||
X-Git-Url: https://repo.or.cz/alpine.git/blobdiff_plain/fb2217ac67706e4cbef69bea41041e2fb8b910e9..3ee981816abfb7d47ffc0ac522fff002b5749b72:/alpine/help.c
 | 
			
		||||
 | 
			
		||||
diff --git a/alpine/help.c b/alpine/help.c
 | 
			
		||||
index 4f1bf46..e9c7b34 100644
 | 
			
		||||
--- a/alpine/help.c
 | 
			
		||||
+++ b/alpine/help.c
 | 
			
		||||
@@ -36,6 +36,7 @@ static char rcsid[] = "$Id: help.c 1032 2008-04-11 00:30:04Z hubert@u.washington
 | 
			
		||||
 #include "../pith/detoken.h"
 | 
			
		||||
 #include "../pith/list.h"
 | 
			
		||||
 #include "../pith/margin.h"
 | 
			
		||||
+#include "../pith/busy.h"
 | 
			
		||||
 
 | 
			
		||||
 
 | 
			
		||||
 typedef struct _help_scroll {
 | 
			
		||||
@@ -135,10 +136,12 @@ helper_internal(HelpType text, char *frag, char *title, int flags)
 | 
			
		||||
     is_external = 0;
 | 
			
		||||
 
 | 
			
		||||
     if(shown_text && *shown_text && !struncmp(*shown_text, "x-alpine-http:", 14)){
 | 
			
		||||
-	int status;
 | 
			
		||||
+	int status, we_cancel = 0;
 | 
			
		||||
+
 | 
			
		||||
+	we_cancel = busy_cue(_("Retrieving help text"), NULL, 1);
 | 
			
		||||
 	HTTPSTREAM *stream = http_open(*shown_text + 14);
 | 
			
		||||
 	if(stream) help_text = http_get(stream, NULL);
 | 
			
		||||
-	status = stream->status ? stream->status->code : -1;
 | 
			
		||||
+	status = stream && stream->status ? stream->status->code : -1;
 | 
			
		||||
 	if(stream) http_close(stream);
 | 
			
		||||
 	if(status != HTTP_OK){
 | 
			
		||||
 	    shown_text = NO_HELP;
 | 
			
		||||
@@ -165,7 +168,8 @@ helper_internal(HelpType text, char *frag, char *title, int flags)
 | 
			
		||||
 		*rv = NULL;
 | 
			
		||||
 	    }
 | 
			
		||||
 	}
 | 
			
		||||
-
 | 
			
		||||
+	if(we_cancel)
 | 
			
		||||
+	   cancel_busy_cue(-1);
 | 
			
		||||
     }
 | 
			
		||||
 
 | 
			
		||||
     if(F_ON(F_BLANK_KEYMENU,ps_global)){
 | 
			
		||||
| 
						 | 
				
			
			@ -1,53 +0,0 @@
 | 
			
		|||
Fix for epiphany with libportal-0.5.
 | 
			
		||||
 | 
			
		||||
This patch was adapted from upstream
 | 
			
		||||
https://gitlab.gnome.org/GNOME/epiphany/-/commit/e4d259f614f75c26ad0d2094f4f569ffd1bc06d1
 | 
			
		||||
 | 
			
		||||
diff --git a/lib/ephy-flatpak-utils.c b/lib/ephy-flatpak-utils.c
 | 
			
		||||
index 6fc9a5dec17a63c0660cbc1d95103c8f77231d30..0fd90b3f178392930e812a8391fd81bf1371b8bf 100644
 | 
			
		||||
--- a/lib/ephy-flatpak-utils.c
 | 
			
		||||
+++ b/lib/ephy-flatpak-utils.c
 | 
			
		||||
@@ -29,7 +29,7 @@
 | 
			
		||||
 #include <gio/gio.h>
 | 
			
		||||
 #include <gio/gunixfdlist.h>
 | 
			
		||||
 #if USE_LIBPORTAL
 | 
			
		||||
-#include <libportal/portal-gtk3.h>
 | 
			
		||||
+#include <libportal-gtk3/portal-gtk3.h>
 | 
			
		||||
 #endif
 | 
			
		||||
 #include <string.h>
 | 
			
		||||
 #include <sys/stat.h>
 | 
			
		||||
diff --git a/lib/meson.build b/lib/meson.build
 | 
			
		||||
index 264f9c5fb66268fc248f780b8d1c06c8291f856d..db0a0557f0ae634d7fb95e57aba0cd901ca4d6c1 100644
 | 
			
		||||
--- a/lib/meson.build
 | 
			
		||||
+++ b/lib/meson.build
 | 
			
		||||
@@ -66,6 +66,7 @@ libephymisc_deps = [
 | 
			
		||||
   libxml_dep,
 | 
			
		||||
   m_dep,
 | 
			
		||||
   portal_dep,
 | 
			
		||||
+  portal_gtk_dep,
 | 
			
		||||
   sqlite3_dep,
 | 
			
		||||
   webkit2gtk_dep
 | 
			
		||||
 ]
 | 
			
		||||
diff --git a/meson.build b/meson.build
 | 
			
		||||
index 0b9f862b22a23619289342ec39fa0a0274558c25..4285a975004e48366789a4e66f8b23f3af05a636 100644
 | 
			
		||||
--- a/meson.build
 | 
			
		||||
+++ b/meson.build
 | 
			
		||||
@@ -95,7 +95,8 @@ libhandy_dep = dependency('libhandy-1', version: '>= 1.5.0')
 | 
			
		||||
 libsecret_dep = dependency('libsecret-1', version: '>= 0.19.0')
 | 
			
		||||
 libxml_dep = dependency('libxml-2.0', version: '>= 2.6.12')
 | 
			
		||||
 nettle_dep = dependency('nettle', version: nettle_requirement)
 | 
			
		||||
-portal_dep = dependency('libportal', version: '>= 0.0.2', required: get_option('libportal'))
 | 
			
		||||
+portal_dep = dependency('libportal', version: '>= 0.5', required: get_option('libportal'))
 | 
			
		||||
+portal_gtk_dep = dependency('libportal-gtk3', version: '>= 0.5', required: get_option('libportal'))
 | 
			
		||||
 sqlite3_dep = dependency('sqlite3', version: '>= 3.22')
 | 
			
		||||
 
 | 
			
		||||
 if get_option('soup2').enabled()
 | 
			
		||||
@@ -108,7 +109,7 @@ else
 | 
			
		||||
   webkit2gtk_web_extension_dep = dependency('webkit2gtk-web-extension-4.1', version: webkitgtk_requirement)
 | 
			
		||||
 endif
 | 
			
		||||
 
 | 
			
		||||
-conf.set10('USE_LIBPORTAL', portal_dep.found())
 | 
			
		||||
+conf.set10('USE_LIBPORTAL', portal_dep.found() and portal_gtk_dep.found())
 | 
			
		||||
 
 | 
			
		||||
 webkit_revision = webkit2gtk_dep.get_variable(pkgconfig : 'revision', default_value : '')
 | 
			
		||||
 if webkit_revision == 'tarball'
 | 
			
		||||
| 
						 | 
				
			
			@ -1,34 +0,0 @@
 | 
			
		|||
From 18a08fb7f0443f8bde83393bd6f69e23a04246b3 Mon Sep 17 00:00:00 2001
 | 
			
		||||
From: Pablo Neira Ayuso <pablo@netfilter.org>
 | 
			
		||||
Date: Tue, 22 Feb 2022 00:56:36 +0100
 | 
			
		||||
Subject: examples: compile with `make check' and add AM_CPPFLAGS
 | 
			
		||||
 | 
			
		||||
Compile examples via `make check' like libnftnl does. Use AM_CPPFLAGS to
 | 
			
		||||
specify local headers via -I.
 | 
			
		||||
 | 
			
		||||
Unfortunately, `make distcheck' did not catch this compile time error in
 | 
			
		||||
my system, since it was using the nftables/libnftables.h file of the
 | 
			
		||||
previous nftables release.
 | 
			
		||||
 | 
			
		||||
Fixes: 5b364657a35f ("build: missing SUBIRS update")
 | 
			
		||||
Fixes: caf2a6ad2d22 ("examples: add libnftables example program")
 | 
			
		||||
Signed-off-by: Pablo Neira Ayuso <pablo@netfilter.org>
 | 
			
		||||
---
 | 
			
		||||
 examples/Makefile.am | 4 +++-
 | 
			
		||||
 1 file changed, 3 insertions(+), 1 deletion(-)
 | 
			
		||||
 | 
			
		||||
diff --git a/examples/Makefile.am b/examples/Makefile.am
 | 
			
		||||
index c972170d..3b8b0b67 100644
 | 
			
		||||
--- a/examples/Makefile.am
 | 
			
		||||
+++ b/examples/Makefile.am
 | 
			
		||||
@@ -1,4 +1,6 @@
 | 
			
		||||
-noinst_PROGRAMS	= nft-buffer		\
 | 
			
		||||
+check_PROGRAMS	= nft-buffer		\
 | 
			
		||||
 		  nft-json-file
 | 
			
		||||
 
 | 
			
		||||
+AM_CPPFLAGS = -I$(top_srcdir)/include
 | 
			
		||||
+
 | 
			
		||||
 LDADD = $(top_builddir)/src/libnftables.la
 | 
			
		||||
-- 
 | 
			
		||||
cgit v1.2.3
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -5,7 +5,7 @@
 | 
			
		|||
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
 | 
			
		||||
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 | 
			
		||||
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
 | 
			
		||||
;;; Copyright © 2017, 2021 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;; Copyright © 2017, 2021, 2022 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2021 Jean-Baptiste Volatier <jbv@pm.me>
 | 
			
		||||
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 | 
			
		||||
| 
						 | 
				
			
			@ -42,8 +42,8 @@
 | 
			
		|||
   (version "8.45")
 | 
			
		||||
   (source (origin
 | 
			
		||||
            (method url-fetch)
 | 
			
		||||
            (uri (string-append "https://ftp.pcre.org/pub/pcre/pcre-"
 | 
			
		||||
                                version ".tar.bz2"))
 | 
			
		||||
            (uri (string-append "mirror://sourceforge/pcre/pcre/"
 | 
			
		||||
                                version "/pcre-" version ".tar.bz2"))
 | 
			
		||||
            (sha256
 | 
			
		||||
             (base32
 | 
			
		||||
              "1f7zichy6iimmkfrqdl575sdlm795cyc75szgg1vc2xvsbf6zbjd"))))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -19,6 +19,7 @@
 | 
			
		|||
;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
 | 
			
		||||
;;; Copyright © 2022 Paul A. Patience <paul@apatience.com>
 | 
			
		||||
;;; Copyright © 2022 Wiktor Żelazny <wzelazny@vurv.cz>
 | 
			
		||||
;;; Copyright © 2022 Eric Bavier <bavier@posteo.net>
 | 
			
		||||
;;;
 | 
			
		||||
;;; This file is part of GNU Guix.
 | 
			
		||||
;;;
 | 
			
		||||
| 
						 | 
				
			
			@ -858,6 +859,32 @@ and more
 | 
			
		|||
@end itemize")
 | 
			
		||||
    (license license:gpl3)))
 | 
			
		||||
 | 
			
		||||
(define-public python-pyglm
 | 
			
		||||
  (package
 | 
			
		||||
    (name "python-pyglm")
 | 
			
		||||
    (version "2.5.7")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       ;; Test files are not included in the archive in pypi.
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
       (uri (git-reference
 | 
			
		||||
             (url "https://github.com/Zuzu-Typ/PyGLM")
 | 
			
		||||
             (commit version)
 | 
			
		||||
             ;; Checkout the bundled `glm` submodule.  PyGLM uses the
 | 
			
		||||
             ;; currently unreleased GLM_EXT_matrix_integer feature.  Can
 | 
			
		||||
             ;; maybe unbundle once glm@0.9.9.9 is released.
 | 
			
		||||
             (recursive? #t)))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "08v0cgkwsf8rxscx5g9c5p1dy38rvak2fy3q6hg985if1nj6d9ks"))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
    (home-page "https://github.com/Zuzu-Typ/PyGLM")
 | 
			
		||||
    (synopsis "OpenGL Mathematics library for Python")
 | 
			
		||||
    (description "PyGLM is a Python extension library which brings the OpenGL
 | 
			
		||||
Mathematics (GLM) library to Python.")
 | 
			
		||||
    (license license:zlib)))
 | 
			
		||||
 | 
			
		||||
(define-public python-distributed
 | 
			
		||||
  (package
 | 
			
		||||
    (name "python-distributed")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -3,7 +3,7 @@
 | 
			
		|||
;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
 | 
			
		||||
;;; Copyright © 2013, 2014, 2015, 2016, 2019 Andreas Enge <andreas@enge.fr>
 | 
			
		||||
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
 | 
			
		||||
;;; Copyright © 2014, 2017, 2021 Eric Bavier <bavier@posteo.net>
 | 
			
		||||
;;; Copyright © 2014, 2017, 2021, 2022 Eric Bavier <bavier@posteo.net>
 | 
			
		||||
;;; Copyright © 2014, 2015 Federico Beffa <beffa@fbengineering.ch>
 | 
			
		||||
;;; Copyright © 2015 Omar Radwan <toxemicsquire4@gmail.com>
 | 
			
		||||
;;; Copyright © 2015 Pierre-Antoine Rault <par@rigelk.eu>
 | 
			
		||||
| 
						 | 
				
			
			@ -3086,7 +3086,13 @@ server.")
 | 
			
		|||
              (chdir "miniupnpc")
 | 
			
		||||
              (setenv "CC" #$(cc-for-target))
 | 
			
		||||
              (substitute* "Makefile"
 | 
			
		||||
                (("/bin/sh") (search-input-file inputs "/bin/sh"))))))))
 | 
			
		||||
                (("/bin/sh") (search-input-file inputs "/bin/sh")))))
 | 
			
		||||
          (add-before 'subdir 'remove-kernel-version
 | 
			
		||||
            ;; Avoid embedding the running kernel version for reproducible builds
 | 
			
		||||
            (lambda _
 | 
			
		||||
              (substitute*
 | 
			
		||||
                  "miniupnpc/updateminiupnpcstrings.sh"
 | 
			
		||||
                (("^OS_VERSION=`uname -r`") "OS_VERSION=Guix")))))))
 | 
			
		||||
    (inputs (list python))              ;we are building a Python extension
 | 
			
		||||
    (synopsis "UPnP client for Python")
 | 
			
		||||
    (description "Miniupnpc is a client library for Python programs to set up
 | 
			
		||||
| 
						 | 
				
			
			@ -12346,7 +12352,11 @@ libmagic.")))
 | 
			
		|||
                           ;; This test validates that 'pydevd' is not in the
 | 
			
		||||
                           ;; exception message, but it is due to being part
 | 
			
		||||
                           ;; of the build file name present in the message.
 | 
			
		||||
                           "and not test_evaluate_exception_trace")))))
 | 
			
		||||
                           "and not test_evaluate_exception_trace "
 | 
			
		||||
                           ;; These fail on systems with YAMA LSM’s ptrace
 | 
			
		||||
                           ;; scope > 0. Upstream issue:
 | 
			
		||||
                           ;; https://github.com/fabioz/PyDev.Debugger/issues/218
 | 
			
		||||
                           "and not test_attach_to_pid")))))
 | 
			
		||||
            (add-after 'install 'install-attach-binary
 | 
			
		||||
              (lambda _
 | 
			
		||||
                (install-file "attach.so"
 | 
			
		||||
| 
						 | 
				
			
			@ -12391,6 +12401,7 @@ and other @acronym{IDEs, Integrated Development Environments}.")
 | 
			
		|||
    (build-system python-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     (list
 | 
			
		||||
      #:tests? #f ; Fail on systems with YAMA LSM’s ptrace scope > 0.
 | 
			
		||||
      #:phases
 | 
			
		||||
      #~(modify-phases %standard-phases
 | 
			
		||||
          (add-after 'unpack 'patch-sh-in-tests
 | 
			
		||||
| 
						 | 
				
			
			@ -12411,17 +12422,18 @@ and other @acronym{IDEs, Integrated Development Environments}.")
 | 
			
		|||
              (setenv "DEBUGPY_BUNDLING_DISABLED" "1")))
 | 
			
		||||
          (replace 'check
 | 
			
		||||
            (lambda* (#:key tests? #:allow-other-keys)
 | 
			
		||||
              (invoke "pytest" "-vv"
 | 
			
		||||
                      "-n" (number->string (parallel-job-count))
 | 
			
		||||
                      "-k"
 | 
			
		||||
                      (string-append
 | 
			
		||||
                       ;; These tests cannot be run in parallel because their
 | 
			
		||||
                       ;; test data would not be copied by xdist and lead to
 | 
			
		||||
                       ;; import errors. (see:
 | 
			
		||||
                       ;; https://github.com/microsoft/debugpy/issues/342 and
 | 
			
		||||
                       ;; https://github.com/microsoft/debugpy/issues/880).
 | 
			
		||||
                       "not test_custom_python_args "
 | 
			
		||||
                       "and not test_autokill ")))))))
 | 
			
		||||
              (when tests?
 | 
			
		||||
                (invoke "pytest" "-vv"
 | 
			
		||||
                        "-n" (number->string (parallel-job-count))
 | 
			
		||||
                        "-k"
 | 
			
		||||
                        (string-append
 | 
			
		||||
                         ;; These tests cannot be run in parallel because their
 | 
			
		||||
                         ;; test data would not be copied by xdist and lead to
 | 
			
		||||
                         ;; import errors. (see:
 | 
			
		||||
                         ;; https://github.com/microsoft/debugpy/issues/342 and
 | 
			
		||||
                         ;; https://github.com/microsoft/debugpy/issues/880).
 | 
			
		||||
                         "not test_custom_python_args "
 | 
			
		||||
                         "and not test_autokill "))))))))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     ;; See: https://raw.githubusercontent.com/microsoft/debugpy/
 | 
			
		||||
     ;;      main/tests/requirements.txt.
 | 
			
		||||
| 
						 | 
				
			
			@ -19901,22 +19913,14 @@ design and layout.")
 | 
			
		|||
(define-public python-pkginfo
 | 
			
		||||
  (package
 | 
			
		||||
    (name "python-pkginfo")
 | 
			
		||||
    (version "1.8.2")
 | 
			
		||||
    (version "1.8.3")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (pypi-uri "pkginfo" version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1zrbn2gblb1q1rx0jlbd0vc9h1dm1bj0760p40ff5qjhcw5hsbjl"))))
 | 
			
		||||
        (base32 "0z46w559hrl79gf7navgzimj21ma821wka27jh58fvyqilqs8kd8"))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:phases
 | 
			
		||||
       (modify-phases %standard-phases
 | 
			
		||||
         (add-before 'check 'patch-tests
 | 
			
		||||
           (lambda _
 | 
			
		||||
             (substitute* "pkginfo/tests/test_installed.py"
 | 
			
		||||
               (("test_ctor_w_package_no_PKG_INFO")
 | 
			
		||||
                "_test_ctor_w_package_no_PKG_INFO")))))))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list python-wheel))
 | 
			
		||||
    (home-page "https://code.launchpad.net/~tseaver/pkginfo/trunk")
 | 
			
		||||
| 
						 | 
				
			
			@ -24363,7 +24367,7 @@ with features similar to the @command{wget} utility.")
 | 
			
		|||
(define-public offlate
 | 
			
		||||
  (package
 | 
			
		||||
    (name "offlate")
 | 
			
		||||
    (version "0.5")
 | 
			
		||||
    (version "0.6.1")
 | 
			
		||||
    (source
 | 
			
		||||
      (origin
 | 
			
		||||
        (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -24373,33 +24377,37 @@ with features similar to the @command{wget} utility.")
 | 
			
		|||
        (file-name (git-file-name name version))
 | 
			
		||||
        (sha256
 | 
			
		||||
         (base32
 | 
			
		||||
          "13pqnbl05wcyldfvl75fp89vjgwsvxyc69vhnb17kkha2rc2k1h7"))))
 | 
			
		||||
          "1sx5cv8pamyw1m089b6x8ykaxdkx26jk9cblhbzlf0m3ckz52jik"))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     ;; No tests
 | 
			
		||||
     `(#:tests? #f
 | 
			
		||||
       #:phases (modify-phases %standard-phases
 | 
			
		||||
                  (add-after 'unpack 'patch-for-pygit2
 | 
			
		||||
                    (lambda _
 | 
			
		||||
                      (substitute* "offlate/systems/git.py"
 | 
			
		||||
                        (("pygit2.remote.RemoteCallbacks")
 | 
			
		||||
                         "pygit2.RemoteCallbacks")))))))
 | 
			
		||||
       #:phases
 | 
			
		||||
       (modify-phases %standard-phases
 | 
			
		||||
         (add-before 'build 'generate-fonts
 | 
			
		||||
           (lambda _
 | 
			
		||||
             (invoke "make" "fonts")))
 | 
			
		||||
         (add-before 'build 'generate-translations
 | 
			
		||||
           (lambda _
 | 
			
		||||
             (invoke "make" "update-langs"))))))
 | 
			
		||||
    (propagated-inputs
 | 
			
		||||
      (list python-android-stringslib
 | 
			
		||||
            python-dateutil
 | 
			
		||||
            python-gitlab
 | 
			
		||||
            python-lxml
 | 
			
		||||
            python-polib
 | 
			
		||||
            python-pycountry
 | 
			
		||||
            python-pyenchant
 | 
			
		||||
            python-pygit2
 | 
			
		||||
            python-pygithub
 | 
			
		||||
            python-pyqt
 | 
			
		||||
            python-requests
 | 
			
		||||
            python-ruamel.yaml
 | 
			
		||||
            python-translate-toolkit
 | 
			
		||||
            python-translation-finder
 | 
			
		||||
            python-watchdog))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list qttools))
 | 
			
		||||
     (list qttools fontforge))
 | 
			
		||||
    (home-page "https://framagit.org/tyreunom/offlate")
 | 
			
		||||
    (synopsis "Offline translation interface for online translation tools")
 | 
			
		||||
    (description "Offlate offers a unified interface for different translation
 | 
			
		||||
| 
						 | 
				
			
			@ -24736,6 +24744,38 @@ usable as a configuration language.  This Python package implements parsing and
 | 
			
		|||
dumping of JSON5 data structures.")
 | 
			
		||||
    (license license:asl2.0)))
 | 
			
		||||
 | 
			
		||||
(define-public python-freetype-py
 | 
			
		||||
  (package
 | 
			
		||||
    (name "python-freetype-py")
 | 
			
		||||
    (version "2.3.0")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (pypi-uri "freetype-py" version ".zip"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1l55wzy21jmdayjna29ahzxrf2fp68580978rs6kap1a4zilrdpr"))))
 | 
			
		||||
    (build-system python-build-system)
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list python-setuptools-scm
 | 
			
		||||
           unzip))
 | 
			
		||||
    (inputs (list freetype))
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:phases
 | 
			
		||||
       ;; Note: the pypi archive does not contain tests, but running the check
 | 
			
		||||
       ;; phase will at least test whether the module loads correctly.
 | 
			
		||||
       (modify-phases %standard-phases
 | 
			
		||||
         (add-before 'build 'embed-library-reference
 | 
			
		||||
           (lambda* (#:key inputs #:allow-other-keys)
 | 
			
		||||
             (substitute* "freetype/raw.py"
 | 
			
		||||
               (("^(filename = ).*" _ >)
 | 
			
		||||
                (string-append > "\"" (search-input-file inputs "/lib/libfreetype.so")
 | 
			
		||||
                               "\"\n"))))))))
 | 
			
		||||
    (home-page "https://github.com/rougier/freetype-py")
 | 
			
		||||
    (synopsis "Freetype python bindings")
 | 
			
		||||
    (description "Freetype Python provides bindings for the FreeType
 | 
			
		||||
library.  Only the high-level API is bound.")
 | 
			
		||||
    (license license:bsd-3)))
 | 
			
		||||
 | 
			
		||||
(define-public python-frozendict
 | 
			
		||||
  (package
 | 
			
		||||
    (name "python-frozendict")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -368,7 +368,7 @@ are already there.")
 | 
			
		|||
(define-public direnv
 | 
			
		||||
  (package
 | 
			
		||||
    (name "direnv")
 | 
			
		||||
    (version "2.28.0")
 | 
			
		||||
    (version "2.31.0")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin (method git-fetch)
 | 
			
		||||
             (uri (git-reference
 | 
			
		||||
| 
						 | 
				
			
			@ -377,7 +377,7 @@ are already there.")
 | 
			
		|||
             (file-name (git-file-name name version))
 | 
			
		||||
             (sha256
 | 
			
		||||
              (base32
 | 
			
		||||
               "0yk53jn7wafklixclka17wyjjs2g5giigjr2bd0xzy10nrzwp7c9"))))
 | 
			
		||||
               "1c52izjzkdhmyrfx1gmbp34n0qpxyxw0s94f0vy3ldlg8xr36wmk"))))
 | 
			
		||||
    (build-system go-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     '(#:import-path "github.com/direnv/direnv"
 | 
			
		||||
| 
						 | 
				
			
			@ -405,8 +405,7 @@ are already there.")
 | 
			
		|||
                 (invoke "go" "test" "./...")
 | 
			
		||||
                 ;; Clean up from the tests, especially so that the extra
 | 
			
		||||
                 ;; direnv executable that's generated is removed.
 | 
			
		||||
                 (invoke "make" "clean")))
 | 
			
		||||
             #t)))))
 | 
			
		||||
                 (invoke "make" "clean"))))))))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list go-github-com-burntsushi-toml go-github-com-direnv-go-dotenv
 | 
			
		||||
           go-github-com-mattn-go-isatty go-golang-org-x-mod which))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -6409,7 +6409,7 @@ files, including Rmarkdown files.")
 | 
			
		|||
(define-public readstat
 | 
			
		||||
  (package
 | 
			
		||||
    (name "readstat")
 | 
			
		||||
    (version "1.1.5")
 | 
			
		||||
    (version "1.1.8")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -6418,7 +6418,7 @@ files, including Rmarkdown files.")
 | 
			
		|||
             (commit (string-append "v" version))))
 | 
			
		||||
       (file-name (git-file-name name version))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "00sdmaq0qzp6kyv53fpfi6jf3iv4pd0ap0gmw3mbfip52bbnl55w"))))
 | 
			
		||||
        (base32 "1r04lq45h1yn34v1mgfiqjfzyaqv4axqlby0nkandamcsqyhc7y4"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list autoconf automake gnu-gettext libtool))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -835,7 +835,7 @@ eye-candy, customizable, and reasonably lightweight.")
 | 
			
		|||
(define-public foot
 | 
			
		||||
  (package
 | 
			
		||||
    (name "foot")
 | 
			
		||||
    (version "1.11.0")
 | 
			
		||||
    (version "1.12.1")
 | 
			
		||||
    (home-page "https://codeberg.org/dnkl/foot")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -843,7 +843,7 @@ eye-candy, customizable, and reasonably lightweight.")
 | 
			
		|||
              (file-name (git-file-name name version))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "1d9bk8lhmw5lc8k0mw80g0vbwgxyh3gw5c7ppy3sir07s9y0y0fn"))))
 | 
			
		||||
                "14jqs4sarxbrgi5pxz0afqa9jxq90cb5ayqd21qj2n65whqa5bpk"))))
 | 
			
		||||
    (build-system meson-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(;; Using a "release" build is recommended both for performance, and
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,5 +1,5 @@
 | 
			
		|||
;;; GNU Guix --- Functional package management for GNU
 | 
			
		||||
;;; Copyright © 2017, 2018, 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2017, 2018, 2020–2022 Tobias Geerinckx-Rice <me@tobias.gr>
 | 
			
		||||
;;; Copyright © 2019 Jesse Gibbons <jgibbons2357+guix@gmail.com>
 | 
			
		||||
;;; Copyright © 2019, 2020, 2021 Timotej Lazar <timotej.lazar@araneo.si>
 | 
			
		||||
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
| 
						 | 
				
			
			@ -57,8 +57,7 @@
 | 
			
		|||
           (for-each delete-file-recursively
 | 
			
		||||
                     (cons* "bitmaps/bsd" "bitmaps/sakura" "bitmaps/tomoyo"
 | 
			
		||||
                            "bitmasks/bsd" "bitmasks/sakura" "bitmasks/tomoyo"
 | 
			
		||||
                            (find-files "cursors" "(bsd|card|petal).*\\.xbm")))
 | 
			
		||||
           #t))))
 | 
			
		||||
                            (find-files "cursors" "(bsd|card|petal).*\\.xbm")))))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (native-inputs
 | 
			
		||||
     (list imake))
 | 
			
		||||
| 
						 | 
				
			
			@ -73,8 +72,7 @@
 | 
			
		|||
             (invoke "xmkmf")
 | 
			
		||||
             ;; Fix incorrectly generated compiler flags.
 | 
			
		||||
             (substitute* "Makefile"
 | 
			
		||||
               (("(CDEBUGFLAGS = ).*" _ front) (string-append front "-O2\n")))
 | 
			
		||||
             #t))
 | 
			
		||||
               (("(CDEBUGFLAGS = ).*" _ front) (string-append front "-O2\n")))))
 | 
			
		||||
         (replace 'install
 | 
			
		||||
           (lambda* (#:key outputs make-flags #:allow-other-keys)
 | 
			
		||||
             (let* ((out (assoc-ref outputs "out"))
 | 
			
		||||
| 
						 | 
				
			
			@ -89,12 +87,14 @@
 | 
			
		|||
               (copy-file "oneko.man" (string-append man6 "/oneko.6"))
 | 
			
		||||
               (copy-file "oneko.man.jp" (string-append man6-ja "/oneko.6"))
 | 
			
		||||
               (for-each (lambda (file) (install-file file doc))
 | 
			
		||||
                         (find-files "." "README.*")))
 | 
			
		||||
             #t)))))
 | 
			
		||||
                         (find-files "." "README.*"))))))))
 | 
			
		||||
    (home-page "http://www.daidouji.com/oneko/")
 | 
			
		||||
    (synopsis "Cute cat chasing your mouse pointer")
 | 
			
		||||
    (description "Displays a cat or another animated character that chases the
 | 
			
		||||
mouse pointer around the screen while you work.")
 | 
			
		||||
    (description
 | 
			
		||||
     "Oneko displays an animated cat or dog that chases the mouse pointer---now
 | 
			
		||||
an actual mouse or a bone---around the screen while you work.
 | 
			
		||||
 | 
			
		||||
It was written for the X Window system and does not work well on Wayland.")
 | 
			
		||||
    (license license:public-domain))) ; see https://directory.fsf.org/wiki/Oneko
 | 
			
		||||
 | 
			
		||||
(define-public sl
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -461,7 +461,7 @@ trouble using them, because you do not have to remember each snippet name.")
 | 
			
		|||
(define-public vim-fugitive
 | 
			
		||||
  (package
 | 
			
		||||
    (name "vim-fugitive")
 | 
			
		||||
    (version "3.6")
 | 
			
		||||
    (version "3.7")
 | 
			
		||||
    (source
 | 
			
		||||
      (origin
 | 
			
		||||
        (method git-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -470,7 +470,7 @@ trouble using them, because you do not have to remember each snippet name.")
 | 
			
		|||
               (commit (string-append "v" version))))
 | 
			
		||||
        (file-name (git-file-name name version))
 | 
			
		||||
        (sha256
 | 
			
		||||
         (base32 "17c3wzqkbzbf0nmlxpgk90yyv3d09209fqxqysand8bzb1cbfwzn"))))
 | 
			
		||||
         (base32 "138290g2aph1jjhaza6biky5qi4ka6435s01bwxivllgb53g3irc"))))
 | 
			
		||||
    (build-system copy-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     '(#:install-plan
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1590,16 +1590,16 @@ input from UTF-8 into the locale's encoding.")
 | 
			
		|||
(define-public mkfontscale
 | 
			
		||||
  (package
 | 
			
		||||
    (name "mkfontscale")
 | 
			
		||||
    (version "1.2.1")
 | 
			
		||||
    (version "1.2.2")
 | 
			
		||||
    (source
 | 
			
		||||
      (origin
 | 
			
		||||
        (method url-fetch)
 | 
			
		||||
        (uri (string-append
 | 
			
		||||
               "mirror://xorg/individual/app/mkfontscale-"
 | 
			
		||||
               version
 | 
			
		||||
               ".tar.bz2"))
 | 
			
		||||
               ".tar.xz"))
 | 
			
		||||
        (sha256
 | 
			
		||||
          (base32 "1ixsnsm2mn0zy9ksdid0lj6irnhvasfik9mz8bbrs5sajzmra16a"))))
 | 
			
		||||
          (base32 "1i6mw97r2s1rb6spjj8fbdsgw6197smaqq2haqgnwhz73xdzpqwa"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
      (list zlib xorgproto freetype libfontenc))
 | 
			
		||||
| 
						 | 
				
			
			@ -1991,14 +1991,14 @@ server.")
 | 
			
		|||
(define-public xauth
 | 
			
		||||
  (package
 | 
			
		||||
    (name "xauth")
 | 
			
		||||
    (version "1.1")
 | 
			
		||||
    (version "1.1.2")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append "mirror://xorg/individual/app/xauth-" version
 | 
			
		||||
                           ".tar.bz2"))
 | 
			
		||||
                           ".tar.xz"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "032klzzw8r09z36x1272ssd79bcisz8j5p8gbdy111fiknvx27bd"))))
 | 
			
		||||
        (base32 "0072ivzn4z59ysanz838nh8s4mcmdsx6q9xkvlfysv2k37ynmfkq"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list libxmu libxext libxau libx11))
 | 
			
		||||
| 
						 | 
				
			
			@ -2067,14 +2067,14 @@ legacy X clients.")
 | 
			
		|||
(define-public xcalc
 | 
			
		||||
  (package
 | 
			
		||||
    (name "xcalc")
 | 
			
		||||
    (version "1.1.0")
 | 
			
		||||
    (version "1.1.1")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append "mirror://xorg/individual/app/"
 | 
			
		||||
                           "xcalc-" version ".tar.gz"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "0c768lh0nh28ram9ldldhaf51024fngc589v4pjmf3lxmzcihr58"))))
 | 
			
		||||
        (base32 "0fwgnva716ymnrf8f4lvnqlyikf5c837054sxxlf3l5jpy4wh6cj"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     `(#:phases (modify-phases %standard-phases
 | 
			
		||||
| 
						 | 
				
			
			@ -2084,8 +2084,7 @@ legacy X clients.")
 | 
			
		|||
                     (substitute* "Makefile"
 | 
			
		||||
                       (("^appdefaultdir = .*$")
 | 
			
		||||
                        (string-append "appdefaultdir = " %output
 | 
			
		||||
                                       ,%app-defaults-dir "\n")))
 | 
			
		||||
                     #t)))))
 | 
			
		||||
                                       ,%app-defaults-dir "\n"))))))))
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list libxaw))
 | 
			
		||||
    (native-inputs
 | 
			
		||||
| 
						 | 
				
			
			@ -2299,17 +2298,17 @@ left-handed version of the cursors is also included.")
 | 
			
		|||
(define-public xdpyinfo
 | 
			
		||||
  (package
 | 
			
		||||
    (name "xdpyinfo")
 | 
			
		||||
    (version "1.3.2")
 | 
			
		||||
    (version "1.3.3")
 | 
			
		||||
    (source
 | 
			
		||||
      (origin
 | 
			
		||||
        (method url-fetch)
 | 
			
		||||
        (uri (string-append
 | 
			
		||||
               "mirror://xorg/individual/app/xdpyinfo-"
 | 
			
		||||
               version
 | 
			
		||||
               ".tar.bz2"))
 | 
			
		||||
               ".tar.xz"))
 | 
			
		||||
        (sha256
 | 
			
		||||
          (base32
 | 
			
		||||
            "0ldgrj4w2fa8jng4b3f3biaj0wyn8zvya88pnk70d7k12pcqw8rh"))))
 | 
			
		||||
            "01n21ygbvzycjasv97rk33b14qdbshr1pkxysqvfx61y5zb5yv9m"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
      (list xorgproto
 | 
			
		||||
| 
						 | 
				
			
			@ -2486,15 +2485,15 @@ including most mice, keyboards, tablets and touchscreens.")
 | 
			
		|||
(define-public xf86-input-libinput
 | 
			
		||||
  (package
 | 
			
		||||
    (name "xf86-input-libinput")
 | 
			
		||||
    (version "1.1.0")
 | 
			
		||||
    (version "1.2.1")
 | 
			
		||||
    (source (origin
 | 
			
		||||
              (method url-fetch)
 | 
			
		||||
              (uri (string-append
 | 
			
		||||
                    "mirror://xorg/individual/driver/"
 | 
			
		||||
                    name "-" version ".tar.bz2"))
 | 
			
		||||
                    name "-" version ".tar.xz"))
 | 
			
		||||
              (sha256
 | 
			
		||||
               (base32
 | 
			
		||||
                "05ldqr10f2rrnshyk3lc773rz0gp3ccdzwa8n7lsc94i850jl7g1"))))
 | 
			
		||||
                "06wpgqga4kc5ph5bd5cabfg0gdcdkbd65jrdx467qcfvkmdxnlc1"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (arguments
 | 
			
		||||
     '(#:configure-flags
 | 
			
		||||
| 
						 | 
				
			
			@ -2658,14 +2657,14 @@ as USB mice.")
 | 
			
		|||
(define-public xf86-video-amdgpu
 | 
			
		||||
  (package
 | 
			
		||||
    (name "xf86-video-amdgpu")
 | 
			
		||||
    (version "21.0.0")
 | 
			
		||||
    (version "22.0.0")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append "mirror://xorg/individual/driver/"
 | 
			
		||||
                           "xf86-video-amdgpu-" version ".tar.bz2"))
 | 
			
		||||
                           "xf86-video-amdgpu-" version ".tar.xz"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "125dq85n46yqmnmr2hknxwcqicwlvz2b2phf0m963fpg9l1j6y30"))))
 | 
			
		||||
        (base32 "0rl2fxhhgcjywn2z8h9gmvm58zjy93lx391ax76krp0m55hgn8wx"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (inputs (list xorg-server))
 | 
			
		||||
    (native-inputs (list pkg-config))
 | 
			
		||||
| 
						 | 
				
			
			@ -2777,14 +2776,14 @@ X server.")
 | 
			
		|||
(define-public xf86-video-dummy
 | 
			
		||||
  (package
 | 
			
		||||
    (name "xf86-video-dummy")
 | 
			
		||||
    (version "0.3.8")
 | 
			
		||||
    (version "0.4.0")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append "mirror://xorg/individual/driver/"
 | 
			
		||||
                           "xf86-video-dummy-" version ".tar.bz2"))
 | 
			
		||||
                           "xf86-video-dummy-" version ".tar.xz"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32 "1fcm9vwgv8wnffbvkzddk4yxrh3kc0np6w65wj8k88q7jf3bn4ip"))))
 | 
			
		||||
        (base32 "0nhy9sd49ig9z00mp9sjbdkfzjgsm71szwjqnry8qn60r3jym377"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (inputs (list xorg-server))
 | 
			
		||||
    (native-inputs (list pkg-config))
 | 
			
		||||
| 
						 | 
				
			
			@ -4091,17 +4090,17 @@ running on X server.")
 | 
			
		|||
(define-public xlsfonts
 | 
			
		||||
  (package
 | 
			
		||||
    (name "xlsfonts")
 | 
			
		||||
    (version "1.0.6")
 | 
			
		||||
    (version "1.0.7")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
       (uri (string-append
 | 
			
		||||
             "mirror://xorg/individual/app/xlsfonts-"
 | 
			
		||||
             version
 | 
			
		||||
             ".tar.bz2"))
 | 
			
		||||
             ".tar.xz"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "0s6kxgv78chkwsqmhw929f4pf91gq63f4yvixxnan1h00cx0pf49"))))
 | 
			
		||||
         "0r84wp4352hbfcaybqp2khipm40293byvrfyrlslrd37m52njwkv"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list xorgproto libx11))
 | 
			
		||||
| 
						 | 
				
			
			@ -4217,7 +4216,7 @@ tastes.")
 | 
			
		|||
(define-public xorg-sgml-doctools
 | 
			
		||||
  (package
 | 
			
		||||
    (name "xorg-sgml-doctools")
 | 
			
		||||
    (version "1.11")
 | 
			
		||||
    (version "1.12")
 | 
			
		||||
    (source
 | 
			
		||||
      (origin
 | 
			
		||||
        (method url-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -4227,7 +4226,7 @@ tastes.")
 | 
			
		|||
               ".tar.bz2"))
 | 
			
		||||
        (sha256
 | 
			
		||||
          (base32
 | 
			
		||||
            "0k5pffyi5bx8dmfn033cyhgd3gf6viqj3x769fqixifwhbgy2777"))))
 | 
			
		||||
            "01n8zqlkqjcxk1c59pk279y08gzhc14r03dhq3lxayy1xpfzvab5"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (native-inputs (list pkg-config))
 | 
			
		||||
    (home-page "https://www.x.org/wiki/")
 | 
			
		||||
| 
						 | 
				
			
			@ -5681,7 +5680,7 @@ Intrinsics (Xt) Library.")
 | 
			
		|||
(define-public twm
 | 
			
		||||
  (package
 | 
			
		||||
    (name "twm")
 | 
			
		||||
    (version "1.0.11")
 | 
			
		||||
    (version "1.0.12")
 | 
			
		||||
    (source
 | 
			
		||||
     (origin
 | 
			
		||||
       (method url-fetch)
 | 
			
		||||
| 
						 | 
				
			
			@ -5689,7 +5688,7 @@ Intrinsics (Xt) Library.")
 | 
			
		|||
                           version ".tar.xz"))
 | 
			
		||||
       (sha256
 | 
			
		||||
        (base32
 | 
			
		||||
         "1iv8kdb18n9vk3is5fyh6l40ipq9mkgx8ppj86byf464vr1ais7l"))))
 | 
			
		||||
         "1r5gfv1gvcjn39v7n6znpnvifwhlw2zf8gfrxq8vph84vva03wma"))))
 | 
			
		||||
    (build-system gnu-build-system)
 | 
			
		||||
    (inputs
 | 
			
		||||
     (list libxt libxmu libxext xorgproto))
 | 
			
		||||
| 
						 | 
				
			
			@ -6486,8 +6485,6 @@ X11 servers, Windows, or macOS.")
 | 
			
		|||
                  (guix build emacs-utils))
 | 
			
		||||
       #:imported-modules (,@%gnu-build-system-modules
 | 
			
		||||
                           (guix build emacs-utils))
 | 
			
		||||
       #:parallel-build? #f ; for reproducible generation of
 | 
			
		||||
                            ; share/uim/installed-modules.scm
 | 
			
		||||
       #:configure-flags
 | 
			
		||||
       (list "--with-anthy-utf8"
 | 
			
		||||
             (string-append "--with-lispdir=" %output "/share/emacs")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -2,6 +2,7 @@
 | 
			
		|||
;;; Copyright © 2021 Liliana Marie Prikler <liliana.prikler@gmail.com>
 | 
			
		||||
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 | 
			
		||||
;;; Copyright © 2021 Calum Irwin <calumirwin1@gmail.com>
 | 
			
		||||
;;; Copyright © 2022 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;;
 | 
			
		||||
;;; This file is part of GNU Guix.
 | 
			
		||||
;;;
 | 
			
		||||
| 
						 | 
				
			
			@ -99,4 +100,7 @@ toolchain.  Among other features it provides
 | 
			
		|||
@item concurrency via async functions.
 | 
			
		||||
@end itemize")
 | 
			
		||||
    (home-page "https://github.com/ziglang/zig")
 | 
			
		||||
    ;; Currently building zig can take up to 10GB of RAM for linking stage1:
 | 
			
		||||
    ;; https://github.com/ziglang/zig/issues/6485
 | 
			
		||||
    (supported-systems %64bit-supported-systems)
 | 
			
		||||
    (license license:expat)))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -4,6 +4,7 @@
 | 
			
		|||
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
 | 
			
		||||
;;; Copyright © 2021 B. Wilson <elaexuotee@wilsonb.com>
 | 
			
		||||
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 | 
			
		||||
;;;
 | 
			
		||||
;;; This file is part of GNU Guix.
 | 
			
		||||
;;;
 | 
			
		||||
| 
						 | 
				
			
			@ -21,9 +22,12 @@
 | 
			
		|||
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 | 
			
		||||
 | 
			
		||||
(define-module (gnu services linux)
 | 
			
		||||
  #:use-module (guix diagnostics)
 | 
			
		||||
  #:use-module (guix gexp)
 | 
			
		||||
  #:use-module (guix records)
 | 
			
		||||
  #:use-module (guix modules)
 | 
			
		||||
  #:use-module (guix i18n)
 | 
			
		||||
  #:use-module (guix ui)
 | 
			
		||||
  #:use-module (gnu services)
 | 
			
		||||
  #:use-module (gnu services base)
 | 
			
		||||
  #:use-module (gnu services shepherd)
 | 
			
		||||
| 
						 | 
				
			
			@ -252,7 +256,21 @@ representation."
 | 
			
		|||
  (memory-limit             zram-device-configuration-memory-limit
 | 
			
		||||
                            (default 0))        ; string or integer
 | 
			
		||||
  (priority                 zram-device-configuration-priority
 | 
			
		||||
                            (default -1)))      ; integer
 | 
			
		||||
                            (default #f)        ; integer | #f
 | 
			
		||||
                            (delayed) ; to avoid printing the deprecation
 | 
			
		||||
                                      ; warning multiple times
 | 
			
		||||
                            (sanitize warn-zram-priority-change)))
 | 
			
		||||
 | 
			
		||||
(define-with-syntax-properties
 | 
			
		||||
  (warn-zram-priority-change (priority properties))
 | 
			
		||||
  (if (eqv? priority -1)
 | 
			
		||||
      (begin
 | 
			
		||||
        (warning (source-properties->location properties)
 | 
			
		||||
                 (G_ "using -1 for zram priority is deprecated~%"))
 | 
			
		||||
        (display-hint (G_ "Use #f or leave as default instead (@pxref{Linux \
 | 
			
		||||
Services})."))
 | 
			
		||||
        #f)
 | 
			
		||||
      priority))
 | 
			
		||||
 | 
			
		||||
(define (zram-device-configuration->udev-string config)
 | 
			
		||||
  "Translate a <zram-device-configuration> into a string which can be
 | 
			
		||||
| 
						 | 
				
			
			@ -278,9 +296,12 @@ placed in a udev rules file."
 | 
			
		|||
         "")
 | 
			
		||||
       "RUN+=\"/run/current-system/profile/sbin/mkswap /dev/zram0\" "
 | 
			
		||||
       "RUN+=\"/run/current-system/profile/sbin/swapon "
 | 
			
		||||
       (if (not (equal? -1 priority))
 | 
			
		||||
         (string-append "--priority " (number->string priority) " ")
 | 
			
		||||
         "")
 | 
			
		||||
       ;; TODO: Revert to simply use 'priority' after removing the deprecation
 | 
			
		||||
       ;; warning and the delayed property of the field.
 | 
			
		||||
       (let ((priority* (force priority)))
 | 
			
		||||
         (if priority*
 | 
			
		||||
             (format #f "--priority ~a " priority*)
 | 
			
		||||
             ""))
 | 
			
		||||
       "/dev/zram0\"\n"))))
 | 
			
		||||
 | 
			
		||||
(define %zram-device-config
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -26,6 +26,7 @@
 | 
			
		|||
  #:use-module (gnu packages admin)
 | 
			
		||||
  #:use-module (gnu packages certs)
 | 
			
		||||
  #:use-module (gnu packages glib)
 | 
			
		||||
  #:use-module (gnu packages guile-xyz)
 | 
			
		||||
  #:use-module (gnu packages jami)
 | 
			
		||||
  #:use-module (gnu packages telephony)
 | 
			
		||||
  #:use-module (guix deprecation)
 | 
			
		||||
| 
						 | 
				
			
			@ -48,7 +49,7 @@
 | 
			
		|||
            jami-account-name-server-uri
 | 
			
		||||
 | 
			
		||||
            jami-configuration
 | 
			
		||||
            jami-configuration-jamid
 | 
			
		||||
            jami-configuration-libjami
 | 
			
		||||
            jami-configuration-dbus
 | 
			
		||||
            jami-configuration-enable-logging?
 | 
			
		||||
            jami-configuration-debug?
 | 
			
		||||
| 
						 | 
				
			
			@ -227,11 +228,11 @@ SET-ACCOUNT-DETAILS."
 | 
			
		|||
(define-maybe/no-serialization jami-account-list)
 | 
			
		||||
 | 
			
		||||
(define-configuration/no-serialization jami-configuration
 | 
			
		||||
  (jamid
 | 
			
		||||
  (libjami
 | 
			
		||||
   (file-like libjami)
 | 
			
		||||
   "The Jami daemon package to use.")
 | 
			
		||||
  (dbus
 | 
			
		||||
   (file-like dbus)
 | 
			
		||||
   (file-like dbus-for-jami)
 | 
			
		||||
   "The D-Bus package to use to start the required D-Bus session.")
 | 
			
		||||
  (nss-certs
 | 
			
		||||
   (file-like nss-certs)
 | 
			
		||||
| 
						 | 
				
			
			@ -265,8 +266,8 @@ consistent state."))
 | 
			
		|||
  "Derive the command line arguments to used to launch the Jami daemon from
 | 
			
		||||
CONFIG, a <jami-configuration> object."
 | 
			
		||||
  (match-record config <jami-configuration>
 | 
			
		||||
    (jamid dbus enable-logging? debug? auto-answer?)
 | 
			
		||||
    `(,(file-append jamid "/libexec/jamid")
 | 
			
		||||
    (libjami dbus enable-logging? debug? auto-answer?)
 | 
			
		||||
    `(,(file-append libjami "/libexec/jamid")
 | 
			
		||||
      "--persistent"                    ;stay alive after client quits
 | 
			
		||||
      ,@(if enable-logging?
 | 
			
		||||
            '()                         ;logs go to syslog by default
 | 
			
		||||
| 
						 | 
				
			
			@ -284,34 +285,48 @@ CONFIG, a <jami-configuration> object."
 | 
			
		|||
    #~(begin
 | 
			
		||||
        (use-modules (gnu build activation))
 | 
			
		||||
        (let ((user (getpwnam "jami")))
 | 
			
		||||
          (mkdir-p/perms "/var/run/jami" user #o700)))))
 | 
			
		||||
          (mkdir-p/perms "/var/run/jami" user #o700)
 | 
			
		||||
          ;; Customize the D-Bus policy to allow 'root' to access other users'
 | 
			
		||||
          ;; session bus.  Also modify the location of the written PID file,
 | 
			
		||||
          ;; from the default '/var/run/dbus/pid' location.  This file is only
 | 
			
		||||
          ;; honored by the 'dbus-for-jami' package variant.
 | 
			
		||||
          (call-with-output-file "/var/run/jami/session-local.conf"
 | 
			
		||||
            (lambda (port)
 | 
			
		||||
              (format port "\
 | 
			
		||||
<busconfig>
 | 
			
		||||
  <pidfile>/var/run/jami/pid</pidfile>
 | 
			
		||||
  <policy context=\"mandatory\">
 | 
			
		||||
    <allow user=\"root\"/>
 | 
			
		||||
  </policy>
 | 
			
		||||
</busconfig>~%")))))))
 | 
			
		||||
 | 
			
		||||
(define (jami-shepherd-services config)
 | 
			
		||||
  "Return a <shepherd-service> running the Jami daemon."
 | 
			
		||||
  (let* ((jamid (jami-configuration-jamid config))
 | 
			
		||||
  (let* ((libjami (jami-configuration-libjami config))
 | 
			
		||||
         (nss-certs (jami-configuration-nss-certs config))
 | 
			
		||||
         (dbus (jami-configuration-dbus config))
 | 
			
		||||
         (dbus-daemon (file-append dbus "/bin/dbus-daemon"))
 | 
			
		||||
         (dbus-send (file-append dbus "/bin/dbus-send"))
 | 
			
		||||
         (accounts (jami-configuration-accounts config))
 | 
			
		||||
         (declarative-mode? (not (eq? 'disabled accounts))))
 | 
			
		||||
 | 
			
		||||
    (with-imported-modules (source-module-closure
 | 
			
		||||
                            '((gnu build jami-service)
 | 
			
		||||
                              (gnu build shepherd)
 | 
			
		||||
                              (gnu system file-systems)))
 | 
			
		||||
    (with-extensions (list guile-packrat ;used by guile-ac-d-bus
 | 
			
		||||
                           guile-ac-d-bus
 | 
			
		||||
                           ;; Fibers is needed to provide the non-blocking
 | 
			
		||||
                           ;; variant of the 'sleep' procedure.
 | 
			
		||||
                           guile-fibers)
 | 
			
		||||
      (with-imported-modules (source-module-closure
 | 
			
		||||
                              '((gnu build dbus-service)
 | 
			
		||||
                                (gnu build jami-service)
 | 
			
		||||
                                (gnu build shepherd)
 | 
			
		||||
                                (gnu system file-systems)))
 | 
			
		||||
 | 
			
		||||
      (define list-accounts-action
 | 
			
		||||
        (shepherd-action
 | 
			
		||||
         (name 'list-accounts)
 | 
			
		||||
         (documentation "List the available Jami accounts.  Return the account
 | 
			
		||||
        (define list-accounts-action
 | 
			
		||||
          (shepherd-action
 | 
			
		||||
           (name 'list-accounts)
 | 
			
		||||
           (documentation "List the available Jami accounts.  Return the account
 | 
			
		||||
details alists keyed by their account username.")
 | 
			
		||||
         (procedure
 | 
			
		||||
          #~(lambda _
 | 
			
		||||
              (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                             (%send-dbus-user   "jami")
 | 
			
		||||
                             (%send-dbus-group  "jami"))
 | 
			
		||||
           (procedure
 | 
			
		||||
            #~(lambda _
 | 
			
		||||
                ;; Print the accounts summary or long listing, according to
 | 
			
		||||
                ;; user-provided option.
 | 
			
		||||
                (let* ((usernames (get-usernames))
 | 
			
		||||
| 
						 | 
				
			
			@ -341,39 +356,31 @@ details alists keyed by their account username.")
 | 
			
		|||
                      accounts)
 | 
			
		||||
                     (display "\n")))
 | 
			
		||||
                  ;; Return the account-details-list alist.
 | 
			
		||||
                  (map cons usernames accounts)))))))
 | 
			
		||||
                  (map cons usernames accounts))))))
 | 
			
		||||
 | 
			
		||||
      (define list-account-details-action
 | 
			
		||||
        (shepherd-action
 | 
			
		||||
         (name 'list-account-details)
 | 
			
		||||
         (documentation "Display the account details of the available Jami
 | 
			
		||||
        (define list-account-details-action
 | 
			
		||||
          (shepherd-action
 | 
			
		||||
           (name 'list-account-details)
 | 
			
		||||
           (documentation "Display the account details of the available Jami
 | 
			
		||||
accounts in the @code{recutils} format.  Return the account details alists
 | 
			
		||||
keyed by their account username.")
 | 
			
		||||
         (procedure
 | 
			
		||||
          #~(lambda _
 | 
			
		||||
              (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                             (%send-dbus-user   "jami")
 | 
			
		||||
                             (%send-dbus-group  "jami"))
 | 
			
		||||
           (procedure
 | 
			
		||||
            #~(lambda _
 | 
			
		||||
                (let* ((usernames (get-usernames))
 | 
			
		||||
                       (accounts (map-in-order username->account usernames)))
 | 
			
		||||
                  (for-each (lambda (account)
 | 
			
		||||
                              (display (account-details->recutil account))
 | 
			
		||||
                              (display "\n\n"))
 | 
			
		||||
                            accounts)
 | 
			
		||||
                  (map cons usernames accounts)))))))
 | 
			
		||||
                  (map cons usernames accounts))))))
 | 
			
		||||
 | 
			
		||||
      (define list-contacts-action
 | 
			
		||||
        (shepherd-action
 | 
			
		||||
         (name 'list-contacts)
 | 
			
		||||
         (documentation "Display the contacts for each Jami account.  Return
 | 
			
		||||
        (define list-contacts-action
 | 
			
		||||
          (shepherd-action
 | 
			
		||||
           (name 'list-contacts)
 | 
			
		||||
           (documentation "Display the contacts for each Jami account.  Return
 | 
			
		||||
an alist containing the contacts keyed by the account usernames.")
 | 
			
		||||
         (procedure
 | 
			
		||||
          #~(lambda _
 | 
			
		||||
              (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                             (%send-dbus-user   "jami")
 | 
			
		||||
                             (%send-dbus-group  "jami"))
 | 
			
		||||
           (procedure
 | 
			
		||||
            #~(lambda _
 | 
			
		||||
                (let* ((usernames (get-usernames))
 | 
			
		||||
                       (contacts (map-in-order username->contacts usernames)))
 | 
			
		||||
                  (for-each (lambda (username contacts)
 | 
			
		||||
| 
						 | 
				
			
			@ -381,19 +388,15 @@ an alist containing the contacts keyed by the account usernames.")
 | 
			
		|||
                                      username)
 | 
			
		||||
                              (format #t "~{  - ~a~%~}~%" contacts))
 | 
			
		||||
                            usernames contacts)
 | 
			
		||||
                  (map cons usernames contacts)))))))
 | 
			
		||||
                  (map cons usernames contacts))))))
 | 
			
		||||
 | 
			
		||||
      (define list-moderators-action
 | 
			
		||||
        (shepherd-action
 | 
			
		||||
         (name 'list-moderators)
 | 
			
		||||
         (documentation "Display the moderators for each Jami account.  Return
 | 
			
		||||
        (define list-moderators-action
 | 
			
		||||
          (shepherd-action
 | 
			
		||||
           (name 'list-moderators)
 | 
			
		||||
           (documentation "Display the moderators for each Jami account.  Return
 | 
			
		||||
an alist containing the moderators keyed by the account usernames.")
 | 
			
		||||
         (procedure
 | 
			
		||||
          #~(lambda _
 | 
			
		||||
              (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                             (%send-dbus-user   "jami")
 | 
			
		||||
                             (%send-dbus-group  "jami"))
 | 
			
		||||
           (procedure
 | 
			
		||||
            #~(lambda _
 | 
			
		||||
                (let* ((usernames (get-usernames))
 | 
			
		||||
                       (moderators (map-in-order username->moderators
 | 
			
		||||
                                                 usernames)))
 | 
			
		||||
| 
						 | 
				
			
			@ -406,12 +409,12 @@ an alist containing the moderators keyed by the account usernames.")
 | 
			
		|||
                           (format #t "Moderators for account ~a:~%" username)
 | 
			
		||||
                           (format #t "~{  - ~a~%~}~%" moderators))))
 | 
			
		||||
                   usernames moderators)
 | 
			
		||||
                  (map cons usernames moderators)))))))
 | 
			
		||||
                  (map cons usernames moderators))))))
 | 
			
		||||
 | 
			
		||||
      (define add-moderator-action
 | 
			
		||||
        (shepherd-action
 | 
			
		||||
         (name 'add-moderator)
 | 
			
		||||
         (documentation "Add a moderator for a given Jami account.  The
 | 
			
		||||
        (define add-moderator-action
 | 
			
		||||
          (shepherd-action
 | 
			
		||||
           (name 'add-moderator)
 | 
			
		||||
           (documentation "Add a moderator for a given Jami account.  The
 | 
			
		||||
MODERATOR contact must be given as its 40 characters fingerprint, while the
 | 
			
		||||
Jami account can be provided as its registered USERNAME or fingerprint.
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -420,21 +423,17 @@ herd add-moderator jami 1dbcb0f5f37324228235564b79f2b9737e9a008f username
 | 
			
		|||
@end example
 | 
			
		||||
 | 
			
		||||
Return the moderators for the account known by USERNAME.")
 | 
			
		||||
         (procedure
 | 
			
		||||
          #~(lambda (_ moderator username)
 | 
			
		||||
              (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                             (%send-dbus-user   "jami")
 | 
			
		||||
                             (%send-dbus-group  "jami"))
 | 
			
		||||
           (procedure
 | 
			
		||||
            #~(lambda (_ moderator username)
 | 
			
		||||
                (set-all-moderators #f username)
 | 
			
		||||
                (add-contact moderator username)
 | 
			
		||||
                (set-moderator moderator #t username)
 | 
			
		||||
                (username->moderators username))))))
 | 
			
		||||
                (username->moderators username)))))
 | 
			
		||||
 | 
			
		||||
      (define ban-contact-action
 | 
			
		||||
        (shepherd-action
 | 
			
		||||
         (name 'ban-contact)
 | 
			
		||||
         (documentation "Ban a contact for a given or all Jami accounts, and
 | 
			
		||||
        (define ban-contact-action
 | 
			
		||||
          (shepherd-action
 | 
			
		||||
           (name 'ban-contact)
 | 
			
		||||
           (documentation "Ban a contact for a given or all Jami accounts, and
 | 
			
		||||
clear their moderator flag.  The CONTACT must be given as its 40 characters
 | 
			
		||||
fingerprint, while the Jami account can be provided as its registered USERNAME
 | 
			
		||||
or fingerprint, or omitted.  When the account is omitted, CONTACT is banned
 | 
			
		||||
| 
						 | 
				
			
			@ -443,31 +442,22 @@ from all accounts.
 | 
			
		|||
@example
 | 
			
		||||
herd ban-contact jami 1dbcb0f5f37324228235564b79f2b9737e9a008f [username]
 | 
			
		||||
@end example")
 | 
			
		||||
         (procedure
 | 
			
		||||
          #~(lambda* (_ contact #:optional username)
 | 
			
		||||
              (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                             (%send-dbus-user   "jami")
 | 
			
		||||
                             (%send-dbus-group  "jami"))
 | 
			
		||||
           (procedure
 | 
			
		||||
            #~(lambda* (_ contact #:optional username)
 | 
			
		||||
                (let ((usernames (or (and=> username list)
 | 
			
		||||
                                     (get-usernames))))
 | 
			
		||||
                  (for-each (lambda (username)
 | 
			
		||||
                              (set-moderator contact #f username)
 | 
			
		||||
                              (remove-contact contact username #:ban? #t))
 | 
			
		||||
                            usernames)))))))
 | 
			
		||||
                            usernames))))))
 | 
			
		||||
 | 
			
		||||
      (define list-banned-contacts-action
 | 
			
		||||
        (shepherd-action
 | 
			
		||||
         (name 'list-banned-contacts)
 | 
			
		||||
         (documentation "List the banned contacts for each accounts.  Return
 | 
			
		||||
        (define list-banned-contacts-action
 | 
			
		||||
          (shepherd-action
 | 
			
		||||
           (name 'list-banned-contacts)
 | 
			
		||||
           (documentation "List the banned contacts for each accounts.  Return
 | 
			
		||||
an alist of the banned contacts, keyed by the account usernames.")
 | 
			
		||||
         (procedure
 | 
			
		||||
          #~(lambda _
 | 
			
		||||
              (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                             (%send-dbus-user   "jami")
 | 
			
		||||
                             (%send-dbus-group  "jami"))
 | 
			
		||||
 | 
			
		||||
           (procedure
 | 
			
		||||
            #~(lambda _
 | 
			
		||||
                (define banned-contacts
 | 
			
		||||
                  (let ((usernames (get-usernames)))
 | 
			
		||||
                    (map cons usernames
 | 
			
		||||
| 
						 | 
				
			
			@ -484,183 +474,157 @@ an alist of the banned contacts, keyed by the account usernames.")
 | 
			
		|||
                                       username)
 | 
			
		||||
                               (format #t "~{  - ~a~%~}~%" banned))))
 | 
			
		||||
                          banned-contacts)
 | 
			
		||||
                banned-contacts)))))
 | 
			
		||||
                banned-contacts))))
 | 
			
		||||
 | 
			
		||||
      (define enable-account-action
 | 
			
		||||
        (shepherd-action
 | 
			
		||||
         (name 'enable-account)
 | 
			
		||||
         (documentation "Enable an account.  It takes USERNAME as an argument,
 | 
			
		||||
        (define enable-account-action
 | 
			
		||||
          (shepherd-action
 | 
			
		||||
           (name 'enable-account)
 | 
			
		||||
           (documentation "Enable an account.  It takes USERNAME as an argument,
 | 
			
		||||
either a registered username or the fingerprint of the account.")
 | 
			
		||||
         (procedure
 | 
			
		||||
          #~(lambda (_ username)
 | 
			
		||||
              (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                             (%send-dbus-user   "jami")
 | 
			
		||||
                             (%send-dbus-group  "jami"))
 | 
			
		||||
                (enable-account username))))))
 | 
			
		||||
           (procedure
 | 
			
		||||
            #~(lambda (_ username)
 | 
			
		||||
                (enable-account username)))))
 | 
			
		||||
 | 
			
		||||
      (define disable-account-action
 | 
			
		||||
        (shepherd-action
 | 
			
		||||
         (name 'disable-account)
 | 
			
		||||
         (documentation "Disable an account.  It takes USERNAME as an
 | 
			
		||||
        (define disable-account-action
 | 
			
		||||
          (shepherd-action
 | 
			
		||||
           (name 'disable-account)
 | 
			
		||||
           (documentation "Disable an account.  It takes USERNAME as an
 | 
			
		||||
argument, either a registered username or the fingerprint of the account.")
 | 
			
		||||
         (procedure
 | 
			
		||||
          #~(lambda (_ username)
 | 
			
		||||
              (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                             (%send-dbus-user   "jami")
 | 
			
		||||
                             (%send-dbus-group  "jami"))
 | 
			
		||||
                (disable-account username))))))
 | 
			
		||||
           (procedure
 | 
			
		||||
            #~(lambda (_ username)
 | 
			
		||||
                (disable-account username)))))
 | 
			
		||||
 | 
			
		||||
      (list (shepherd-service
 | 
			
		||||
             (documentation "Run a D-Bus session for the Jami daemon.")
 | 
			
		||||
             (provision '(jami-dbus-session))
 | 
			
		||||
             (modules `((gnu build shepherd)
 | 
			
		||||
                        (gnu build jami-service)
 | 
			
		||||
                        (gnu system file-systems)
 | 
			
		||||
                        ,@%default-modules))
 | 
			
		||||
             ;; The requirement on dbus-system is to ensure other required
 | 
			
		||||
             ;; activation for D-Bus, such as a /etc/machine-id file.
 | 
			
		||||
             (requirement '(dbus-system syslogd))
 | 
			
		||||
             (start
 | 
			
		||||
              #~(lambda args
 | 
			
		||||
                  (define pid
 | 
			
		||||
                    ((make-forkexec-constructor/container
 | 
			
		||||
                      (list #$dbus-daemon "--session"
 | 
			
		||||
                            "--address=unix:path=/var/run/jami/bus"
 | 
			
		||||
                            "--nofork" "--syslog-only" "--nopidfile")
 | 
			
		||||
                      #:mappings (list (file-system-mapping
 | 
			
		||||
                                        (source "/dev/log") ;for syslog
 | 
			
		||||
                                        (target source))
 | 
			
		||||
                                       (file-system-mapping
 | 
			
		||||
                                        (source "/var/run/jami")
 | 
			
		||||
                                        (target source)
 | 
			
		||||
                                        (writable? #t)))
 | 
			
		||||
                      #:user "jami"
 | 
			
		||||
                      #:group "jami"
 | 
			
		||||
                      #:environment-variables
 | 
			
		||||
                      ;; This is so that the cx.ring.Ring service D-Bus
 | 
			
		||||
                      ;; definition is found by dbus-send.
 | 
			
		||||
                      (list (string-append "XDG_DATA_DIRS="
 | 
			
		||||
                                           #$jamid "/share")))))
 | 
			
		||||
        (list (shepherd-service
 | 
			
		||||
               (documentation "Run a D-Bus session for the Jami daemon.")
 | 
			
		||||
               (provision '(jami-dbus-session))
 | 
			
		||||
               (modules `((gnu build shepherd)
 | 
			
		||||
                          (gnu build dbus-service)
 | 
			
		||||
                          (gnu build jami-service)
 | 
			
		||||
                          (gnu system file-systems)
 | 
			
		||||
                          ,@%default-modules))
 | 
			
		||||
               ;; The requirement on dbus-system is to ensure other required
 | 
			
		||||
               ;; activation for D-Bus, such as a /etc/machine-id file.
 | 
			
		||||
               (requirement '(dbus-system syslogd))
 | 
			
		||||
               (start
 | 
			
		||||
                #~(make-forkexec-constructor/container
 | 
			
		||||
                   (list #$dbus-daemon "--session"
 | 
			
		||||
                         "--address=unix:path=/var/run/jami/bus"
 | 
			
		||||
                         "--syslog-only")
 | 
			
		||||
                   #:pid-file "/var/run/jami/pid"
 | 
			
		||||
                   #:mappings
 | 
			
		||||
                   (list (file-system-mapping
 | 
			
		||||
                          (source "/dev/log") ;for syslog
 | 
			
		||||
                          (target source))
 | 
			
		||||
                         (file-system-mapping
 | 
			
		||||
                          (source "/var/run/jami")
 | 
			
		||||
                          (target source)
 | 
			
		||||
                          (writable? #t)))
 | 
			
		||||
                   #:user "jami"
 | 
			
		||||
                   #:group "jami"
 | 
			
		||||
                   #:environment-variables
 | 
			
		||||
                   ;; This is so that the cx.ring.Ring service D-Bus
 | 
			
		||||
                   ;; definition is found by dbus-daemon.
 | 
			
		||||
                   (list (string-append "XDG_DATA_DIRS=" #$libjami "/share"))))
 | 
			
		||||
               (stop #~(make-kill-destructor)))
 | 
			
		||||
 | 
			
		||||
                  ;; XXX: This manual synchronization probably wouldn't be
 | 
			
		||||
                  ;; needed if we were using a PID file, but providing it via a
 | 
			
		||||
                  ;; customized config file with <pidfile> would not override
 | 
			
		||||
                  ;; the one inherited from the base config of D-Bus.
 | 
			
		||||
                  (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
 | 
			
		||||
                    (with-retries 20 1 (catch 'system-error
 | 
			
		||||
                                         (lambda ()
 | 
			
		||||
                                           (connect sock AF_UNIX
 | 
			
		||||
                                                    "/var/run/jami/bus")
 | 
			
		||||
                                           (close-port sock)
 | 
			
		||||
                                           #t)
 | 
			
		||||
                                         (lambda args
 | 
			
		||||
                                           #f))))
 | 
			
		||||
              (shepherd-service
 | 
			
		||||
               (documentation "Run the Jami daemon.")
 | 
			
		||||
               (provision '(jami))
 | 
			
		||||
               (actions (list list-accounts-action
 | 
			
		||||
                              list-account-details-action
 | 
			
		||||
                              list-contacts-action
 | 
			
		||||
                              list-moderators-action
 | 
			
		||||
                              add-moderator-action
 | 
			
		||||
                              ban-contact-action
 | 
			
		||||
                              list-banned-contacts-action
 | 
			
		||||
                              enable-account-action
 | 
			
		||||
                              disable-account-action))
 | 
			
		||||
               (requirement '(jami-dbus-session))
 | 
			
		||||
               (modules `((ice-9 format)
 | 
			
		||||
                          (ice-9 ftw)
 | 
			
		||||
                          (ice-9 match)
 | 
			
		||||
                          (ice-9 receive)
 | 
			
		||||
                          (srfi srfi-1)
 | 
			
		||||
                          (srfi srfi-26)
 | 
			
		||||
                          (gnu build dbus-service)
 | 
			
		||||
                          (gnu build jami-service)
 | 
			
		||||
                          (gnu build shepherd)
 | 
			
		||||
                          (gnu system file-systems)
 | 
			
		||||
                          ,@%default-modules))
 | 
			
		||||
               (start
 | 
			
		||||
                #~(lambda args
 | 
			
		||||
                    (define (delete-file-recursively/safe file)
 | 
			
		||||
                      ;; Ensure we're not deleting things outside of
 | 
			
		||||
                      ;; /var/lib/jami.  This prevents a possible attack in case
 | 
			
		||||
                      ;; the daemon is compromised and an attacker gains write
 | 
			
		||||
                      ;; access to /var/lib/jami.
 | 
			
		||||
                      (let ((parent-directory (dirname file)))
 | 
			
		||||
                        (if (eq? 'symlink (stat:type (stat parent-directory)))
 | 
			
		||||
                            (error "abnormality detected; unexpected symlink found at"
 | 
			
		||||
                                   parent-directory)
 | 
			
		||||
                            (delete-file-recursively file))))
 | 
			
		||||
 | 
			
		||||
                  pid))
 | 
			
		||||
             (stop #~(make-kill-destructor)))
 | 
			
		||||
                    (when #$declarative-mode?
 | 
			
		||||
                      ;; Clear the Jami configuration and accounts, to enforce the
 | 
			
		||||
                      ;; declared state.
 | 
			
		||||
                      (catch #t
 | 
			
		||||
                        (lambda ()
 | 
			
		||||
                          (for-each (cut delete-file-recursively/safe <>)
 | 
			
		||||
                                    '("/var/lib/jami/.cache/jami"
 | 
			
		||||
                                      "/var/lib/jami/.config/jami"
 | 
			
		||||
                                      "/var/lib/jami/.local/share/jami"
 | 
			
		||||
                                      "/var/lib/jami/accounts")))
 | 
			
		||||
                        (lambda args
 | 
			
		||||
                          #t))
 | 
			
		||||
                      ;; Copy the Jami account archives from somewhere readable
 | 
			
		||||
                      ;; by root to a place only the jami user can read.
 | 
			
		||||
                      (let* ((accounts-dir "/var/lib/jami/accounts/")
 | 
			
		||||
                             (pwd (getpwnam "jami"))
 | 
			
		||||
                             (user (passwd:uid pwd))
 | 
			
		||||
                             (group (passwd:gid pwd)))
 | 
			
		||||
                        (mkdir-p accounts-dir)
 | 
			
		||||
                        (chown accounts-dir user group)
 | 
			
		||||
                        (for-each (lambda (f)
 | 
			
		||||
                                    (let ((dest (string-append accounts-dir
 | 
			
		||||
                                                               (basename f))))
 | 
			
		||||
                                      (copy-file f dest)
 | 
			
		||||
                                      (chown dest user group)))
 | 
			
		||||
                                  '#$(and declarative-mode?
 | 
			
		||||
                                          (map jami-account-archive accounts)))))
 | 
			
		||||
 | 
			
		||||
            (shepherd-service
 | 
			
		||||
             (documentation "Run the Jami daemon.")
 | 
			
		||||
             (provision '(jami))
 | 
			
		||||
             (actions (list list-accounts-action
 | 
			
		||||
                            list-account-details-action
 | 
			
		||||
                            list-contacts-action
 | 
			
		||||
                            list-moderators-action
 | 
			
		||||
                            add-moderator-action
 | 
			
		||||
                            ban-contact-action
 | 
			
		||||
                            list-banned-contacts-action
 | 
			
		||||
                            enable-account-action
 | 
			
		||||
                            disable-account-action))
 | 
			
		||||
             (requirement '(jami-dbus-session))
 | 
			
		||||
             (modules `((ice-9 format)
 | 
			
		||||
                        (ice-9 ftw)
 | 
			
		||||
                        (ice-9 match)
 | 
			
		||||
                        (ice-9 receive)
 | 
			
		||||
                        (srfi srfi-1)
 | 
			
		||||
                        (srfi srfi-26)
 | 
			
		||||
                        (gnu build jami-service)
 | 
			
		||||
                        (gnu build shepherd)
 | 
			
		||||
                        (gnu system file-systems)
 | 
			
		||||
                        ,@%default-modules))
 | 
			
		||||
             (start
 | 
			
		||||
              #~(lambda args
 | 
			
		||||
                  (define (delete-file-recursively/safe file)
 | 
			
		||||
                    ;; Ensure we're not deleting things outside of
 | 
			
		||||
                    ;; /var/lib/jami.  This prevents a possible attack in case
 | 
			
		||||
                    ;; the daemon is compromised and an attacker gains write
 | 
			
		||||
                    ;; access to /var/lib/jami.
 | 
			
		||||
                    (let ((parent-directory (dirname file)))
 | 
			
		||||
                      (if (eq? 'symlink (stat:type (stat parent-directory)))
 | 
			
		||||
                          (error "abnormality detected; unexpected symlink found at"
 | 
			
		||||
                                 parent-directory)
 | 
			
		||||
                          (delete-file-recursively file))))
 | 
			
		||||
                    ;; Start the daemon.
 | 
			
		||||
                    (define daemon-pid
 | 
			
		||||
                      ((make-forkexec-constructor/container
 | 
			
		||||
                        '#$(jami-configuration->command-line-arguments config)
 | 
			
		||||
                        #:mappings
 | 
			
		||||
                        (list (file-system-mapping
 | 
			
		||||
                               (source "/dev/log") ;for syslog
 | 
			
		||||
                               (target source))
 | 
			
		||||
                              (file-system-mapping
 | 
			
		||||
                               (source "/var/lib/jami")
 | 
			
		||||
                               (target source)
 | 
			
		||||
                               (writable? #t))
 | 
			
		||||
                              (file-system-mapping
 | 
			
		||||
                               (source "/var/run/jami")
 | 
			
		||||
                               (target source)
 | 
			
		||||
                               (writable? #t))
 | 
			
		||||
                              ;; Expose TLS certificates for GnuTLS.
 | 
			
		||||
                              (file-system-mapping
 | 
			
		||||
                               (source #$(file-append nss-certs "/etc/ssl/certs"))
 | 
			
		||||
                               (target "/etc/ssl/certs")))
 | 
			
		||||
                        #:user "jami"
 | 
			
		||||
                        #:group "jami"
 | 
			
		||||
                        #:environment-variables
 | 
			
		||||
                        (list (string-append "DBUS_SESSION_BUS_ADDRESS="
 | 
			
		||||
                                             "unix:path=/var/run/jami/bus")
 | 
			
		||||
                              ;; Expose TLS certificates for OpenSSL.
 | 
			
		||||
                              "SSL_CERT_DIR=/etc/ssl/certs"))))
 | 
			
		||||
 | 
			
		||||
                  (when #$declarative-mode?
 | 
			
		||||
                    ;; Clear the Jami configuration and accounts, to enforce the
 | 
			
		||||
                    ;; declared state.
 | 
			
		||||
                    (catch #t
 | 
			
		||||
                      (lambda ()
 | 
			
		||||
                        (for-each (cut delete-file-recursively/safe <>)
 | 
			
		||||
                                  '("/var/lib/jami/.cache/jami"
 | 
			
		||||
                                    "/var/lib/jami/.config/jami"
 | 
			
		||||
                                    "/var/lib/jami/.local/share/jami"
 | 
			
		||||
                                    "/var/lib/jami/accounts")))
 | 
			
		||||
                      (lambda args
 | 
			
		||||
                        #t))
 | 
			
		||||
                    ;; Copy the Jami account archives from somewhere readable
 | 
			
		||||
                    ;; by root to a place only the jami user can read.
 | 
			
		||||
                    (let* ((accounts-dir "/var/lib/jami/accounts/")
 | 
			
		||||
                           (pwd (getpwnam "jami"))
 | 
			
		||||
                           (user (passwd:uid pwd))
 | 
			
		||||
                           (group (passwd:gid pwd)))
 | 
			
		||||
                      (mkdir-p accounts-dir)
 | 
			
		||||
                      (chown accounts-dir user group)
 | 
			
		||||
                      (for-each (lambda (f)
 | 
			
		||||
                                  (let ((dest (string-append accounts-dir
 | 
			
		||||
                                                             (basename f))))
 | 
			
		||||
                                    (copy-file f dest)
 | 
			
		||||
                                    (chown dest user group)))
 | 
			
		||||
                                '#$(and declarative-mode?
 | 
			
		||||
                                        (map jami-account-archive accounts)))))
 | 
			
		||||
 | 
			
		||||
                  ;; Start the daemon.
 | 
			
		||||
                  (define daemon-pid
 | 
			
		||||
                    ((make-forkexec-constructor/container
 | 
			
		||||
                      '#$(jami-configuration->command-line-arguments config)
 | 
			
		||||
                      #:mappings
 | 
			
		||||
                      (list (file-system-mapping
 | 
			
		||||
                             (source "/dev/log") ;for syslog
 | 
			
		||||
                             (target source))
 | 
			
		||||
                            (file-system-mapping
 | 
			
		||||
                             (source "/var/lib/jami")
 | 
			
		||||
                             (target source)
 | 
			
		||||
                             (writable? #t))
 | 
			
		||||
                            (file-system-mapping
 | 
			
		||||
                             (source "/var/run/jami")
 | 
			
		||||
                             (target source)
 | 
			
		||||
                             (writable? #t))
 | 
			
		||||
                            ;; Expose TLS certificates for GnuTLS.
 | 
			
		||||
                            (file-system-mapping
 | 
			
		||||
                             (source #$(file-append nss-certs "/etc/ssl/certs"))
 | 
			
		||||
                             (target "/etc/ssl/certs")))
 | 
			
		||||
                      #:user "jami"
 | 
			
		||||
                      #:group "jami"
 | 
			
		||||
                      #:environment-variables
 | 
			
		||||
                      (list (string-append "DBUS_SESSION_BUS_ADDRESS="
 | 
			
		||||
                                           "unix:path=/var/run/jami/bus")
 | 
			
		||||
                            ;; Expose TLS certificates for OpenSSL.
 | 
			
		||||
                            "SSL_CERT_DIR=/etc/ssl/certs"))))
 | 
			
		||||
 | 
			
		||||
                  (parameterize ((%send-dbus-binary #$dbus-send)
 | 
			
		||||
                                 (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 | 
			
		||||
                                 (%send-dbus-user   "jami")
 | 
			
		||||
                                 (%send-dbus-group  "jami"))
 | 
			
		||||
                    (setenv "DBUS_SESSION_BUS_ADDRESS"
 | 
			
		||||
                            "unix:path=/var/run/jami/bus")
 | 
			
		||||
 | 
			
		||||
                    ;; Wait until the service name has been acquired by D-Bus.
 | 
			
		||||
                    (with-retries 20 1
 | 
			
		||||
                      (dbus-service-available? "cx.ring.Ring"))
 | 
			
		||||
                    (with-retries 20 1 (jami-service-available?))
 | 
			
		||||
 | 
			
		||||
                    (when #$declarative-mode?
 | 
			
		||||
                      ;; Provision the accounts via the D-Bus API of the daemon.
 | 
			
		||||
| 
						 | 
				
			
			@ -717,17 +681,17 @@ argument, either a registered username or the fingerprint of the account.")
 | 
			
		|||
                                 (map-in-order (cut jami-account-moderators <>)
 | 
			
		||||
                                               accounts))
 | 
			
		||||
                         '#$(and declarative-mode?
 | 
			
		||||
                                 (map-in-order jami-account->alist accounts))))))
 | 
			
		||||
                                 (map-in-order jami-account->alist accounts)))))
 | 
			
		||||
 | 
			
		||||
                  ;; Finally, return the PID of the daemon process.
 | 
			
		||||
                  daemon-pid))
 | 
			
		||||
             (stop
 | 
			
		||||
              #~(lambda (pid . args)
 | 
			
		||||
                  (kill pid SIGKILL)
 | 
			
		||||
                  ;; Wait for the process to exit; this prevents overlapping
 | 
			
		||||
                  ;; processes when issuing 'herd restart'.
 | 
			
		||||
                  (waitpid pid)
 | 
			
		||||
                  #f)))))))
 | 
			
		||||
                    ;; Finally, return the PID of the daemon process.
 | 
			
		||||
                    daemon-pid))
 | 
			
		||||
               (stop
 | 
			
		||||
                #~(lambda (pid . args)
 | 
			
		||||
                    (kill pid SIGKILL)
 | 
			
		||||
                    ;; Wait for the process to exit; this prevents overlapping
 | 
			
		||||
                    ;; processes when issuing 'herd restart'.
 | 
			
		||||
                    (waitpid pid)
 | 
			
		||||
                    #f))))))))
 | 
			
		||||
 | 
			
		||||
(define jami-service-type
 | 
			
		||||
  (service-type
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -20,6 +20,7 @@
 | 
			
		|||
  #:use-module (gnu)
 | 
			
		||||
  #:use-module (gnu packages)
 | 
			
		||||
  #:use-module (gnu packages guile)
 | 
			
		||||
  #:use-module (gnu packages guile-xyz)
 | 
			
		||||
  #:use-module (gnu tests)
 | 
			
		||||
  #:use-module (gnu system vm)
 | 
			
		||||
  #:use-module (gnu services)
 | 
			
		||||
| 
						 | 
				
			
			@ -125,221 +126,204 @@ accounts provisioning feature of the service."
 | 
			
		|||
                              "Account.username"))
 | 
			
		||||
 | 
			
		||||
  (define test
 | 
			
		||||
    (with-imported-modules (source-module-closure
 | 
			
		||||
                            '((gnu build marionette)
 | 
			
		||||
                              (gnu build jami-service)))
 | 
			
		||||
      #~(begin
 | 
			
		||||
          (use-modules (rnrs base)
 | 
			
		||||
                       (srfi srfi-11)
 | 
			
		||||
                       (srfi srfi-64)
 | 
			
		||||
                       (gnu build marionette)
 | 
			
		||||
                       (gnu build jami-service))
 | 
			
		||||
    (with-extensions (list guile-packrat ;used by guile-ac-d-bus
 | 
			
		||||
                           guile-ac-d-bus
 | 
			
		||||
                           ;; Fibers is needed to provide the non-blocking
 | 
			
		||||
                           ;; variant of the 'sleep' procedure.
 | 
			
		||||
                           guile-fibers)
 | 
			
		||||
      (with-imported-modules (source-module-closure
 | 
			
		||||
                              '((gnu build marionette)
 | 
			
		||||
                                (gnu build dbus-service)
 | 
			
		||||
                                (gnu build jami-service)))
 | 
			
		||||
        #~(begin
 | 
			
		||||
            (use-modules (rnrs base)
 | 
			
		||||
                         (srfi srfi-11)
 | 
			
		||||
                         (srfi srfi-64)
 | 
			
		||||
                         (gnu build marionette)
 | 
			
		||||
                         (gnu build dbus-service)
 | 
			
		||||
                         (gnu build jami-service))
 | 
			
		||||
 | 
			
		||||
          (define marionette
 | 
			
		||||
            (make-marionette (list #$vm)))
 | 
			
		||||
            (setenv "DBUS_SESSION_BUS_ADDRESS" "unix:path=/var/run/jami/bus")
 | 
			
		||||
 | 
			
		||||
          (test-runner-current (system-test-runner #$output))
 | 
			
		||||
          (test-begin "jami")
 | 
			
		||||
            (define marionette
 | 
			
		||||
              (make-marionette (list #$vm)))
 | 
			
		||||
 | 
			
		||||
          (test-assert "service is running"
 | 
			
		||||
            (marionette-eval
 | 
			
		||||
             '(begin
 | 
			
		||||
                (use-modules (gnu services herd))
 | 
			
		||||
                (match (start-service 'jami)
 | 
			
		||||
                  (#f #f)
 | 
			
		||||
                  (('service response-parts ...)
 | 
			
		||||
                   (match (assq-ref response-parts 'running)
 | 
			
		||||
                     ((pid) (number? pid))))))
 | 
			
		||||
             marionette))
 | 
			
		||||
            (test-runner-current (system-test-runner #$output))
 | 
			
		||||
            (test-begin "jami")
 | 
			
		||||
 | 
			
		||||
          (test-assert "service can be stopped"
 | 
			
		||||
            (marionette-eval
 | 
			
		||||
             '(begin
 | 
			
		||||
                (use-modules (gnu services herd)
 | 
			
		||||
                             (rnrs base))
 | 
			
		||||
                (setenv "PATH" "/run/current-system/profile/bin")
 | 
			
		||||
                (let ((pid (match (start-service 'jami)
 | 
			
		||||
                             (#f #f)
 | 
			
		||||
                             (('service response-parts ...)
 | 
			
		||||
                              (match (assq-ref response-parts 'running)
 | 
			
		||||
                                ((pid) pid))))))
 | 
			
		||||
            (test-assert "service is running"
 | 
			
		||||
              (marionette-eval
 | 
			
		||||
               '(begin
 | 
			
		||||
                  (use-modules (gnu build jami-service))
 | 
			
		||||
                  (jami-service-available?))
 | 
			
		||||
               marionette))
 | 
			
		||||
 | 
			
		||||
                  (assert (number? pid))
 | 
			
		||||
            (test-assert "service can be stopped"
 | 
			
		||||
              (marionette-eval
 | 
			
		||||
               '(begin
 | 
			
		||||
                  (use-modules (gnu build jami-service)
 | 
			
		||||
                               (gnu services herd)
 | 
			
		||||
                               (rnrs base))
 | 
			
		||||
                  (assert (jami-service-available?))
 | 
			
		||||
 | 
			
		||||
                  (match (stop-service 'jami)
 | 
			
		||||
                    (services           ;a list of service symbols
 | 
			
		||||
                     (member 'jami services)))
 | 
			
		||||
                  ;; Sometimes, the process still appear in pgrep, even
 | 
			
		||||
                  ;; though we are using waitpid after sending it SIGTERM
 | 
			
		||||
                  ;; in the service; use retries.
 | 
			
		||||
                  (stop-service 'jami)
 | 
			
		||||
 | 
			
		||||
                  (with-retries 20 1 (not (jami-service-available?))))
 | 
			
		||||
               marionette))
 | 
			
		||||
 | 
			
		||||
            (test-assert "service can be restarted"
 | 
			
		||||
              (marionette-eval
 | 
			
		||||
               '(begin
 | 
			
		||||
                  (use-modules (gnu build dbus-service)
 | 
			
		||||
                               (gnu build jami-service)
 | 
			
		||||
                               (gnu services herd)
 | 
			
		||||
                               (rnrs base)                               )
 | 
			
		||||
                  ;; Start the service.
 | 
			
		||||
                  (start-service 'jami)
 | 
			
		||||
                  (with-retries 20 1 (jami-service-available?))
 | 
			
		||||
                  ;; Restart the service.
 | 
			
		||||
                  (restart-service 'jami)
 | 
			
		||||
                  (with-retries 20 1 (jami-service-available?)))
 | 
			
		||||
               marionette))
 | 
			
		||||
 | 
			
		||||
            (unless #$provisioning? (test-skip 1))
 | 
			
		||||
            (test-assert "jami accounts provisioning, account present"
 | 
			
		||||
              (marionette-eval
 | 
			
		||||
               '(begin
 | 
			
		||||
                  (use-modules (gnu build dbus-service)
 | 
			
		||||
                               (gnu services herd)
 | 
			
		||||
                               (rnrs base))
 | 
			
		||||
                  ;; Accounts take some time to appear after being added.
 | 
			
		||||
                  (with-retries 20 1
 | 
			
		||||
                    (not (zero? (status:exit-val
 | 
			
		||||
                                 (system* "pgrep" "jamid")))))))
 | 
			
		||||
             marionette))
 | 
			
		||||
                    (with-shepherd-action 'jami ('list-accounts) results
 | 
			
		||||
                      (let ((account (assoc-ref (car results) #$username)))
 | 
			
		||||
                        (assert (string=? #$username
 | 
			
		||||
                                          (assoc-ref account
 | 
			
		||||
                                                     "Account.username")))))))
 | 
			
		||||
               marionette))
 | 
			
		||||
 | 
			
		||||
          (test-assert "service can be restarted"
 | 
			
		||||
            (marionette-eval
 | 
			
		||||
             '(begin
 | 
			
		||||
                (use-modules (gnu services herd)
 | 
			
		||||
                             (rnrs base))
 | 
			
		||||
                ;; Start and retrieve the current PID.
 | 
			
		||||
                (define pid (match (start-service 'jami)
 | 
			
		||||
                              (#f #f)
 | 
			
		||||
                              (('service response-parts ...)
 | 
			
		||||
                               (match (assq-ref response-parts 'running)
 | 
			
		||||
                                 ((pid) pid)))))
 | 
			
		||||
                (assert (number? pid))
 | 
			
		||||
            (unless #$provisioning? (test-skip 1))
 | 
			
		||||
            (test-assert "jami accounts provisioning, allowed-contacts"
 | 
			
		||||
              (marionette-eval
 | 
			
		||||
               '(begin
 | 
			
		||||
                  (use-modules (gnu services herd)
 | 
			
		||||
                               (rnrs base)
 | 
			
		||||
                               (srfi srfi-1))
 | 
			
		||||
 | 
			
		||||
                ;; Restart the service.
 | 
			
		||||
                (restart-service 'jami)
 | 
			
		||||
 | 
			
		||||
                (define new-pid (match (start-service 'jami)
 | 
			
		||||
                                  (#f #f)
 | 
			
		||||
                                  (('service response-parts ...)
 | 
			
		||||
                                   (match (assq-ref response-parts 'running)
 | 
			
		||||
                                     ((pid) pid)))))
 | 
			
		||||
                (assert (number? new-pid))
 | 
			
		||||
 | 
			
		||||
                (not (eq? pid new-pid)))
 | 
			
		||||
             marionette))
 | 
			
		||||
 | 
			
		||||
          (unless #$provisioning? (test-skip 1))
 | 
			
		||||
          (test-assert "jami accounts provisioning, account present"
 | 
			
		||||
            (marionette-eval
 | 
			
		||||
             '(begin
 | 
			
		||||
                (use-modules (gnu services herd)
 | 
			
		||||
                             (rnrs base))
 | 
			
		||||
                ;; Accounts take some time to appear after being added.
 | 
			
		||||
                (with-retries 20 1
 | 
			
		||||
                  (with-shepherd-action 'jami ('list-accounts) results
 | 
			
		||||
                  ;; Public mode is disabled.
 | 
			
		||||
                  (with-shepherd-action 'jami ('list-account-details)
 | 
			
		||||
                                        results
 | 
			
		||||
                    (let ((account (assoc-ref (car results) #$username)))
 | 
			
		||||
                      (assert (string=? #$username
 | 
			
		||||
                      (assert (string=? "false"
 | 
			
		||||
                                        (assoc-ref account
 | 
			
		||||
                                                   "Account.username")))))))
 | 
			
		||||
             marionette))
 | 
			
		||||
                                                   "DHT.PublicInCalls")))))
 | 
			
		||||
 | 
			
		||||
          (unless #$provisioning? (test-skip 1))
 | 
			
		||||
          (test-assert "jami accounts provisioning, allowed-contacts"
 | 
			
		||||
            (marionette-eval
 | 
			
		||||
             '(begin
 | 
			
		||||
                (use-modules (gnu services herd)
 | 
			
		||||
                             (rnrs base)
 | 
			
		||||
                             (srfi srfi-1))
 | 
			
		||||
                  ;; Allowed contacts match those declared in the configuration.
 | 
			
		||||
                  (with-shepherd-action 'jami ('list-contacts) results
 | 
			
		||||
                    (let ((contacts (assoc-ref (car results) #$username)))
 | 
			
		||||
                      (assert (lset= string-ci=? contacts '#$%allowed-contacts)))))
 | 
			
		||||
               marionette))
 | 
			
		||||
 | 
			
		||||
                ;; Public mode is disabled.
 | 
			
		||||
                (with-shepherd-action 'jami ('list-account-details)
 | 
			
		||||
                                      results
 | 
			
		||||
                  (let ((account (assoc-ref (car results) #$username)))
 | 
			
		||||
                    (assert (string=? "false"
 | 
			
		||||
                                      (assoc-ref account
 | 
			
		||||
                                                 "DHT.PublicInCalls")))))
 | 
			
		||||
            (unless #$provisioning? (test-skip 1))
 | 
			
		||||
            (test-assert "jami accounts provisioning, moderators"
 | 
			
		||||
              (marionette-eval
 | 
			
		||||
               '(begin
 | 
			
		||||
                  (use-modules (gnu services herd)
 | 
			
		||||
                               (rnrs base)
 | 
			
		||||
                               (srfi srfi-1))
 | 
			
		||||
 | 
			
		||||
                ;; Allowed contacts match those declared in the configuration.
 | 
			
		||||
                (with-shepherd-action 'jami ('list-contacts) results
 | 
			
		||||
                  (let ((contacts (assoc-ref (car results) #$username)))
 | 
			
		||||
                    (assert (lset= string-ci=? contacts '#$%allowed-contacts)))))
 | 
			
		||||
             marionette))
 | 
			
		||||
                  ;; Moderators match those declared in the configuration.
 | 
			
		||||
                  (with-shepherd-action 'jami ('list-moderators) results
 | 
			
		||||
                    (let ((moderators (assoc-ref (car results) #$username)))
 | 
			
		||||
                      (assert (lset= string-ci=? moderators '#$%moderators))))
 | 
			
		||||
 | 
			
		||||
          (unless #$provisioning? (test-skip 1))
 | 
			
		||||
          (test-assert "jami accounts provisioning, moderators"
 | 
			
		||||
            (marionette-eval
 | 
			
		||||
             '(begin
 | 
			
		||||
                (use-modules (gnu services herd)
 | 
			
		||||
                             (rnrs base)
 | 
			
		||||
                             (srfi srfi-1))
 | 
			
		||||
                  ;; Moderators can be added via the Shepherd action.
 | 
			
		||||
                  (with-shepherd-action 'jami
 | 
			
		||||
                      ('add-moderator "cccccccccccccccccccccccccccccccccccccccc"
 | 
			
		||||
                                      #$username) results
 | 
			
		||||
                    (let ((moderators (car results)))
 | 
			
		||||
                      (assert (lset= string-ci=? moderators
 | 
			
		||||
                                     (cons "cccccccccccccccccccccccccccccccccccccccc"
 | 
			
		||||
                                           '#$%moderators))))))
 | 
			
		||||
               marionette))
 | 
			
		||||
 | 
			
		||||
                ;; Moderators match those declared in the configuration.
 | 
			
		||||
                (with-shepherd-action 'jami ('list-moderators) results
 | 
			
		||||
                  (let ((moderators (assoc-ref (car results) #$username)))
 | 
			
		||||
                    (assert (lset= string-ci=? moderators '#$%moderators))))
 | 
			
		||||
            (unless #$provisioning? (test-skip 1))
 | 
			
		||||
            (test-assert "jami service actions, ban/unban contacts"
 | 
			
		||||
              (marionette-eval
 | 
			
		||||
               '(begin
 | 
			
		||||
                  (use-modules (gnu services herd)
 | 
			
		||||
                               (rnrs base)
 | 
			
		||||
                               (srfi srfi-1))
 | 
			
		||||
 | 
			
		||||
                ;; Moderators can be added via the Shepherd action.
 | 
			
		||||
                (with-shepherd-action 'jami
 | 
			
		||||
                    ('add-moderator "cccccccccccccccccccccccccccccccccccccccc"
 | 
			
		||||
                                    #$username) results
 | 
			
		||||
                  (let ((moderators (car results)))
 | 
			
		||||
                    (assert (lset= string-ci=? moderators
 | 
			
		||||
                                   (cons "cccccccccccccccccccccccccccccccccccccccc"
 | 
			
		||||
                                         '#$%moderators))))))
 | 
			
		||||
             marionette))
 | 
			
		||||
                  ;; Globally ban a contact.
 | 
			
		||||
                  (with-shepherd-action 'jami
 | 
			
		||||
                      ('ban-contact "1dbcb0f5f37324228235564b79f2b9737e9a008f") _
 | 
			
		||||
                    (with-shepherd-action 'jami ('list-banned-contacts) results
 | 
			
		||||
                      (every (match-lambda
 | 
			
		||||
                               ((username . banned-contacts)
 | 
			
		||||
                                (member "1dbcb0f5f37324228235564b79f2b9737e9a008f"
 | 
			
		||||
                                        banned-contacts)))
 | 
			
		||||
                             (car results))))
 | 
			
		||||
 | 
			
		||||
          (unless #$provisioning? (test-skip 1))
 | 
			
		||||
          (test-assert "jami service actions, ban/unban contacts"
 | 
			
		||||
            (marionette-eval
 | 
			
		||||
             '(begin
 | 
			
		||||
                (use-modules (gnu services herd)
 | 
			
		||||
                             (rnrs base)
 | 
			
		||||
                             (srfi srfi-1))
 | 
			
		||||
                  ;; Ban a contact for a single account.
 | 
			
		||||
                  (with-shepherd-action 'jami
 | 
			
		||||
                      ('ban-contact "dddddddddddddddddddddddddddddddddddddddd"
 | 
			
		||||
                                    #$username) _
 | 
			
		||||
                    (with-shepherd-action 'jami ('list-banned-contacts) results
 | 
			
		||||
                      (every (match-lambda
 | 
			
		||||
                               ((username . banned-contacts)
 | 
			
		||||
                                (let ((found? (member "dddddddddddddddddddddddddddddddddddddddd"
 | 
			
		||||
                                                      banned-contacts)))
 | 
			
		||||
                                  (if (string=? #$username username)
 | 
			
		||||
                                      found?
 | 
			
		||||
                                      (not found?)))))
 | 
			
		||||
                             (car results)))))
 | 
			
		||||
               marionette))
 | 
			
		||||
 | 
			
		||||
                ;; Globally ban a contact.
 | 
			
		||||
                (with-shepherd-action 'jami
 | 
			
		||||
                    ('ban-contact "1dbcb0f5f37324228235564b79f2b9737e9a008f") _
 | 
			
		||||
                  (with-shepherd-action 'jami ('list-banned-contacts) results
 | 
			
		||||
                    (every (match-lambda
 | 
			
		||||
                             ((username . banned-contacts)
 | 
			
		||||
                              (member "1dbcb0f5f37324228235564b79f2b9737e9a008f"
 | 
			
		||||
                                      banned-contacts)))
 | 
			
		||||
                           (car results))))
 | 
			
		||||
            (unless #$provisioning? (test-skip 1))
 | 
			
		||||
            (test-assert "jami service actions, enable/disable accounts"
 | 
			
		||||
              (marionette-eval
 | 
			
		||||
               '(begin
 | 
			
		||||
                  (use-modules (gnu services herd)
 | 
			
		||||
                               (rnrs base))
 | 
			
		||||
 | 
			
		||||
                ;; Ban a contact for a single account.
 | 
			
		||||
                (with-shepherd-action 'jami
 | 
			
		||||
                    ('ban-contact "dddddddddddddddddddddddddddddddddddddddd"
 | 
			
		||||
                                  #$username) _
 | 
			
		||||
                  (with-shepherd-action 'jami ('list-banned-contacts) results
 | 
			
		||||
                    (every (match-lambda
 | 
			
		||||
                             ((username . banned-contacts)
 | 
			
		||||
                              (let ((found? (member "dddddddddddddddddddddddddddddddddddddddd"
 | 
			
		||||
                                                    banned-contacts)))
 | 
			
		||||
                                (if (string=? #$username username)
 | 
			
		||||
                                    found?
 | 
			
		||||
                                    (not found?)))))
 | 
			
		||||
                           (car results)))))
 | 
			
		||||
             marionette))
 | 
			
		||||
                  (with-shepherd-action 'jami
 | 
			
		||||
                      ('disable-account #$username) _
 | 
			
		||||
                    (with-shepherd-action 'jami ('list-accounts) results
 | 
			
		||||
                      (let ((account (assoc-ref (car results) #$username)))
 | 
			
		||||
                        (assert (string= "false"
 | 
			
		||||
                                         (assoc-ref account "Account.enable"))))))
 | 
			
		||||
 | 
			
		||||
          (unless #$provisioning? (test-skip 1))
 | 
			
		||||
          (test-assert "jami service actions, enable/disable accounts"
 | 
			
		||||
            (marionette-eval
 | 
			
		||||
             '(begin
 | 
			
		||||
                (use-modules (gnu services herd)
 | 
			
		||||
                             (rnrs base))
 | 
			
		||||
                  (with-shepherd-action 'jami
 | 
			
		||||
                      ('enable-account #$username) _
 | 
			
		||||
                    (with-shepherd-action 'jami ('list-accounts) results
 | 
			
		||||
                      (let ((account (assoc-ref (car results) #$username)))
 | 
			
		||||
                        (assert (string= "true"
 | 
			
		||||
                                         (assoc-ref account "Account.enable")))))))
 | 
			
		||||
               marionette))
 | 
			
		||||
 | 
			
		||||
                (with-shepherd-action 'jami
 | 
			
		||||
                    ('disable-account #$username) _
 | 
			
		||||
                  (with-shepherd-action 'jami ('list-accounts) results
 | 
			
		||||
                    (let ((account (assoc-ref (car results) #$username)))
 | 
			
		||||
                      (assert (string= "false"
 | 
			
		||||
                                       (assoc-ref account "Account.enable"))))))
 | 
			
		||||
            (unless #$provisioning? (test-skip 1))
 | 
			
		||||
            (test-assert "jami account parameters"
 | 
			
		||||
              (marionette-eval
 | 
			
		||||
               '(begin
 | 
			
		||||
                  (use-modules (gnu services herd)
 | 
			
		||||
                               (rnrs base)
 | 
			
		||||
                               (srfi srfi-1))
 | 
			
		||||
 | 
			
		||||
                (with-shepherd-action 'jami
 | 
			
		||||
                    ('enable-account #$username) _
 | 
			
		||||
                  (with-shepherd-action 'jami ('list-accounts) results
 | 
			
		||||
                    (let ((account (assoc-ref (car results) #$username)))
 | 
			
		||||
                      (assert (string= "true"
 | 
			
		||||
                                       (assoc-ref account "Account.enable")))))))
 | 
			
		||||
             marionette))
 | 
			
		||||
                  (with-shepherd-action 'jami ('list-account-details) results
 | 
			
		||||
                    (let ((account-details (assoc-ref (car results)
 | 
			
		||||
                                                      #$username)))
 | 
			
		||||
                      (assert (lset<=
 | 
			
		||||
                               equal?
 | 
			
		||||
                               '(("Account.hostname" .
 | 
			
		||||
                                  "bootstrap.me;fallback.another.host")
 | 
			
		||||
                                 ("Account.peerDiscovery" . "false")
 | 
			
		||||
                                 ("Account.rendezVous" . "true")
 | 
			
		||||
                                 ("RingNS.uri" . "https://my.name.server"))
 | 
			
		||||
                               account-details)))))
 | 
			
		||||
               marionette))
 | 
			
		||||
 | 
			
		||||
          (unless #$provisioning? (test-skip 1))
 | 
			
		||||
          (test-assert "jami account parameters"
 | 
			
		||||
            (marionette-eval
 | 
			
		||||
             '(begin
 | 
			
		||||
                (use-modules (gnu services herd)
 | 
			
		||||
                             (rnrs base)
 | 
			
		||||
                             (srfi srfi-1))
 | 
			
		||||
 | 
			
		||||
                (with-shepherd-action 'jami ('list-account-details) results
 | 
			
		||||
                  (let ((account-details (assoc-ref (car results)
 | 
			
		||||
                                                    #$username)))
 | 
			
		||||
                    (assert (lset<=
 | 
			
		||||
                             equal?
 | 
			
		||||
                             '(("Account.hostname" .
 | 
			
		||||
                                "bootstrap.me;fallback.another.host")
 | 
			
		||||
                               ("Account.peerDiscovery" . "false")
 | 
			
		||||
                               ("Account.rendezVous" . "true")
 | 
			
		||||
                               ("RingNS.uri" . "https://my.name.server"))
 | 
			
		||||
                             account-details)))))
 | 
			
		||||
             marionette))
 | 
			
		||||
 | 
			
		||||
          (test-end))))
 | 
			
		||||
            (test-end)))))
 | 
			
		||||
 | 
			
		||||
  (gexp->derivation (if provisioning?
 | 
			
		||||
                        "jami-provisioning-test"
 | 
			
		||||
| 
						 | 
				
			
			@ -357,7 +341,3 @@ accounts provisioning feature of the service."
 | 
			
		|||
   (name "jami-provisioning")
 | 
			
		||||
   (description "Provisioning test for the jami service.")
 | 
			
		||||
   (value (run-jami-test #:provisioning? #t))))
 | 
			
		||||
 | 
			
		||||
;; Local Variables:
 | 
			
		||||
;; eval: (put 'with-retries 'scheme-indent-function 2)
 | 
			
		||||
;; End:
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -51,7 +51,7 @@
 | 
			
		|||
  "Return a wrapper of PROGRAM that executes it with the least authority.
 | 
			
		||||
 | 
			
		||||
PROGRAM is executed in separate namespaces according to NAMESPACES, a list of
 | 
			
		||||
symbols; it turns with GUEST-UID and GUEST-GID.  MAPPINGS is a list of
 | 
			
		||||
symbols; it runs with GUEST-UID and GUEST-GID.  MAPPINGS is a list of
 | 
			
		||||
<file-system-mapping> records indicating directories mirrored inside the
 | 
			
		||||
execution environment of PROGRAM.  DIRECTORY is the working directory of the
 | 
			
		||||
wrapped process.  Each environment listed in PRESERVED-ENVIRONMENT-VARIABLES
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -3,7 +3,7 @@
 | 
			
		|||
;;; Copyright © 2014, 2015, 2017, 2018, 2019 Mark H Weaver <mhw@netris.org>
 | 
			
		||||
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 | 
			
		||||
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 | 
			
		||||
;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;; Copyright © 2017, 2019, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
 | 
			
		||||
;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
 | 
			
		||||
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 | 
			
		||||
;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
 | 
			
		||||
| 
						 | 
				
			
			@ -149,6 +149,8 @@
 | 
			
		|||
 | 
			
		||||
            transitive-input-references
 | 
			
		||||
 | 
			
		||||
            %32bit-supported-systems
 | 
			
		||||
            %64bit-supported-systems
 | 
			
		||||
            %supported-systems
 | 
			
		||||
            %hurd-systems
 | 
			
		||||
            %cuirass-supported-systems
 | 
			
		||||
| 
						 | 
				
			
			@ -400,11 +402,19 @@ from forcing GEXP-PROMISE."
 | 
			
		|||
                      #:guile-for-build guile)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(define %32bit-supported-systems
 | 
			
		||||
  ;; This is the list of 32-bit system types that are supported.
 | 
			
		||||
  '("i686-linux" "armhf-linux" "i586-gnu" "powerpc-linux"))
 | 
			
		||||
 | 
			
		||||
(define %64bit-supported-systems
 | 
			
		||||
  ;; This is the list of 64-bit system types that are supported.
 | 
			
		||||
  '("x86_64-linux" "mips64el-linux" "aarch64-linux" "powerpc64le-linux"
 | 
			
		||||
    "riscv64-linux"))
 | 
			
		||||
 | 
			
		||||
(define %supported-systems
 | 
			
		||||
  ;; This is the list of system types that are supported.  By default, we
 | 
			
		||||
  ;; expect all packages to build successfully here.
 | 
			
		||||
  '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu"
 | 
			
		||||
    "powerpc64le-linux" "powerpc-linux" "riscv64-linux"))
 | 
			
		||||
  (append %32bit-supported-systems %64bit-supported-systems))
 | 
			
		||||
 | 
			
		||||
(define %hurd-systems
 | 
			
		||||
  ;; The GNU/Hurd systems for which support is being developed.
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -121,7 +121,7 @@ otherwise."
 | 
			
		|||
(define (platform-target->system target)
 | 
			
		||||
  "Return the system matching the given TARGET if it exists or false
 | 
			
		||||
otherwise."
 | 
			
		||||
  (let ((platform (lookup-platform-by-target system)))
 | 
			
		||||
  (let ((platform (lookup-platform-by-target target)))
 | 
			
		||||
    (and=> platform platform-system)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -49,6 +49,7 @@
 | 
			
		|||
  #:autoload   (gnu packages bootstrap) (%bootstrap-guile)
 | 
			
		||||
  #:autoload   (gnu packages certs) (le-certs)
 | 
			
		||||
  #: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)
 | 
			
		||||
| 
						 | 
				
			
			@ -810,6 +811,33 @@ Use '~/.config/guix/channels.scm' instead."))
 | 
			
		|||
        ((assoc-ref opts 'generation)
 | 
			
		||||
         (process-generation-change opts profile))
 | 
			
		||||
        (else
 | 
			
		||||
         ;; Bail out early when users accidentally run, e.g., ’sudo guix pull’.
 | 
			
		||||
         ;; If CACHE-DIRECTORY doesn't yet exist, test where it would end up.
 | 
			
		||||
         (let-values (((stats dir) (let loop ((dir (cache-directory)))
 | 
			
		||||
                                     (let ((stats (stat dir #f)))
 | 
			
		||||
                                       (if stats
 | 
			
		||||
                                           (values stats dir)
 | 
			
		||||
                                           (loop (dirname dir)))))))
 | 
			
		||||
           (let ((dir:uid (stat:uid stats))
 | 
			
		||||
                 (our:uid (getuid)))
 | 
			
		||||
             (unless (= dir:uid our:uid)
 | 
			
		||||
               (let* ((user (lambda (uid)    ; handle the unthinkable invalid UID
 | 
			
		||||
                              (or (false-if-exception (passwd:name
 | 
			
		||||
                                                       (getpwuid uid)))
 | 
			
		||||
                                  uid)))
 | 
			
		||||
                      (our:user (user our:uid))
 | 
			
		||||
                      (dir:user (user dir:uid)))
 | 
			
		||||
                 (raise
 | 
			
		||||
                  (condition
 | 
			
		||||
                   (&message
 | 
			
		||||
                    (message
 | 
			
		||||
                     (format #f (G_ "directory ‘~a’ is not owned by user ~a")
 | 
			
		||||
                             dir dir:user)))
 | 
			
		||||
                   (&fix-hint
 | 
			
		||||
                    (hint
 | 
			
		||||
                     (format #f (G_ "You should run this command as ~a; use ‘sudo -i’ or equivalent if you really want to pull as ~a.")
 | 
			
		||||
                             dir:user our:user)))))))))
 | 
			
		||||
 | 
			
		||||
         (with-store store
 | 
			
		||||
           (with-status-verbosity (assoc-ref opts 'verbosity)
 | 
			
		||||
             (parameterize ((%current-system (assoc-ref opts 'system))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue