Merge branch 'master' into gnome-team

6 files changed, 149 insertions, 61 deletions

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 <ludo@gnu.org>
+;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -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 <linux/sched.h>.
+(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"))
         <))
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)
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)
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index d2a1cee56e..1f34cab088 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix scripts import)
+  #:use-module (guix import utils)
   #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix read-print)
@@ -65,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")
@@ -77,32 +108,33 @@ Run IMPORTER with ARGS.\n"))
     (()
      (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 ...))
+     (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 _ ...)
-                            ('define-public _ ...)))
-              (print expr))
-             ((? list? expressions)
-              (for-each (lambda (expr)
-                          (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)))))
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 <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2019, 2022, 2023 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019, 2022-2024 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
@@ -566,17 +566,21 @@ specified in SOURCE, an <upstream-source>."
              (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<? (upstream-input-downstream-name a)
+                        (upstream-input-downstream-name b)))))))
 
   (define regular-inputs
     (filtered-inputs upstream-source-regular-inputs
diff --git a/guix/utils.scm b/guix/utils.scm
index e4e9d922e7..29ad09d9f7 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -20,6 +20,7 @@
 ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2023 Zheng Junjie <873216071@qq.com>
 ;;; Copyright © 2023 Foundation Devices, Inc. <hello@foundationdevices.com>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; 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,8 @@
             go-to-location
             edit-expression
             delete-expression
+            insert-expression
+            find-definition-insertion-location
 
             filtered-port
             decompressed-port
@@ -502,6 +506,32 @@ 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)))
+
+(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.