Package QEMU for AFL++

2 files changed, 72 insertions, 0 deletions

diff --git a/loftix/emulation.scm b/loftix/emulation.scm
index 7796d71..0f7cbe2 100644
--- a/loftix/emulation.scm
+++ b/loftix/emulation.scm
@@ -15,6 +15,71 @@
   #:use-module (guix packages)
   #:use-module (guix utils))
 
+(define-public qemu-for-aflplusplus
+  (let ((base qemu-minimal)
+        (base-version "5.2.50")
+        (commit "c43dd6e0369cd5d2a2458f3bd7f4f58c8de53300")
+        (revision "master"))
+    (hidden-package
+     (package
+       (inherit base)
+       (synopsis "QEMU for AFL++")
+       (name "qemu-for-aflplusplus")
+       (version (git-version base-version revision commit))
+       (home-page "https://github.com/AFLplusplus/qemuafl")
+       (source
+        (origin
+          (method git-fetch)
+          (uri (git-reference (url home-page)
+                              (commit commit)
+                              (recursive? #t)))
+          (file-name (git-file-name name version))
+          (sha256
+           (base32 "1qhblmr3azmvzv15w4isxws8zm8jmxxmskmjhmwnn5899rr34p0g"))))
+       (arguments
+        (substitute-keyword-arguments (package-arguments base)
+          ((#:configure-flags _ #~'())
+           #~(list (string-append
+                    "--target-list="
+                    ;; AFL++ only supports using a single afl-qemu-trace,
+                    ;; so we only build qemu for the native target.
+                    (match #$(let-system system system)
+                      ("x86_64-linux"   "x86_64-linux-user")
+                      ("i686-linux"     "i386-linux-user")
+                      ("aarch64-linux"  "aarch64-linux-user")
+                      ("armhf-linux"    "arm-linux-user")
+                      ("mips64el-linux" "mips64el-linux-user")
+                      ("powerpc-linux"  "ppc-linux-user")
+                      ;; Prevent errors when querying this package
+                      ;; on unsupported platforms, e.g. when running
+                      ;; "guix search"
+                      (_                "")))))
+          ((#:phases phases)
+           #~(modify-phases #$phases
+               (delete 'replace-firmwares)
+               (delete 'patch-embedded-shebangs)
+               (delete 'fix-optionrom-makefile)
+               (delete 'disable-unusable-tests)
+               (replace 'configure
+                 (lambda* (#:key inputs outputs configure-flags
+                           #:allow-other-keys)
+                   ;; The `configure' script doesn't understand some of the
+                   ;; GNU options.  Thus, add a new phase that's compatible.
+                   (let ((out (assoc-ref outputs "out")))
+                     (setenv "SHELL" (which "bash"))
+                     ;; The binaries need to be linked against -lrt.
+                     (setenv "LDFLAGS" "-lrt")
+                     (apply invoke
+                            `("./configure"
+                              ,(string-append "--cc=" (which "gcc"))
+                              ;; Some architectures insist on using HOST_CC
+                              ,(string-append "--host-cc=" (which "gcc"))
+                              "--disable-debug-info" ; save build space
+                              ,(string-append "--prefix=" out)
+                              ,(string-append "--sysconfdir=/etc")
+                              ,@configure-flags)))))
+               (delete 'delete-firmwares)))))))))
+
 (define-public qemu-for-fuzzolic
   (let ((base qemu-minimal)
         (base-version "4.1.1")
diff --git a/loftix/fuzzing.scm b/loftix/fuzzing.scm
index 4624fdb..c715bbc 100644
--- a/loftix/fuzzing.scm
+++ b/loftix/fuzzing.scm
@@ -29,6 +29,13 @@
   #:use-module (loftix emulation)
   #:export (for-evocatio))
 
+(define-public afl++
+  (package
+    (inherit aflplusplus)
+    (name "afl++")
+    (inputs (modify-inputs (package-inputs aflplusplus)
+              (replace "qemu" qemu-for-aflplusplus)))))
+
 (define-public afl-dyninst
   (package
     (name "afl-dyninst")