aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020, 2021 Marius Bakke <marius@gnu.org>
;;; Copyright © 2022 Nicolas Graves <ngraves@ngraves.fr>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu build chromium-extension)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (gnu packages gnupg)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages node-xyz)
  #:use-module (guix build-system trivial)
  #:export (make-chromium-extension))

;;; Commentary:
;;;
;;; Tools to deal with Chromium extensions.
;;;
;;; Code:

(define (make-signing-key seed)
  "Return a derivation for a deterministic PKCS #8 private key using SEED."
  (computed-file
   (string-append seed "-signing-key.pem")
   (with-extensions (list guile-gcrypt)
     #~(begin
         (use-modules (gcrypt base16) (gcrypt hash) (ice-9 iconv))
         (let* ((sha256sum (bytevector->base16-string
                            (sha256 (string->bytevector #$seed "UTF-8"))))
                ;; certtool.c wants a 56 byte seed for a 2048 bit key.
                (key-size 2048)
                (normalized-seed (string-take sha256sum 56)))

           (system* #$(file-append gnutls "/bin/certtool")
                    "--generate-privkey"
                    "--key-type=rsa"
                    "--pkcs8"
                    ;; Use the provable FIPS-PUB186-4 algorithm for
                    ;; deterministic results.
                    "--provable"
                    "--password="
                    "--no-text"
                    (string-append "--bits=" (number->string key-size))
                    (string-append "--seed=" normalized-seed)
                    "--outfile" #$output))))
   #:local-build? #t))

(define* (make-crx signing-key package #:optional (package-output "out"))
  "Create a signed \".crx\" file from the unpacked Chromium extension residing
in PACKAGE-OUTPUT of PACKAGE.  The extension will be signed with SIGNING-KEY."
  (define name (package-name package))
  (define version (package-version package))

  (computed-file
   (string-append name "-" version ".crx")
   (with-imported-modules '((guix build utils))
     #~(begin
         (use-modules (guix build utils))
         (let ((crx3 #+(file-append node-crx3 "/bin/crx3"))
               (packdir (string-append (getcwd) "/extension")))
           (mkdir packdir)
           (copy-recursively (ungexp package package-output) packdir
                             ;; Ensure consistent file modification times.
                             #:keep-mtime? #t)
           (invoke crx3 "--keyPath" #$signing-key packdir)
           (copy-file (string-append packdir ".crx") #$output))))
   #:local-build? #t))

(define (crx->chromium-json crx version)
  "Return a derivation that creates a Chromium JSON settings file for the
extension given as CRX.  VERSION is used to signify the CRX version, and
must match the version listed in the extension manifest.json."
  ;; See chrome/browser/extensions/external_provider_impl.cc and
  ;; extensions/common/extension.h for documentation on the JSON format.
  (computed-file "extension.json"
                 #~(call-with-output-file #$output
                     (lambda (port)
                       (format port "{
  \"external_crx\": \"~a\",
  \"external_version\": \"~a\"
}
"
                               #$crx #$version)))
                 #:local-build? #t))


(define (signing-key->public-der key)
  "Return a derivation for a file containing the public key of KEY in DER
format."
  (computed-file "der"
                 #~(system* #$(file-append gnutls "/bin/certtool")
                            "--load-privkey" #$key
                            "--pubkey-info"
                            "--outfile" #$output
                            "--outder")
                 #:local-build? #t))

(define (file-sha256sum file)
  (with-extensions (list guile-gcrypt)
    #~(begin
        (use-modules (gcrypt base16) (gcrypt hash))
        (bytevector->base16-string (file-sha256 #$file)))))

(define* (make-chromium-extension pkg #:optional (pkg-output "out"))
  "Create a Chromium extension from package PKG and return a package that,
when installed, will make the extension contained in PKG available as a
Chromium browser extension.  PKG-OUTPUT specifies which output of PKG to use."
  (let* ((name (package-name pkg))
         (version (package-version pkg)))
    (package
      (inherit pkg)
      (name (string-append name "-chromium"))
      (source #f)
      (native-inputs '())
      (inputs '())
      (propagated-inputs '())
      (outputs '("out"))
      (build-system trivial-build-system)
      (arguments
       (list #:modules '((guix build utils))
             #:builder
             (let*
                 ((private-key (make-signing-key name))
                  (public-key (signing-key->public-der private-key))
                  (checksum (file-sha256sum public-key))
                  (crx (make-crx private-key pkg pkg-output))
                  (json (crx->chromium-json crx version)))
               #~(begin
                   (use-modules (guix build utils))
                   (define (base16-char->chromium-base16 char)
                     ;; Translate CHAR, a hexadecimal character, to a Chromium-style
                     ;; representation using the letters a-p (where a=0, p=15).
                     (string-ref "abcdefghijklmnop"
                                 (string-index "0123456789abcdef" char)))
                   (let ((file-name (string-map base16-char->chromium-base16
                                                (string-take #$checksum 32)))
                         (extension-directory
                          (string-append #$output
                                         "/share/chromium/extensions")))
                     (mkdir-p extension-directory)
                     (symlink #$json (string-append extension-directory "/"
                                                    file-name ".json"))))))))))
If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services avahi) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services shepherd) #:use-module (gnu services dbus) #:use-module (gnu system shadow) #:use-module (gnu packages avahi) #:use-module (gnu packages admin) #:use-module (guix records) #:use-module (guix gexp) #:export (avahi-configuration avahi-service avahi-service-type)) ;;; Commentary: ;;; ;;; This module provides service definitions for the Avahi ;;; "zero-configuration" tool set. ;;; ;;; Code: ;; TODO: Export. (define-record-type* <avahi-configuration> avahi-configuration make-avahi-configuration avahi-configuration? (avahi avahi-configuration-avahi ;<package> (default avahi)) (debug? avahi-configuration-debug? ;Boolean (default #f)) (host-name avahi-configuration-host-name) ;string (publish? avahi-configuration-publish?) ;Boolean ;; The default for this was #t in Avahi 0.6.31 and became #f in 0.7. For ;; now we stick to the old default. (publish-workstation? avahi-configuration-publish-workstation? ;Boolean (default #t)) (ipv4? avahi-configuration-ipv4?) ;Boolean (ipv6? avahi-configuration-ipv6?) ;Boolean (wide-area? avahi-configuration-wide-area?) ;Boolean (domains-to-browse avahi-configuration-domains-to-browse)) ;list of strings (define* (configuration-file config) "Return an avahi-daemon configuration file based on CONFIG, an <avahi-configuration>." (define (bool value) (if value "yes\n" "no\n")) (define host-name (avahi-configuration-host-name config)) (plain-file "avahi-daemon.conf" (string-append "[server]\n" (if host-name (string-append "host-name=" host-name "\n") "") "browse-domains=" (string-join (avahi-configuration-domains-to-browse config)) "\n" "use-ipv4=" (bool (avahi-configuration-ipv4? config)) "use-ipv6=" (bool (avahi-configuration-ipv6? config)) "[wide-area]\n" "enable-wide-area=" (bool (avahi-configuration-wide-area? config)) "[publish]\n" "disable-publishing=" (bool (not (avahi-configuration-publish? config))) "publish-workstation=" (bool (avahi-configuration-publish-workstation? config))))) (define %avahi-accounts ;; Account and group for the Avahi daemon. (list (user-group (name "avahi") (system? #t)) (user-account (name "avahi") (group "avahi") (system? #t) (comment "Avahi daemon user") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) (define %avahi-activation ;; Activation gexp. #~(begin (use-modules (guix build utils)) (mkdir-p "/run/avahi-daemon"))) (define (avahi-shepherd-service config) "Return a list of <shepherd-service> for CONFIG." (let ((config (configuration-file config)) (debug? (avahi-configuration-debug? config)) (avahi (avahi-configuration-avahi config))) (list (shepherd-service (documentation "Run the Avahi mDNS/DNS-SD responder.") (provision '(avahi-daemon)) (requirement '(dbus-system networking)) (start #~(make-forkexec-constructor (list #$(file-append avahi "/sbin/avahi-daemon") "--daemonize" #$@(if debug? #~("--debug") #~()) "-f" #$config) #:pid-file "/run/avahi-daemon/pid")) (stop #~(make-kill-destructor)))))) (define avahi-service-type (let ((avahi-package (compose list avahi-configuration-avahi))) (service-type (name 'avahi) (description "Run @command{avahi-daemon}, a host and service discovery daemon that implements the multicast DNS (mDNS) and DNS service discovery (DNS-SD) protocols. Additionally, extend the C library's name service switch (NSS) with support for @code{.local} host name resolution.") (extensions (list (service-extension shepherd-root-service-type avahi-shepherd-service) (service-extension dbus-root-service-type avahi-package) (service-extension account-service-type (const %avahi-accounts)) (service-extension activation-service-type (const %avahi-activation)) (service-extension nscd-service-type (const (list nss-mdns))) ;; Provide 'avahi-browse', 'avahi-resolve', etc. in ;; the system profile. (service-extension profile-service-type avahi-package)))))) (define* (avahi-service #:key (avahi avahi) debug? host-name (publish? #t) (ipv4? #t) (ipv6? #t) wide-area? (domains-to-browse '())) "Return a service that runs @command{avahi-daemon}, a system-wide mDNS/DNS-SD responder that allows for service discovery and \"zero-configuration\" host name lookups (see @uref{http://avahi.org/}), and extends the name service cache daemon (nscd) so that it can resolve @code{.local} host names using @uref{http://0pointer.de/lennart/projects/nss-mdns/, nss-mdns}. Additionally, add the @var{avahi} package to the system profile so that commands such as @command{avahi-browse} are directly usable. If @var{host-name} is different from @code{#f}, use that as the host name to publish for this machine; otherwise, use the machine's actual host name. When @var{publish?} is true, publishing of host names and services is allowed; in particular, avahi-daemon will publish the machine's host name and IP address via mDNS on the local network. When @var{wide-area?} is true, DNS-SD over unicast DNS is enabled. Boolean values @var{ipv4?} and @var{ipv6?} determine whether to use IPv4/IPv6 sockets." (service avahi-service-type (avahi-configuration (avahi avahi) (debug? debug?) (host-name host-name) (publish? publish?) (ipv4? ipv4?) (ipv6? ipv6?) (wide-area? wide-area?) (domains-to-browse domains-to-browse)))) ;;; avahi.scm ends here