fix(guix-bootstrap): serve local distfiles via fixed localhost HTTP mirror

steps-guix/guix-1.5.0/pass1.sh

@@ -61,16 +61,14 @@ src_prepare() {
     patch --dry-run -p1 < "${rendered_mes_patch}"
     patch -p1 < "${rendered_mes_patch}"
 
-    grep -q 'file:///external/distfiles/' "${bootstrap_scm}"
+    grep -q '127.0.0.1:38445' "${bootstrap_scm}"
     grep -q "${EXEC_BASH_HASH}" "${bootstrap_scm}"
     grep -q "${STATIC_BINARIES_SEED_HASH}" "${bootstrap_scm}"
     grep -q "${GUILE_SEED_HASH}" "${bootstrap_scm}"
     grep -q "${MES_MINIMAL_SEED_HASH}" "${bootstrap_scm}"
     grep -q "${MESCC_TOOLS_SEED_HASH}" "${bootstrap_scm}"
-    grep -q "All bootstrap binaries must come from local, reproducible distfiles." "${bootstrap_scm}"
+    grep -q "All bootstrap binaries must come from the local bootstrap mirror." "${bootstrap_scm}"
     grep -q "%bootstrap-linux-headers-base-urls" "${bootstrap_scm}"
-    grep -q "%allowed-local-download-directories" guix/scripts/perform-download.scm
-    grep -q '"/external/distfiles"' guix/scripts/perform-download.scm
     grep -q '^(define (bootstrap-mes-minimal-origin system)' "${bootstrap_scm}"
     grep -q '^(define %bootstrap-mescc-tools' "${bootstrap_scm}"
     grep -q "mes-minimal-stripped-0.19-i686-linux.tar.xz" "${bootstrap_scm}"

steps-guix/guix-1.5.0/patches/allow-local-distfiles-in-perform-download.patch

@@ -1,51 +0,0 @@
---- guix-1.5.0/guix/scripts/perform-download.scm
-+++ guix-1.5.0/guix/scripts/perform-download.scm
-@@ -97,16 +97,46 @@ a list of wrapper procedures for safely calling the list of procedures that
-   (call-with-port (open file (logior O_NOFOLLOW O_RDONLY))
-     proc))
- 
-+(define %allowed-local-download-directories
-+  ;; Allow only the explicitly prepared offline distfiles directory.  Other
-+  ;; local file URLs remain forbidden.
-+  '("/external/distfiles"))
-+
-+(define (path-within-directory? path directory)
-+  (or (string=? path directory)
-+      (string-prefix? (string-append directory "/") path)))
-+
-+(define (allowed-local-file? path)
-+  (let ((canon-path (false-if-exception (canonicalize-path path))))
-+    (and canon-path
-+         (let loop ((directories %allowed-local-download-directories))
-+           (match directories
-+             (() #f)
-+             ((directory rest ...)
-+              (let ((canon-directory
-+                     (false-if-exception (canonicalize-path directory))))
-+                (if (and canon-directory
-+                         (path-within-directory? canon-path canon-directory))
-+                    #t
-+                    (loop rest)))))))))
-+
-+(define (file-uri-allowed? url)
-+  (let ((uri (string->uri url)))
-+    (and uri
-+         (eq? (uri-scheme uri) 'file)
-+         (allowed-local-file? (uri-path uri)))))
-+
- (define (assert-non-local-urls url)
-   "Exit if URL (or any element of URL if it is a list) is either not a valid
- URL or is a URL for a local file."
-   (for-each (lambda (url)
--              (let ((scheme (and=> (string->uri url) uri-scheme)))
--                (unless scheme
-+              (let ((uri (string->uri url)))
-+                (unless uri
-                   (leave (G_ "URL ~S can't be decoded~%") url))
--                (when (eq? scheme 'file)
-+                (when (and (eq? (uri-scheme uri) 'file)
-+                           (not (file-uri-allowed? url)))
-                   (leave (G_ "URL ~S is for a local file~%") url))))
-             (if (list? url)
-                 url
-                 (list url))))

steps-guix/guix-1.5.0/patches/bootstrap-local-seeds.patch.in

@@ -27,7 +27,7 @@
 -    "https://alpha.gnu.org/gnu/guix/bootstrap/"
 -    "http://flashner.co.il/guix/bootstrap/"
 -    "http://lilypond.org/janneke/guix/"))
-+  '("file:///external/distfiles/"))
++  '("http://127.0.0.1:38445/"))
  
  (define (bootstrap-executable-file-name system program)
    "Return the FILE-NAME part of url where PROGRAM can be found for SYSTEM."

steps-guix/guix-1.5.0/patches/enforce-local-bootstrap-binaries-except-linux-headers.patch

@@ -17,8 +17,8 @@
      "http://lilypond.org/janneke/guix/"))
  
 +(define %bootstrap-base-urls
-+  ;; All bootstrap binaries must come from local, reproducible distfiles.
-+  '("file:///external/distfiles"))
++  ;; All bootstrap binaries must come from the local bootstrap mirror.
++  '("http://127.0.0.1:38445"))
 +
  (define (bootstrap-guile-url-path system)
    "Return the URI for FILE."

steps-guix/improve/guix-daemon-and-pull.sh

@@ -13,6 +13,11 @@ channel_repo="${channel_root}/guix"
 channel_work="/tmp/guix-local-channel-work"
 channels_file="/root/.config/guix/channels.scm"
 distfiles="${DISTFILES:-/external/distfiles}"
+distfiles_http_host="127.0.0.1"
+distfiles_http_port="38445"
+distfiles_http_base_url="http://${distfiles_http_host}:${distfiles_http_port}"
+distfiles_http_pid=""
+distfiles_http_log="/tmp/distfiles-httpd.log"
 guix_seed_helper="/steps-guix/improve/guix-1.5.0.sh"
 guix_patch_dir="/steps-guix/guix-1.5.0/patches"
 PATH="/usr/sbin:/sbin:${PATH}"
@@ -32,6 +37,55 @@ export GUILE_SYSTEM_COMPILED_PATH="${guile_site_ccache}:${guile_core_ccache}"
 export GUILE_EXTENSIONS_PATH="${guile_ext_path}"
 export GNUTLS_GUILE_EXTENSION_DIR="${guile_ext_path}"
 
+stop_distfiles_http_server() {
+    if [ -n "${distfiles_http_pid}" ] && kill -0 "${distfiles_http_pid}" >/dev/null 2>&1; then
+        kill "${distfiles_http_pid}" >/dev/null 2>&1 || true
+        wait "${distfiles_http_pid}" >/dev/null 2>&1 || true
+    fi
+}
+
+start_distfiles_http_server() {
+    if [ ! -d "${distfiles}" ]; then
+        echo "Distfiles directory is missing: ${distfiles}" >&2
+        exit 1
+    fi
+
+    if ! command -v python3 >/dev/null 2>&1; then
+        echo "python3 is required to serve local distfiles over HTTP." >&2
+        exit 1
+    fi
+
+    rm -f "${distfiles_http_log}"
+
+    echo "Starting local distfiles HTTP server at ${distfiles_http_base_url}"
+    python3 -m http.server "${distfiles_http_port}" \
+        --bind "${distfiles_http_host}" \
+        --directory "${distfiles}" \
+        >"${distfiles_http_log}" 2>&1 &
+    distfiles_http_pid="$!"
+
+    retry=0
+    while [ "${retry}" -lt 30 ]; do
+        if ! kill -0 "${distfiles_http_pid}" >/dev/null 2>&1; then
+            echo "Local distfiles HTTP server exited unexpectedly." >&2
+            cat "${distfiles_http_log}" >&2 || true
+            exit 1
+        fi
+        if python3 -c "import urllib.request; urllib.request.urlopen('${distfiles_http_base_url}/', timeout=2).read(1)" \
+            >/dev/null 2>&1; then
+            return
+        fi
+        retry=$((retry + 1))
+        sleep 1
+    done
+
+    echo "Timed out waiting for local distfiles HTTP server: ${distfiles_http_base_url}" >&2
+    cat "${distfiles_http_log}" >&2 || true
+    exit 1
+}
+
+trap stop_distfiles_http_server EXIT INT TERM HUP
+
 have_group() {
     if command -v getent >/dev/null 2>&1; then
         getent group "$1" >/dev/null 2>&1
@@ -107,8 +161,6 @@ prepare_local_channel_checkout() {
 
     (
         cd "${channel_repo}"
-        patch --dry-run -p1 < "${guix_patch_dir}/allow-local-distfiles-in-perform-download.patch"
-        patch -p1 < "${guix_patch_dir}/allow-local-distfiles-in-perform-download.patch"
         patch --dry-run -p1 < "${guix_patch_dir}/enforce-local-bootstrap-binaries-except-linux-headers.patch"
         patch -p1 < "${guix_patch_dir}/enforce-local-bootstrap-binaries-except-linux-headers.patch"
         patch --dry-run -p1 < "${rendered_patch}"
@@ -252,4 +304,5 @@ if ! guile -c '(use-modules (gnutls)) (if (module-variable (resolve-module (quot
     exit 1
 fi
 
+start_distfiles_http_server
 guix pull --bootstrap --no-substitutes --channels="${channels_file}" --disable-authentication