Name bug-reprod binutils & coreutils uniquely

3 files changed, 179 insertions, 141 deletions

diff --git a/bugs/README.md b/bugs/README.md
index 42d6383..9a2a44b 100644
--- a/bugs/README.md
+++ b/bugs/README.md
@@ -4,56 +4,56 @@
 
 - CVE-2017-6965: [heap buffer overflow][sourceware-21137]
 
-      guix shell -e '(@@ (loftix bugs) binutils-2.27-asan)'
+      guix shell binutils-with-asan@2.27
       readelf -w cve/2017/6965/bug_3
 
 - CVE-2017-14745: [integer overflow][sourceware-22148]
 
-      guix shell -e '(@@ (loftix bugs) binutils-2.29)'
+      guix shell binutils@2.29
       objdump -d cve/2017/14745/crash_1
 
 - CVE-2017-15020: [heap buffer overflow][sourceware-22202]
 
-      guix shell -e '(@@ (loftix bugs) binutils-2.29-asan)'
+      guix shell binutils-with-asan@2.29
       nm -l cve/2017/15020/reproducer
 
 - CVE-2017-15025: [division by zero][sourceware-22186]
 
-      guix shell -e '(@@ (loftix bugs) binutils-2.29)'
+      guix shell binutils@2.29
       nm -l cve/2017/15025/3899.crashes.bin
       nm -l cve/2017/15025/floatexception.elf
       objdump -S cve/2017/15025/floatexception.elf
 
 - CVE-2018-10372: [heap buffer overflow][sourceware-23064]
 
-      guix shell -e '(@@ (loftix bugs) binutils-2.30-asan)'
+      guix shell binutils-with-asan@2.30
       readelf -w cve/2018/10372/bug3
 
 - CVE-2019-9077: [heap buffer overflow][sourceware-24243]
 
-      guix shell -e '(@@ (loftix bugs) binutils-2.32-asan)'
+      guix shell binutils-with-asan@2.32
       readelf -a cve/2019/9077/hbo2
 
 ## GNU Core Utilities
 
 - #19784: [heap buffer overflow][gnu-19784]
 
-      guix shell -e '(@@ (loftix bugs) coreutils-8.23-asan)'
+      guix shell coreutils-with-make-prime-list-with-asan@8.23
       make-prime-list 3  # or: $(xargs -0 -a gnu/19784/argv)
 
 - #25003: [negative size param][gnu-25003]
 
-      guix shell -e '(@@ (loftix bugs) coreutils-8.26-sans-4954f79-asan)'
+      guix shell coreutils-with-asan@8.26-sans-4954f79
       split -n2/3 /dev/null  # or: $(xargs -0 -a gnu/25003/argv)
 
 - #25023: [global buffer overflow][gnu-25023]
 
-      guix shell -e '(@@ (loftix bugs) coreutils-8.25-asan)'
+      guix shell coreutils-with-asan@8.25
       pr -m -S"$(printf '\t\t\t')" -t /dev/null /dev/zero
 
 - #26545: [memcpy param overlap][gnu-26545]
 
-      guix shell -e '(@@ (loftix bugs) coreutils-8.27-asan)'
+      guix shell coreutils-with-asan@8.27
       shred -n4 -s7 /dev/null  # or: $(xargs -0 -a gnu/26545/argv)
 
 ## JasPer
diff --git a/loftix/bugs.scm b/loftix/bugs.scm
index 927e788..afa63f9 100644
--- a/loftix/bugs.scm
+++ b/loftix/bugs.scm
@@ -28,153 +28,155 @@
   #:use-module (guix git-download)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix packages)
-  #:use-module (guix utils))
+  #:use-module (guix utils)
+  #:use-module (srfi srfi-26))
 
-(define-public binutils-2.32-asan
+(define (at-version base version uri checksum)
   (package
-    (inherit binutils-2.33)
-    (version "2.32")
-    (source (origin
-              (inherit (package-source binutils))
-              (uri (string-append "mirror://gnu/binutils/binutils-"
-                                  version ".tar.bz2"))
-              (sha256
-               (base32 "0b8767nyal1bc4cyzg5h9iis8kpkln1i3wkamig75cifj1fb2f6y"))
-              (patches '())))
-    (arguments '(#:phases (modify-phases %standard-phases
-                            (add-before 'build 'set-env
-                              (lambda _
-                                (setenv "ASAN_OPTIONS" "detect_leaks=0"))))
-                 #:make-flags '("CFLAGS=-O2 -g -fsanitize=address"
-                                "LDFLAGS=-fsanitize=address")))))
+    (inherit base)
+    (version version)
+    (source
+     (origin
+       (inherit (package-source base))
+       (uri (uri version))
+       (sha256 (base32 checksum))))))
 
-(define-public binutils-2.30-asan
-  (package
-    (inherit binutils-2.32-asan)
-    (version "2.30")
-    (source (origin
-              (inherit (package-source binutils))
-              (uri (string-append "mirror://gnu/binutils/binutils-"
-                                  version ".tar.bz2"))
-              (sha256
-               (base32 "028cklfqaab24glva1ks2aqa1zxa6w6xmc8q34zs1sb7h22dxspg"))
-              (patches '())))))
+(define (binutils-at-version base version checksum)
+  (at-version
+   (package
+     (inherit base)
+     (source
+      (origin
+        (inherit (package-source base))
+        (patches '()))))
+   version
+   (cut string-append "mirror://gnu/binutils/binutils-" <> ".tar.bz2")
+   checksum))
 
-(define-public binutils-2.29-asan
-  (package
-    (inherit binutils-2.32-asan)
-    (version "2.29")
-    (source (origin
-              (inherit (package-source binutils))
-              (uri (string-append "mirror://gnu/binutils/binutils-"
-                                  version ".tar.bz2"))
-              (sha256
-               (base32 "1gqfyksdnj3iir5gzyvlp785mnk60g1pll6zbzbslfchhr4rb8i9"))
-              (patches '())))))
+(define-public binutils-2.32
+  (binutils-at-version
+   binutils-2.33
+   "2.32"
+   "0b8767nyal1bc4cyzg5h9iis8kpkln1i3wkamig75cifj1fb2f6y"))
+
+(define-public binutils-2.30
+  (binutils-at-version
+   binutils-2.33
+   "2.30"
+   "028cklfqaab24glva1ks2aqa1zxa6w6xmc8q34zs1sb7h22dxspg"))
 
 (define-public binutils-2.29
-  (package
-    (inherit binutils-2.33)
-    (version "2.29")
-    (source (origin
-              (inherit (package-source binutils))
-              (uri (string-append "mirror://gnu/binutils/binutils-"
-                                  version ".tar.bz2"))
-              (sha256
-               (base32 "1gqfyksdnj3iir5gzyvlp785mnk60g1pll6zbzbslfchhr4rb8i9"))
-              (patches '())))))
+  (binutils-at-version
+   binutils-2.33
+   "2.29"
+   "1gqfyksdnj3iir5gzyvlp785mnk60g1pll6zbzbslfchhr4rb8i9"))
 
-(define-public binutils-2.27-asan
-  (package
-    (inherit binutils-2.29-asan)
-    (version "2.27")
-    (source (origin
-              (inherit (package-source binutils))
-              (uri (string-append "mirror://gnu/binutils/binutils-"
-                                  version ".tar.bz2"))
-              (sha256
-               (base32 "125clslv17xh1sab74343fg6v31msavpmaa1c1394zsqa773g5rn"))
-              (patches '())))))
+(define-public binutils-2.27
+  (binutils-at-version
+   binutils-2.33
+   "2.27"
+   "125clslv17xh1sab74343fg6v31msavpmaa1c1394zsqa773g5rn"))
 
-(define-public coreutils-8.27-asan
+(define (gnu-build-with-asan base)
   (package
-    (inherit coreutils)
-    (version "8.27")
-    (source (origin
-              (method url-fetch)
-              (uri (string-append "mirror://gnu/coreutils/coreutils-"
-                                  version ".tar.xz"))
-              (sha256
-               (base32
-                "0sv547572iq8ayy8klir4hnngnx92a9nsazmf1wgzfc7xr4x74c8"))
-              (patches
-               (search-patches "patches/coreutils-gnulib-glibc-2.28.patch"))))
+    (inherit base)
+    (name (string-append (package-name base) "-with-asan"))
     (arguments
-      (substitute-keyword-arguments (package-arguments coreutils)
-        ((#:make-flags flags #~'())
-         #~(cons* "CFLAGS=-O2 -g -fsanitize=address"
-                  "LDFLAGS=-fsanitize=address"
-                  #$flags))
-        ((#:phases phases #~%standard-phases)
-         #~(modify-phases #$phases
+     (substitute-keyword-arguments (package-arguments coreutils)
+       ((#:make-flags flags #~'())
+        (with-imported-modules '((loftix transform))
+          #~((@ (loftix transform) append-make-flag)
+             #$flags
+             '(("CFLAGS" "-fsanitize=address" "-O2 -g")
+               ("LDFLAGS" "-fsanitize=address")))))
+       ((#:phases phases #~%standard-phases)
+        #~(modify-phases #$phases
             (add-before 'build 'set-env
-             (lambda _ (setenv "ASAN_OPTIONS" "detect_leaks=0")))))
-        ((#:tests? _ #f)
-         #f)))))
+              (lambda _ (setenv "ASAN_OPTIONS" "detect_leaks=0")))))
+       ((#:tests? _ #f)
+        #f)))))
 
-(define-public coreutils-8.26-sans-4954f79-asan
-  (package
-    (inherit coreutils-8.27-asan)
-    (version "8.26")
-    (source (origin
-              (inherit (package-source coreutils-8.27-asan))
-              (method url-fetch)
-              (uri (string-append "mirror://gnu/coreutils/coreutils-"
-                                  version ".tar.xz"))
-              (sha256
-               (base32
-                "13lspazc7xkviy93qz7ks9jv4sldvgmwpq36ghrbrqpq93br8phm"))
-              (patches (cons (search-patch
-                              "patches/bugs/coreutils-unfix-bug-25003.patch")
-                             (origin-patches
-                              (package-source coreutils-8.27-asan))))))))
+(define-public binutils-with-asan-2.32 (gnu-build-with-asan binutils-2.32))
+(define-public binutils-with-asan-2.30 (gnu-build-with-asan binutils-2.30))
+(define-public binutils-with-asan-2.29 (gnu-build-with-asan binutils-2.29))
+(define-public binutils-with-asan-2.27 (gnu-build-with-asan binutils-2.27))
 
-(define-public coreutils-8.25-asan
+(define-public coreutils-8.27
   (package
-    (inherit coreutils-8.27-asan)
-    (version "8.25")
-    (source (origin
-              (method url-fetch)
-              (uri (string-append "mirror://gnu/coreutils/coreutils-"
-                                  version ".tar.xz"))
-              (sha256
-               (base32
-                "11yfrnb94xzmvi4lhclkcmkqsbhww64wf234ya1aacjvg82prrii"))
-              (patches (cons (search-patch
-                              "patches/coreutils-gnulib-glibc-2.25.patch")
-                             (origin-patches
-                               (package-source coreutils-8.27-asan))))))))
+    (inherit coreutils)
+    (version "8.27")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "mirror://gnu/coreutils/coreutils-" version
+                           ".tar.xz"))
+       (sha256 (base32 "0sv547572iq8ayy8klir4hnngnx92a9nsazmf1wgzfc7xr4x74c8"))
+       (patches (search-patches
+                 "patches/coreutils-gnulib-glibc-2.28.patch"))))))
+
+(define-public coreutils-with-asan-8.27 (gnu-build-with-asan coreutils-8.27))
 
-(define-public coreutils-8.23-asan
+(define (coreutils-at-version base version checksum)
+  (at-version
+   base
+   version
+   (cut string-append "mirror://gnu/coreutils/coreutils-" <> ".tar.xz")
+   checksum))
+
+(define-public coreutils-8.26
+  (coreutils-at-version
+   coreutils-8.27
+   "8.26"
+   "13lspazc7xkviy93qz7ks9jv4sldvgmwpq36ghrbrqpq93br8phm"))
+
+(define (with-patches base . patches)
   (package
-    (inherit coreutils-8.25-asan)
-    (version "8.23")
-    (source (origin
-              (inherit (package-source coreutils-8.25-asan))
-              (uri (string-append "mirror://gnu/coreutils/coreutils-"
-                                  version ".tar.xz"))
-              (sha256
-               (base32
-                "0bdq6yggyl7nkc2pbl6pxhhyx15nyqhz3ds6rfn448n6rxdwlhzc"))))
-    (arguments
-      (substitute-keyword-arguments (package-arguments coreutils-8.25-asan)
-        ((#:phases phases #~%standard-phases)
-         #~(modify-phases #$phases
-            (add-after 'install 'install-make-prime-list
-             (lambda* (#:key outputs #:allow-other-keys)
-               (install-file
-                "src/make-prime-list"
-                (string-append (assoc-ref outputs "out") "/bin"))))))))))
+    (inherit base)
+    (source
+     (origin
+       (inherit (package-source base))
+       (patches (append (origin-patches (package-source base))
+                        (map search-patch patches)))))))
+
+(define coreutils-8.26-sans-4954f79
+  (with-patches (package
+                  (inherit coreutils-8.26)
+                  (version "8.26-sans-4954f79"))
+                "patches/bugs/coreutils-unfix-bug-25003.patch"))
+
+(define-public coreutils-with-asan-8.26-sans-4954f79
+  (gnu-build-with-asan coreutils-8.26-sans-4954f79))
+
+(define-public coreutils-8.25
+  (with-patches
+   (coreutils-at-version
+    coreutils-8.27
+    "8.25"
+    "11yfrnb94xzmvi4lhclkcmkqsbhww64wf234ya1aacjvg82prrii")
+   "patches/coreutils-gnulib-glibc-2.25.patch"))
+
+(define-public coreutils-with-asan-8.25 (gnu-build-with-asan coreutils-8.25))
+
+(define-public coreutils-8.23
+  (coreutils-at-version
+    coreutils-8.25
+    "8.23"
+    "0bdq6yggyl7nkc2pbl6pxhhyx15nyqhz3ds6rfn448n6rxdwlhzc"))
+
+(define-public coreutils-with-make-prime-list-with-asan-8.23
+  (let ((base (gnu-build-with-asan coreutils-8.23)))
+    (package
+      (inherit base)
+      (name "coreutils-with-make-prime-list-with-asan")
+      (arguments
+        (substitute-keyword-arguments (package-arguments base)
+          ((#:phases phases #~%standard-phases)
+           #~(modify-phases #$phases
+              (add-after 'install 'install-make-prime-list
+               (lambda* (#:key outputs #:allow-other-keys)
+                 (install-file
+                  "src/make-prime-list"
+                  (string-append (assoc-ref outputs "out") "/bin")))))))))))
 
 (define-public jasper-1.900.19
   ;; FIXME: UBSan somehow breaks build phase.
diff --git a/loftix/transform.scm b/loftix/transform.scm
new file mode 100644
index 0000000..7eac95b
--- /dev/null
+++ b/loftix/transform.scm
@@ -0,0 +1,36 @@
+;;; Package transformations
+;;;
+;;; SPDX-FileCopyrightText: 2025 Nguyễn Gia Phong
+;;; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (loftix transform)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-1)
+  #:export (append-make-flag))
+
+(define (append-make-flag original additions)
+  (let ((orig-ls (map (lambda (flag)
+                        (let ((ls (string-split flag #\=)))
+                          (list (car ls)
+                                (string-join (cdr ls)
+                                             "="))))
+                      original)))
+    (receive (existing new) (partition (lambda (addition)
+                                         (assoc (car addition)
+                                                orig-ls))
+                                       additions)
+      (append (map (match-lambda
+                     ((name value)
+                      (match (assoc name existing)
+                        ((or (addition)
+                             (addition default))
+                         (string-append name "=" value " " addition))
+                        (else (string-append name "=" value)))))
+                   orig-ls)
+              (map (match-lambda
+                     ((name addition)
+                      (string-append name "=" addition))
+                     ((name addition default)
+                      (string-append name "=" default " " addition)))
+                   new)))))