From 00c8a9275c67c08b6fb9058617d3ad7d55fa4fad Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Mon, 19 Feb 2024 11:44:47 +0100 Subject: upstream: update-package-inputs: Sort extra inputs. Ensure that extra inputs end up in the correct order. * guix/upstream.scm (update-package-inputs)[filtered-inputs]: Sort new list of inputs. Change-Id: Ia5fddd8103a33c79426995057fcce61c2e9e5a72 --- guix/upstream.scm | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) (limited to 'guix') diff --git a/guix/upstream.scm b/guix/upstream.scm index e28ae12f3f..180ae21dcf 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2010-2023 Ludovic Courtès ;;; Copyright © 2015 Alex Kost -;;; Copyright © 2019, 2022, 2023 Ricardo Wurmus +;;; Copyright © 2019, 2022-2024 Ricardo Wurmus ;;; Copyright © 2021 Sarah Morgensen ;;; Copyright © 2021, 2022 Maxime Devos ;;; Copyright © 2022 Hartmut Goebel @@ -566,17 +566,21 @@ specified in SOURCE, an ." (properties (package-properties package)) (ignore (or (assoc-ref properties ignore-property) '())) (extra (or (assoc-ref properties extra-property) '()))) - (append (if (null? ignore) - inputs - (remove (lambda (input) - (member (upstream-input-downstream-name input) - ignore)) - inputs)) - (map (lambda (name) - (upstream-input - (name name) - (downstream-name name))) - extra))))) + (sort + (append (if (null? ignore) + inputs + (remove (lambda (input) + (member (upstream-input-downstream-name input) + ignore)) + inputs)) + (map (lambda (name) + (upstream-input + (name name) + (downstream-name name))) + extra)) + (lambda (a b) + (string-ci Date: Tue, 20 Feb 2024 10:32:24 +0100 Subject: import/cran: Use downstream name when using specifications. Reported by Alexander Blume at . * guix/import/cran.scm (format-inputs): Use UPSTREAM-INPUT-DOWNSTREAM-NAME when %INPUT-STYLE is set to 'SPECIFICATION. Change-Id: I2f0963af197896aafd613b253d8712e41a716e52 --- guix/import/cran.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/cran.scm b/guix/import/cran.scm index db9250faec..9b30dc30e0 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -90,7 +90,7 @@ (map (lambda (input) (case (%input-style) ((specification) - `(specification->package ,(upstream-input-name input))) + `(specification->package ,(upstream-input-downstream-name input))) (else ((compose string->symbol upstream-input-downstream-name) -- cgit v1.2.3 From 34c79c6ae8103ebae9ce08c81a9220a6b82b05f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 20 Feb 2024 10:46:42 +0100 Subject: =?UTF-8?q?syscalls:=20=E2=80=98processes=E2=80=99=20really=20omit?= =?UTF-8?q?s=20kernel=20threads.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes a bug whereby ‘processes’ would include kernel threads, thereby leading the ‘stop’ method of ‘user-processes’ to wait indefinitely for a kernel thread. Code taken from the Shepherd. Fixes . * guix/build/syscalls.scm (kernel?): Remove. (linux-process-flags, linux-kernel-thread?, pseudo-process?): New procedures. (PF_KTHREAD): New variable. (processes): Use ‘pseudo-process?’ instead of ‘kernel?’. Reported-by: Tomas Volf <~@wolfsden.cz> Change-Id: I8c439cdaf868a8f899de7fe500ce8bf10e5fc290 --- guix/build/syscalls.scm | 55 +++++++++++++++++++++++++++++++++++-------------- 1 file changed, 39 insertions(+), 16 deletions(-) (limited to 'guix') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index b2871c3c10..39bcffd516 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2023 Ludovic Courtès +;;; Copyright © 2014-2024 Ludovic Courtès ;;; Copyright © 2015 David Thompson ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2017 Mathieu Othacehe @@ -765,27 +765,50 @@ current process." (list (strerror err)) (list err))))))) -(define (kernel? pid) - "Return #t if PID designates a \"kernel thread\" rather than a normal -user-land process." - (let ((stat (call-with-input-file (format #f "/proc/~a/stat" pid) - (compose string-tokenize read-string)))) - ;; See proc.txt in Linux's documentation for the list of fields. - (match stat - ((pid tcomm state ppid pgrp sid tty_nr tty_pgrp flags min_flt - cmin_flt maj_flt cmaj_flt utime stime cutime cstime - priority nice num_thread it_real_value start_time - vsize rss rsslim - (= string->number start_code) (= string->number end_code) _ ...) - ;; Got this obscure trick from sysvinit's 'killall5' program. - (and (zero? start_code) (zero? end_code)))))) +(define (linux-process-flags pid) ;copied from the Shepherd + "Return the process flags of @var{pid} (or'd @code{PF_} constants), assuming +the Linux /proc file system is mounted; raise a @code{system-error} exception +otherwise." + (call-with-input-file (string-append "/proc/" (number->string pid) + "/stat") + (lambda (port) + (define line + (read-string port)) + + ;; Parse like systemd's 'is_kernel_thread' function. + (let ((offset (string-index line #\)))) ;offset past 'tcomm' field + (match (and offset + (string-tokenize (string-drop line (+ offset 1)))) + ((state ppid pgrp sid tty-nr tty-pgrp flags . _) + (or (string->number flags) 0)) + (_ + 0)))))) + +;; Per-process flag defined in . +(define PF_KTHREAD #x00200000) ;I am a kernel thread + +(define (linux-kernel-thread? pid) + "Return true if @var{pid} is a Linux kernel thread." + (= PF_KTHREAD (logand (linux-process-flags pid) PF_KTHREAD))) + +(define pseudo-process? + (if (string-contains %host-type "linux") + (lambda (pid) + "Return true if @var{pid} denotes a \"pseudo-process\" such as a Linux +kernel thread rather than a \"regular\" process. A pseudo-process is one that +may never terminate, even after sending it SIGKILL---e.g., kthreadd on Linux." + (catch 'system-error + (lambda () + (linux-kernel-thread? pid)) + (const #f))) + (const #f))) (define (processes) "Return the list of live processes." (sort (filter-map (lambda (file) (let ((pid (string->number file))) (and pid - (not (kernel? pid)) + (not (pseudo-process? pid)) pid))) (scandir "/proc")) <)) -- cgit v1.2.3 From a1d0610f830e1bf3573cac42ba4c013ed76accef Mon Sep 17 00:00:00 2001 From: Herman Rimm Date: Tue, 20 Feb 2024 21:45:10 +0100 Subject: import: Wrap package expressions with define-public. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/import.scm (guix-import): Wrap package expressions. Change-Id: Ic4d986a4706a692b2fecd6fded8ac72ab6311687 Signed-off-by: Ludovic Courtès --- guix/scripts/import.scm | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index d2a1cee56e..77fcfe3990 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2021 Simon Tournier ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2022 Philip McGrath +;;; Copyright © 2024 Herman Rimm ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +24,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix scripts import) + #:use-module (guix import utils) #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix read-print) @@ -89,12 +91,18 @@ Run IMPORTER with ARGS.\n")) (pretty-print-with-comments (current-output-port) expr))))) (match (apply (resolve-importer importer) args) ((and expr (or ('package _ ...) - ('let _ ...) - ('define-public _ ...))) + ('let _ ...))) + (print (package->definition expr))) + ((and expr ('define-public _ ...)) (print expr)) ((? list? expressions) (for-each (lambda (expr) - (print expr) + (match expr + ((and expr (or ('package _ ...) + ('let _ ...))) + (print (package->definition expr))) + ((and expr ('define-public _ ...)) + (print expr))) ;; Two newlines: one after the closing paren, and ;; one to leave a blank line. (newline) (newline)) -- cgit v1.2.3 From babd39e84389c544e8dab44be8ddec57e52709c9 Mon Sep 17 00:00:00 2001 From: Herman Rimm Date: Tue, 20 Feb 2024 21:45:11 +0100 Subject: utils: Add insert-expression procedure. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/utils.scm (define-module): Use (guix read-print) and export (insert-expression). (insert-expression): Add procedure. * tests/utils.scm ("insert-expression"): Add test. Change-Id: I971a43a78aa6ecaaef33c1a7a0db4b287eb85036 Signed-off-by: Ludovic Courtès --- guix/utils.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'guix') diff --git a/guix/utils.scm b/guix/utils.scm index e4e9d922e7..94b4d753d0 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -20,6 +20,7 @@ ;;; Copyright © 2023 Janneke Nieuwenhuizen ;;; Copyright © 2023 Zheng Junjie <873216071@qq.com> ;;; Copyright © 2023 Foundation Devices, Inc. +;;; Copyright © 2024 Herman Rimm ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,6 +39,7 @@ (define-module (guix utils) #:use-module (guix config) + #:autoload (guix read-print) (object->string*) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -145,6 +147,7 @@ go-to-location edit-expression delete-expression + insert-expression filtered-port decompressed-port @@ -502,6 +505,14 @@ the trailing line is included in the edited expression." "Delete the expression specified by SOURCE-PROPERTIES." (edit-expression source-properties (const "") #:include-trailing-newline? #t)) +(define (insert-expression source-properties expr) + "Insert EXPR before the top-level expression specified by +SOURCE-PROPERTIES." + (let* ((expr (object->string* expr 0)) + (insert (lambda (str) + (string-append expr "\n\n" str)))) + (edit-expression source-properties insert))) + ;;; ;;; Keyword arguments. -- cgit v1.2.3 From 50e514c1bc674b1c36344407c8c4b418d17759c5 Mon Sep 17 00:00:00 2001 From: Herman Rimm Date: Tue, 20 Feb 2024 21:45:12 +0100 Subject: utils: Add find-definition-insertion-location procedure. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/utils.scm (find-definition-insertion-location): Add and export procedure. * tests/utils.scm ("find-definition-insertion-location"): Add test. Change-Id: Ie17e1b4a94790f58518ce121411a38d357f49feb Signed-off-by: Ludovic Courtès --- guix/utils.scm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'guix') diff --git a/guix/utils.scm b/guix/utils.scm index 94b4d753d0..29ad09d9f7 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -148,6 +148,7 @@ edit-expression delete-expression insert-expression + find-definition-insertion-location filtered-port decompressed-port @@ -513,6 +514,24 @@ SOURCE-PROPERTIES." (string-append expr "\n\n" str)))) (edit-expression source-properties insert))) +(define (find-definition-insertion-location file term) + "Search in FILE for a top-level public definition whose defined term +alphabetically succeeds TERM. Return the location if found, or #f +otherwise." + (let ((search-term (symbol->string term))) + (call-with-input-file file + (lambda (port) + (do ((syntax (read-syntax port) + (read-syntax port))) + ((match (syntax->datum syntax) + (('define-public current-term _ ...) + (string> (symbol->string current-term) + search-term)) + ((? eof-object?) #t) + (_ #f)) + (and (not (eof-object? syntax)) + (syntax-source syntax)))))))) + ;;; ;;; Keyword arguments. -- cgit v1.2.3 From 635af8628c096526e3a79348f484e641aa05f04a Mon Sep 17 00:00:00 2001 From: Herman Rimm Date: Tue, 20 Feb 2024 21:45:13 +0100 Subject: import: Insert packages into modules alphabetically. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/import.scm (guix-import): Add 'insert' option. (import-as-definitions): Add procedure. * doc/guix.texi (Invoking guix import): Describe 'insert' option. Change-Id: Id87ea707123630e12bcb6788599acac6895b26c4 Signed-off-by: Ludovic Courtès --- guix/scripts/import.scm | 82 ++++++++++++++++++++++++++++++++----------------- 1 file changed, 53 insertions(+), 29 deletions(-) (limited to 'guix') diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 77fcfe3990..aca4e61f26 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -67,10 +67,39 @@ Run IMPORTER with ARGS.\n")) (display (G_ " -h, --help display this help and exit")) (display (G_ " + -i, --insert insert packages into file alphabetically")) + (display (G_ " -V, --version display version information and exit")) (newline) (show-bug-report-information)) +(define (import-as-definitions importer args proc) + "Wrap package expressions from IMPORTER with 'define-public and invoke +PROC callback." + (if (member importer importers) + (match (apply (resolve-importer importer) args) + ((and expr (or ('package _ ...) + ('let _ ...))) + (proc (package->definition expr))) + ((and expr ('define-public _ ...)) + (proc expr)) + ((expressions ...) + (for-each (lambda (expr) + (match expr + ((and expr (or ('package _ ...) + ('let _ ...))) + (proc (package->definition expr))) + ((and expr ('define-public _ ...)) + (proc expr)))) + expressions)) + (x + (leave (G_ "'~a' import failed~%") importer))) + (let ((hint (string-closest importer importers #:threshold 3))) + (report-error (G_ "~a: invalid importer~%") importer) + (when hint + (display-hint (G_ "Did you mean @code{~a}?~%") hint)) + (exit 1)))) + (define-command (guix-import . args) (category packaging) (synopsis "import a package definition from an external repository") @@ -84,33 +113,28 @@ Run IMPORTER with ARGS.\n")) (exit 0)) ((or ("-V") ("--version")) (show-version-and-exit "guix import")) + ((or ("-i" file importer args ...) + ("--insert" file importer args ...)) + (let ((find-and-insert + (lambda (expr) + (match expr + (('define-public term _ ...) + (let ((source-properties + (find-definition-insertion-location + file term))) + (if source-properties + (insert-expression source-properties expr) + (let ((port (open-file file "a"))) + (pretty-print-with-comments port expr) + (newline port) + (close-port port))))))))) + (import-as-definitions importer args find-and-insert))) ((importer args ...) - (if (member importer importers) - (let ((print (lambda (expr) - (leave-on-EPIPE - (pretty-print-with-comments (current-output-port) expr))))) - (match (apply (resolve-importer importer) args) - ((and expr (or ('package _ ...) - ('let _ ...))) - (print (package->definition expr))) - ((and expr ('define-public _ ...)) - (print expr)) - ((? list? expressions) - (for-each (lambda (expr) - (match expr - ((and expr (or ('package _ ...) - ('let _ ...))) - (print (package->definition expr))) - ((and expr ('define-public _ ...)) - (print expr))) - ;; Two newlines: one after the closing paren, and - ;; one to leave a blank line. - (newline) (newline)) - expressions)) - (x - (leave (G_ "'~a' import failed~%") importer)))) - (let ((hint (string-closest importer importers #:threshold 3))) - (report-error (G_ "~a: invalid importer~%") importer) - (when hint - (display-hint (G_ "Did you mean @code{~a}?~%") hint)) - (exit 1)))))) + (let ((print (lambda (expr) + (leave-on-EPIPE + (pretty-print-with-comments + (current-output-port) expr) + ;; Two newlines: one after the closing paren, and + ;; one to leave a blank line. + (newline) (newline))))) + (import-as-definitions importer args print))))) -- cgit v1.2.3 From df3e44cab1078ac6e84df9059a5acccdf9486700 Mon Sep 17 00:00:00 2001 From: Herman Rimm Date: Tue, 20 Feb 2024 21:45:14 +0100 Subject: import: Discard args after --version and --help. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/import.scm (guix-import): Discard args. Change-Id: Icce5cd0daf9011f7ddde7904113b31b547f063ef Signed-off-by: Ludovic Courtès --- guix/scripts/import.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index aca4e61f26..1f34cab088 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -108,10 +108,10 @@ PROC callback." (() (format (current-error-port) (G_ "guix import: missing importer name~%"))) - ((or ("-h") ("--help")) + ((or ("-h" _ ...) ("--help" _ ...)) (leave-on-EPIPE (show-help)) (exit 0)) - ((or ("-V") ("--version")) + ((or ("-V" _ ...) ("--version" _ ...)) (show-version-and-exit "guix import")) ((or ("-i" file importer args ...) ("--insert" file importer args ...)) -- cgit v1.2.3 From b386c11e7804e0b577411d930b60f1e0a4a0382c Mon Sep 17 00:00:00 2001 From: Herman Rimm Date: Tue, 20 Feb 2024 21:45:15 +0100 Subject: import: Do not return package name with json importer. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/json.scm (json->code): Do not return package names after package expressions. * doc/package-hello.json: Fix comma errors and use valid greeter URL. Change-Id: Id71924e72f690a9bda5fbfdb65a443029adfd158 Signed-off-by: Ludovic Courtès --- guix/import/json.scm | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/import/json.scm b/guix/import/json.scm index b87e9918c5..bf346a1bef 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -78,14 +78,13 @@ a list of S-expressions, or return #F when the JSON is invalid." #:result (append result (list - (package->code (alist->package pkg names)) - (string->symbol (assoc-ref pkg "name")))))))) - (list #:names '() - #:result '()) - packages)))) + (package->code + (alist->package pkg names)))))))) + (list #:names '() + #:result '()) + packages)))) (package - (list (package->code (alist->package json)) - (string->symbol (assoc-ref json "name"))))))) + (list (package->code (alist->package json))))))) (const #f))) (define (json->scheme-file file) -- cgit v1.2.3