~ruther/guix-local

a87944f94e8815de955a39ffc6d8f724e9aa83c1 — Sergey Trofimov 11 months ago 13782f6
services: sane: Support pluggable backends.

* gnu/services/desktop.scm (sane-configuration): New record.
(sane-service-type): Add native search paths to environment.

Change-Id: Ia7b66b62cf027200dd94533f32c1e4bc0ed373d3
2 files changed, 83 insertions(+), 19 deletions(-)

M doc/guix.texi
M gnu/services/desktop.scm
M doc/guix.texi => doc/guix.texi +40 -16
@@ 26957,23 26957,46 @@ site} for more information.
@defvar sane-service-type
This service provides access to scanners @i{via}
@uref{http://www.sane-project.org, SANE} by installing the necessary
udev rules.  It is included in @code{%desktop-services} (@pxref{Desktop
Services}) and relies by default on @code{sane-backends-minimal} package
(see below) for hardware support.
udev rules and pluggable backends.  It is included in
@code{%desktop-services} (@pxref{Desktop Services}) and relies by
default on @code{sane-backends} package (see below) for hardware
support.
@end defvar

@defvar sane-backends-minimal
The default package which the @code{sane-service-type} installs.  It
supports many recent scanners.
@end defvar
@deftp {Data Type} sane-configuration
Data type representing the configuration for SANE.

@defvar sane-backends
This package includes support for all scanners that
@code{sane-backends-minimal} supports, plus older Hewlett-Packard
scanners supported by @code{hplip} package.  In order to use this on
a system which relies on @code{%desktop-services}, you may use
@code{modify-services} (@pxref{Service Reference,
@code{modify-services}}) as illustrated below:
@table @asis

@item @code{sane} (default: @code{sane})
Package containing SANE library.

@item @code{backends} (default: @code{(sane-backends)})
List of packages with pluggable SANE backends:

@itemize @bullet
@item
@code{sane-backends}: The default backend collection which supports many recent scanners,

@item
@code{sane-airscan}: A backend that enables network scanners supporting eSCL (Apple) or WSD,
(Microsoft) protocols

@item
@code{hplip}: A backend containing drivers for older Hewlett-Packard scanners,

@item
@code{utsushi}: A backend containing drivers for older Epson devices.

@end itemize

@end table
@end deftp

In order to use additional backends on a system which relies on
@code{%desktop-services}, you may use @code{modify-services}
(@pxref{Service Reference, @code{modify-services}}) as illustrated
below:

@lisp
(use-modules (gnu))


@@ 26987,13 27010,14 @@ a system which relies on @code{%desktop-services}, you may use
(define %my-desktop-services
  ;; List of desktop services that supports a broader range of scanners.
  (modify-services %desktop-services
    (sane-service-type _ => sane-backends)))
    (sane-service-type _ =>
      (sane-configuration
        (backends (list sane-backends sane-airscan))))))

(operating-system
  @dots{}
  (services %my-desktop-services))
@end lisp
@end defvar

@deffn {Procedure} geoclue-application name [#:allowed? #t] [#:system? #f] [#:users '()]
Return a configuration allowing an application to access GeoClue

M gnu/services/desktop.scm => gnu/services/desktop.scm +43 -3
@@ 80,8 80,10 @@
  #:use-module (gnu packages nfs)
  #:use-module (gnu packages enlightenment)
  #:use-module (guix deprecation)
  #:use-module (guix i18n)
  #:use-module (guix records)
  #:use-module (guix packages)
  #:use-module (guix search-paths)
  #:use-module (guix store)
  #:use-module (guix ui)
  #:use-module (guix utils)


@@ 147,6 149,11 @@
            accountsservice-service  ; deprecated

            cups-pk-helper-service-type

            sane-configuration
            sane-configuration?
            sane-configuration-backends
            sane-configuration-sane
            sane-service-type

            gnome-desktop-configuration


@@ 1681,6 1688,33 @@ accountsservice web site} for more information."
  ;; The '60-libsane.rules' udev rules refers to the "scanner" group.
  (list (user-group (name "scanner") (system? #t))))

(define (non-empty-list-of-packages? val)
  (and (not (null? val)) (list-of-packages? val)))

(define-configuration/no-serialization sane-configuration
  (sane
   (package sane)
   "The package that provides the SANE library.")
  (backends
   (non-empty-list-of-packages (list sane-backends))
   "A list of packages containing SANE backends."))

(define (sane-search-paths config)
  (match-record config <sane-configuration> (sane backends)
    (let ((backend-union (directory-union "sane-backends" backends)))
      (map (match-lambda
             (($ <search-path-specification> variable (files))
              (cons variable (file-append backend-union "/" files))))
           (package-native-search-paths sane)))))

(define* (lift-sane-configuration config #:key warn?)
  (if (sane-configuration? config)
      config
      (begin
        (when warn?
          (warning (G_ "'sane' service now expects a 'sane-configuration' record~%")))
        (sane-configuration (backends (list config))))))

(define sane-service-type
  (service-type
   (name 'sane)


@@ 1688,9 1722,15 @@ accountsservice web site} for more information."
    "This service provides access to scanners @i{via}
@uref{http://www.sane-project.org, SANE} by installing the necessary udev
rules.")
   (default-value sane-backends-minimal)
   (default-value (sane-configuration))
   (extensions
    (list (service-extension udev-service-type list)
    (list (service-extension udev-service-type
                             (lambda (c)
                               (sane-configuration-backends
                                (lift-sane-configuration c #:warn? #t))))
          (service-extension session-environment-service-type
                             (lambda (c)
                               (sane-search-paths (lift-sane-configuration c))))
          (service-extension account-service-type
                             (const %sane-accounts))))))



@@ 2445,7 2485,7 @@ applications needing access to be root.")
         ;; Add udev rules for MTP devices so that non-root users can access
         ;; them.
         (simple-service 'mtp udev-service-type (list libmtp))
         ;; Add udev rules for scanners.
         ;; Add udev rules and default backends for scanners.
         (service sane-service-type)
         ;; Add polkit rules, so that non-root users in the wheel group can
         ;; perform administrative tasks (similar to "sudo").