diff options
Diffstat (limited to 'etc')
| -rwxr-xr-x | etc/committer.scm.in | 26 | ||||
| -rw-r--r-- | etc/disarchive-manifest.scm | 112 | ||||
| -rw-r--r-- | etc/guix-gc.service.in | 20 | ||||
| -rw-r--r-- | etc/guix-gc.timer | 15 | ||||
| -rw-r--r-- | etc/news.scm | 82 | ||||
| -rw-r--r-- | etc/source-manifest.scm | 66 |
6 files changed, 317 insertions, 4 deletions
diff --git a/etc/committer.scm.in b/etc/committer.scm.in index e81ce16611..1ad83e37d7 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -5,6 +5,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; ;;; This file is part of GNU Guix. ;;; @@ -288,6 +289,15 @@ ChangeLog entry." (break-string-with-newlines message/f 72) (break-string-with-newlines changelog/f 72)))) +(define (add-copyright-line line) + "Add the copyright line on LINE to the previous commit." + (let ((author (match:substring + (string-match "^\\+;;; Copyright ©[^[:alpha:]]+(.*)$" line) + 1))) + (format + (current-output-port) "Amend and add copyright line for ~a~%" author) + (system* "git" "commit" "--amend" "--no-edit"))) + (define (group-hunks-by-sexp hunks) "Return a list of pairs associating all hunks with the S-expression they are modifying." @@ -370,15 +380,23 @@ modifying." (error "Cannot apply"))) (usleep %delay)) hunks) - (change-commit-message* (hunk-file-name (first hunks)) - old new) - (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) + (define copyright-line + (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line) + (const line))) + (hunk-diff-lines (first hunks)))) + (cond + (copyright-line + (add-copyright-line copyright-line)) + (else + (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) + (change-commit-message* (hunk-file-name (first hunks)) + old new) (change-commit-message* (hunk-file-name (first hunks)) old new port) (usleep %delay) (unless (eqv? 0 (status:exit-val (close-pipe port))) - (error "Cannot commit"))))) + (error "Cannot commit"))))))) ;; XXX: we recompute the hunks here because previous ;; insertions lead to offsets. (new+old+hunks (diff-info))))))) diff --git a/etc/disarchive-manifest.scm b/etc/disarchive-manifest.scm new file mode 100644 index 0000000000..5cc59f5e2a --- /dev/null +++ b/etc/disarchive-manifest.scm @@ -0,0 +1,112 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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/>. + +;;; This file returns a manifest that builds a directory containing Disarchive +;;; metadata for all the tarballs packages refer to. + +(use-modules (srfi srfi-1) (ice-9 match) + (guix packages) (guix gexp) (guix profiles) + (guix base16) + (gnu packages)) + +(include "source-manifest.scm") + +(define (tarball-origin? origin) + (match (origin-actual-file-name origin) + (#f #f) + ((? string? file) + ;; As of version 0.2.1, Disarchive can only deal with raw tarballs and + ;; gzip-compressed tarballs. + (and (origin-hash origin) + (or (string-suffix? ".tar.gz" file) + (string-suffix? ".tgz" file) + (string-suffix? ".tar" file)))))) + +(define (origin->disarchive origin) + "Return a directory containing Disarchive metadata for ORIGIN, a tarball, or +an empty directory if ORIGIN could not be disassembled." + (define file-name + (let ((hash (origin-hash origin))) + (string-append (symbol->string (content-hash-algorithm hash)) + "/" + (bytevector->base16-string + (content-hash-value hash))))) + + (define disarchive + (specification->package "disarchive")) + + (define build + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (srfi srfi-34)) + + (define tarball + #+(upstream-origin origin)) + + (define file-name + (string-append #$output "/" #$file-name)) + + (define profile + #+(profile (content (packages->manifest (list disarchive))))) + + (mkdir-p (dirname file-name)) + (setenv "PATH" (string-append profile "/bin")) + (setenv "GUILE_LOAD_PATH" + (string-append profile "/share/guile/site/" + (effective-version))) + (setenv "GUILE_LOAD_COMPILED_PATH" + (string-append profile "/lib/guile/" (effective-version) + "/site-ccache")) + + (guard (c ((invoke-error? c) + ;; Sometimes Disarchive fails with "could not find Gzip + ;; compressor". When that happens, produce an empty + ;; directory instead of failing. + (report-invoke-error c) + (delete-file file-name))) + (with-output-to-file file-name + (lambda () + ;; Disarchive records the tarball name in its output. Thus, + ;; strip the hash from TARBALL. + (let ((short-name (strip-store-file-name tarball))) + (symlink tarball short-name) + (invoke "disarchive" "disassemble" short-name)))))))) + + (computed-file (match (origin-actual-file-name origin) + ((? string? str) (string-append str ".dis")) + (#f "anonymous-tarball.dis")) + build)) + +(define (disarchive-collection origins) + "Return a directory containing all the Disarchive metadata for ORIGINS." + (directory-union "disarchive-collection" + (filter-map (lambda (origin) + (and (tarball-origin? origin) + (origin->disarchive origin))) + origins) + #:copy? #t)) + + +;; The manifest containing Disarchive data. +(let ((origins (all-origins))) + (manifest + (list (manifest-entry + (name "disarchive-collection") + (version (length origins)) + (item (disarchive-collection origins)))))) diff --git a/etc/guix-gc.service.in b/etc/guix-gc.service.in new file mode 100644 index 0000000000..2f1ca6584b --- /dev/null +++ b/etc/guix-gc.service.in @@ -0,0 +1,20 @@ +# This is a "service unit file" for the systemd init system to perform a +# one-shot 'guix gc' operation. It is meant to be triggered by a timer. +# Drop it in /etc/systemd/system or similar together with 'guix-gc.timer' +# to set it up. + +[Unit] +Description=Discard unused Guix store items + +[Service] +Type=oneshot +# Customize the 'guix gc' arguments to fit your needs. +ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix gc -d 1m -F 10G +PrivateDevices=yes +PrivateNetwork=yes +PrivateUsers=no +ProtectKernelTunables=yes +ProtectKernelModules=yes +ProtectControlGroups=yes +MemoryDenyWriteExecute=yes +SystemCallFilter=@default @file-system @basic-io @system-service diff --git a/etc/guix-gc.timer b/etc/guix-gc.timer new file mode 100644 index 0000000000..192132fbda --- /dev/null +++ b/etc/guix-gc.timer @@ -0,0 +1,15 @@ +# This is a "timer unit file" for the systemd init system to trigger +# 'guix-gc.service' periodically. Drop it in /etc/systemd/system or similar +# together with 'guix-gc.service' to set it up. + +[Unit] +Description=Discard unused Guix store items + +[Timer] +OnCalendar=weekly +AccuracySec=1h +Persistent=true +RandomizedDelaySec=6000 + +[Install] +WantedBy=timers.target diff --git a/etc/news.scm b/etc/news.scm index dcf07480ed..dc45aaf496 100644 --- a/etc/news.scm +++ b/etc/news.scm @@ -53,6 +53,88 @@ guix home --help Смотрите @command{info \"(guix) Home Configuration\"} для получения более детальных сведений."))) + (entry (commit "5b32ad4f6f555d305659cee825879df075b06331") + (title + (en "New @option{--max-depth} option for @command{guix graph}") + (de "Neue Option @option{--max-depth} für @command{guix graph}") + (fr "Nouvelle option @option{--max-depth} pour @command{guix graph}")) + (body + (en "The @command{guix graph} command has a new @option{--max-depth} +(or @option{-M}) option, which allows you to restrict a graph to the given +depth---very useful when visualizing large graphs. For example, the command +below displays, using the @code{xdot} package, the dependency graph of +LibreOffice, including only nodes that are at most at distance 2 of +LibreOffice itself: + +@example +guix graph -M 2 libreoffice | xdot - +@end example + +See @command{info \"(guix) Invoking guix graph\"} for more information.") + (de "Der Befehl @command{guix graph} verfügt über eine neue +Befehlszeilenoption @option{--max-depth} (oder @option{-M}), mit der +Sie einen Graphen auf die angegebene Tiefe einschränken. Das ist vor +allem bei großen Graphen nützlich; zum Beispiel zeigt der folgende +Befehl, unter Verwendung des Pakets @code{xdot}, den +Abhängigkeitsgraphen von LibreOffice unter Ausschluss der Knoten, die +eine Distanz größer als 2 von LibreOffice selbst haben: + +@example +guix graph -M 2 libreoffice | xdot - +@end example + +Führen Sie @code{info \"(guix.de) Aufruf von guix graph\"} aus, um mehr zu +erfahren.") + (fr "La commande @command{guix graph} dispose d'une nouvelle option +@option{--max-depth} (ou @option{-M}) pour restreindre la profondeur d'un +graphe---très utile pour visualiser des gros graphes. Par exemple, la +commande ci-dessous affiche, en utilisant @code{xdot}, le graphe de dépendance +de LibreOffice en n'incluant que les nœuds qui sont au plus à distance 2 de +LibreOffice soi-même : + +@example +guix graph -M 2 libreoffice | xdot - +@end example + +Voir @command{info \"(guix.fr) Invoquer guix graph\"} pour plus +d'informations."))) + + (entry (commit "05f44c2d858a1e7b13c90362c35fa86bdc4d5a24") + (title + (en "Channel clones fall back to Software Heritage") + (de "Zum Klonen von Kanälen wird notfalls auf Software Heritage zurückgegriffen") + (fr "Les clones de canaux peuvent recourir à Software Heritage")) + (body + (en "When @command{guix time-machine} or @command{guix pull} fetches +a channel pinned to a specific commit, it now automatically falls back to +cloning it from the Software Heritage archive if the original URL is +unreachable. This contributes to long-term reproducibility. See +@command{info \"(guix) Replicating Guix\"}. + +Automatic fallback also works for other Git clones made on your behalf, such +as when using @option{--with-commit} and related package transformation +options.") + (de "Wenn bei @command{guix time-machine} oder @command{guix +pull} ein bestimmter Commit eines Kanals bezogen werden soll, wird +jetzt für den Fall, dass die ursprüngliche URL unerreichbar ist, +automatisch vom Software-Heritage-Archiv geklont. Das trägt zur +langfristigen Reproduzierbarkeit bei. Siehe @command{info \"(guix.de) +Guix nachbilden\"}. + +Der automatische Rückgriff auf Software Heritage findet auch +Verwendung bei anderen Arten von Git-Klon, die Guix durchführt, z.B.@: +wenn Sie @option{--with-commit} und ähnliche Paketumwandlungsoptionen +einsetzen.") + (fr "Quand la commande @command{guix time-machine} ou @command{guix +pull} récupère un canal fixé à une révision spécifique, elle est maintenant +capable de le cloner depuis l'archive Software Heritage si l'URL initiale +n'est plus disponible. Cela contribue à la reproductibilité à long terme. +Voir @command{info \"(guix.fr) Répliquer Guix\"}. + +Ce recours à Software Heritage fonctionne aussi pour les autres clones Git que +Guix peut faire, comme lorsqu'on utilise @option{--with-commit} et les options +de transformation de paquet similaires."))) + (entry (commit "82daab42811a2e3c7684ebdf12af75ff0fa67b99") (title (en "New @samp{deb} format for the @command{guix pack} command") diff --git a/etc/source-manifest.scm b/etc/source-manifest.scm new file mode 100644 index 0000000000..f96a5da6f7 --- /dev/null +++ b/etc/source-manifest.scm @@ -0,0 +1,66 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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/>. + +;;; This file returns a manifest containing origins of all the packages. The +;;; main purpose is to allow continuous integration services to keep upstream +;;; source code around. It can also be passed to 'guix weather -m'. + +(use-modules (srfi srfi-1) (srfi srfi-26) + (ice-9 match) (ice-9 vlist) + (guix packages) (guix profiles) + (gnu packages)) + +(define (all-packages) + "Return the list of all the packages, public or private, omitting only +superseded packages." + (fold-packages (lambda (package lst) + (match (package-replacement package) + (#f (cons package lst)) + (replacement + (append (list replacement package) lst)))) + '() + #:select? (negate package-superseded))) + +(define (upstream-origin source) + "Return SOURCE without any patches or snippet." + (origin (inherit source) + (snippet #f) (patches '()))) + +(define (all-origins) + "Return the list of origins referred to by all the packages." + (let loop ((packages (all-packages)) + (origins '()) + (visited vlist-null)) + (match packages + ((head . tail) + (let ((new (remove (cut vhash-assq <> visited) + (package-direct-sources head)))) + (loop tail (append new origins) + (fold (cut vhash-consq <> #t <>) + visited new)))) + (() + origins)))) + +;; Return a manifest containing all the origins. +(manifest (map (lambda (origin) + (manifest-entry + (name (or (origin-actual-file-name origin) + "origin")) + (version "0") + (item (upstream-origin origin)))) + (all-origins))) |