Merge branch 'master' into emacs-team

3 files changed, 57 insertions, 21 deletions

diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm
index ffb2ec898e..70ddf063d2 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Ivan Petkov <ivanppetkov@gmail.com>
-;;; Copyright © 2019-2023 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2019-2024 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Marius Bakke <marius@gnu.org>
 ;;;
@@ -162,6 +162,7 @@ libraries or executables."
                    ("powerpc64le-linux-gnu" "powerpc64le-unknown-linux-gnu")
                    ("riscv64-linux-gnu" "riscv64gc-unknown-linux-gnu")
                    ("x86_64-linux-gnu" "x86_64-unknown-linux-gnu")
+                   ("x86_64-linux-gnux32" "x86_64-unknown-linux-gnux32")
                    ("i586-pc-gnu" "i686-unknown-hurd-gnu")
                    ("i686-w64-mingw32" "i686-pc-windows-gnu")
                    ("x86_64-w64-mingw32" "x86_64-pc-windows-gnu")
diff --git a/guix/build/git.scm b/guix/build/git.scm
index 867cade2c4..4c69365a7b 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2019, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2019, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -20,7 +20,9 @@
 (define-module (guix build git)
   #:use-module (guix build utils)
   #:autoload   (guix build download-nar) (download-nar)
-  #:autoload   (guix swh) (%verify-swh-certificate? swh-download)
+  #:autoload   (guix swh) (%verify-swh-certificate?
+                           swh-download
+                           swh-download-directory-by-nar-hash)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 format)
   #:export (git-fetch
@@ -91,10 +93,13 @@ fetched, recursively.  Return #t on success, #f otherwise."
 
 (define* (git-fetch-with-fallback url commit directory
                                   #:key (git-command "git")
+                                  hash hash-algorithm
                                   lfs? recursive?)
   "Like 'git-fetch', fetch COMMIT from URL into DIRECTORY, but fall back to
 alternative methods when fetching from URL fails: attempt to download a nar,
-and if that also fails, download from the Software Heritage archive."
+and if that also fails, download from the Software Heritage archive.  When
+HASH and HASH-ALGORITHM are provided, they are interpreted as the nar hash of
+the directory of interested and are used as its content address at SWH."
   (or (git-fetch url commit directory
                  #:lfs? lfs?
                  #:recursive? recursive?
@@ -110,7 +115,14 @@ and if that also fails, download from the Software Heritage archive."
              (format (current-error-port)
                      "Trying to download from Software Heritage...~%")
 
-             (swh-download url commit directory)
+             ;; First try to look up and download the directory corresponding
+             ;; to HASH: this is fundamentally more reliable than looking up
+             ;; COMMIT, especially when COMMIT denotes a tag.
+             (or (and hash hash-algorithm
+                      (swh-download-directory-by-nar-hash hash hash-algorithm
+                                                          directory))
+                 (swh-download url commit directory))
+
              (when (file-exists?
                     (string-append directory "/.gitattributes"))
                ;; Perform CR/LF conversion and other changes
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"))
         <))