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"))))))))))
not found"): Adjust message string. * tests/packages.scm ("patch not found yields a run-time error"): Catch 'formatted-message?'. * guix/lint.scm (check-patch-file-names): Handle 'formatted-message?'. (check-derivation): Ditto. Ludovic Courtès 2020-07-15services: Add 'system-provenance' procedure....* gnu/services.scm (sexp->channel, system-provenance): New procedures. * guix/scripts/system.scm (sexp->channel): Remove. (display-system-generation): Use 'system-provenance' instead of parsing the "provenance" file right here. Ludovic Courtès 2020-07-01services: provenance: Save channel introductions....* gnu/services.scm (channel->code): Include CHANNEL's introduction, if any, unless CHANNEL is the singleton %DEFAULT-CHANNELS. (channel->sexp): Add comment. * guix/scripts/system.scm (sexp->channel): Change pattern to allow for extensibility. Ludovic Courtès 2020-06-08gnu: services: Add %hurd-startup-service....This decouples startup of the Hurd from the "hurd" package, moving the RC script into SYSTEM. * gnu/packages/hurd.scm (hurd)[inputs]: Remove hurd-rc-script. [arguments]: Do not substitute it. Update "runsystem.sh" to parse kernel arguments and exec into --system=SYSTEM/rc. (hurd-rc-script): Move to... * gnu/services.scm (%hurd-rc-file): ...this new variable. (hurd-rc-entry): New procedure. (%hurd-startup-service): Use it in new variable. * gnu/system.scm (hurd-default-essential-services): Use it. Jan (janneke) Nieuwenhuizen 2020-06-08system: examples: Add bare-hurd.tmpl....* gnu/system/hurd.scm (%hurd-def%hurd-default-operating-system-kernel, %hurd-default-operating-system): New exported variables. * gnu/system/examples/bare-hurd.tmpl: New file. * Makefile.am (EXAMPLES): Add it. * tests/guix-system.sh: Add --target=i586-pc-gnu when testing it. Jan (janneke) Nieuwenhuizen 2020-04-26services: system: Initial entries are non-monadic....* gnu/system.scm (operating-system-directory-base-entries): Return a regular, non-monadic value. * gnu/services.scm (system-derivation): Adjust accordingly. * gnu/system/linux-container.scm (container-essential-services): Likewise. Ludovic Courtès 2020-04-26services: profile: Use a declarative profile....* gnu/services.scm (packages->profile-entry): Use 'profile' instead of 'profile-derivation'. Ludovic Courtès 2020-04-21services: etc: Detect and report duplicate entries....Fixes <https://bugs.gnu.org/40729>. Reported by Christopher Baines <mail@cbaines.net>. * gnu/services.scm (files->etc-directory)[assert-no-duplicates]: New procedure. Use it. Ludovic Courtès 2020-04-05services: Allow modprobe to use "/etc/modprobe.d"....* gnu/services.scm (%modprobe-wrapper): Set 'MODPROBE_OPTIONS' environment variable. Signed-off-by: Danny Milosavljevic <dannym@scratchpost.org> Brice Waegeneire 2020-04-02services: Accumulate builds for 'system' entries....That way, more build requests are accumulated when running "guix system build". * gnu/services.scm (system-derivation): Use 'mapm/accumulate-builds' rather than 'sequence'. Ludovic Courtès 2019-12-07services: Add 'provenance-service-type'....* gnu/services.scm (object->pretty-string) (channel->code, channel->sexp, provenance-file) (provenance-entry): New procedures. (provenance-service-type): New variable. * gnu/system.scm (operating-system-with-provenance): New procedure. * doc/guix.texi (Service Reference): Document 'provenance-service-type'. Ludovic Courtès 2019-11-09services: 'fold-services' memoizes service values....Previously 'fold-services' could end up traversing the same services in the graph several times, which is what this change addresses. The hit rate on the 'add-data-to-store' cache goves from 9% to 8% on "guix system build desktop.tmpl -nd", and the number of lookups in that cache goes from 4458 to 4383. * gnu/services.scm (fold-services): Turn 'loop' into a monadic procedure in %STATE-MONAD and use it to memoize values of visited services. Ludovic Courtès 2019-08-14remote: Remove '--system' argument....* gnu/services.scm (activation-script): Return a <program-file> rather than a <scheme-file>. * gnu/deploy.scm (guix-deploy): Remove handling for '--system'. (show-help): Remove documentation for '--system'. (%default-options): Remove default setting for 'system'. Jakob L. Kreuze 2019-05-10services: 'gc-root-service-type' now has a default value....* gnu/services.scm (gc-root-service-type)[default-value]: New field. Ludovic Courtès 2018-09-07services: 'instantiate-missing-services' reaches fixed point....Fixes a bug whereby services indirectly depended on would not be automatically instantiated. * gnu/services.scm (instantiate-missing-services): Loop back when the length of ADJUSTED is greater than that of INSTANCES. * tests/services.scm ("instantiate-missing-services, indirect"): New test. Ludovic Courtès 2018-06-20services: boot: Take gexps instead of monadic gexps....* gnu/services.scm (compute-boot-script): Rename 'mexps' to 'gexps' and remove 'mlet' form. (boot-service-type): Update comment. (cleanup-gexp): Remove 'with-monad' and 'return'. (activation-script): Rewrite in non-monadic style: use 'scheme-file' instead of 'gexp->file'. (gexps->activation-gexp): Remove 'mlet', return a gexp. * gnu/services/shepherd.scm (shepherd-boot-gexp): Remove 'with-monad' and 'return'. * gnu/system.scm (operating-system-boot-script): Remove outdated comment. * gnu/tests/base.scm (%cleanup-os): For 'dirty-service', remove 'with-monad' and 'return'. Ludovic Courtès 2018-06-20services: Add description to core services....* gnu/services.scm (system-service-type, boot-service-type) (cleanup-service-type, activation-service-type) (special-files-service-type, etc-service-type) (setuid-program-service-type, profile-service-type) (firmware-service-type, gc-root-service-type): Add 'description' field. Ludovic Courtès 2018-06-20services: cleanup: Expect file names to be UTF-8-encoded....Fixes <https://bugs.gnu.org/26353>. Reported by Danny Milosavljevic <dannym@scratchpost.org>. * gnu/services.scm (cleanup-gexp): Add 'setenv' and 'setlocale' calls before 'delete-file-recursively'. * gnu/tests/base.scm (%cleanup-os, %test-cleanup): New variables. (run-cleanup-test): New procedure. Ludovic Courtès 2018-06-20services: boot: Reverse the order of boot expressions....* gnu/services.scm (compute-boot-script): Reverse MEXPS. * gnu/system.scm (essential-services): Reverse order of %SHEPHERD-ROOT-SERVICE, %ACTIVATION-SERVICE, and CLEANUP-SERVICE-TYPE. Ludovic Courtès 2018-04-08discovery: Remove dependency on (guix ui)....This reduces the closure of (guix discovery) from 28 to 8 modules. * guix/discovery.scm (scheme-files): Use 'format' instead of 'warning'. (scheme-modules): Add #:warn parameter. Use it instead of 'warn-about-load-error'. (fold-modules): Add #:warn and pass it to 'scheme-modules'. (all-modules): Likewise. * gnu/bootloader.scm (bootloader-modules): Pass #:warn to 'all-modules'. * gnu/packages.scm (fold-packages): Likewise. * gnu/services.scm (all-service-modules): Likewise. * guix/upstream.scm (importer-modules): Likewise. Ludovic Courtès 2018-03-29gnu: Refactor boot-service-type and activation-service-type....* gnu/services.scm (boot-service-type) <compose>: Use the "identity" procedure instead of the "append" procedure because it more accurately reflects the intent, which is to simply return the single list of extensions to which fold-services applies the "compose" procedure. (activation-service-type) <compose>: Likewise. Chris Marusich 2018-01-21services: Missing services are automatically instantiated....This simplifies OS configuration: users no longer need to be aware of what a given service depends on. See the discussion at <https://lists.gnu.org/archive/html/guix-devel/2018-01/msg00114.html>. * gnu/services.scm (missing-target-error): New procedure. (service-back-edges): Use it. (instantiate-missing-services): New procedure. * gnu/system.scm (operating-system-services): Call 'instantiate-missing-services'. * tests/services.scm ("instantiate-missing-services") ("instantiate-missing-services, no default value"): New tests. * gnu/services/version-control.scm (cgit-service-type)[extensions]: Add FCGIWRAP-SERVICE-TYPE. * gnu/tests/version-control.scm (%cgit-os): Remove NGINX-SERVICE-TYPE and FCGIWRAP-SERVICE-TYPE instances. * doc/guix.texi (Log Rotation): Remove 'mcron-service-type' in example. (Miscellaneous Services): Remove 'nginx-service-type' and 'fcgiwrap-service-type' in Cgit example. Ludovic Courtès 2017-12-17services: cleanup: Remove "/run/udev/watch.old" directory....* gnu/services.scm (cleanup-gexp): Remove "/run/udev/watch.old" directory. Danny Milosavljevic 2017-11-08services: Add 'lookup-service-types'....* gnu/services.scm (lookup-service-types): New procedure. * tests/services.scm ("lookup-service-types"): New test. Ludovic Courtès 2017-11-08services: 'fold-service-types' includes (gnu services)....* gnu/services.scm (all-service-modules): New procedure. (fold-service-types): Use it for the default MODULES value. Ludovic Courtès 2017-11-08services: 'fold-service-types' honors its seed....* gnu/services.scm (fold-service-types): Use SEED instead of '(). Ludovic Courtès