gnu/packages/debug.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015, 2016, 2017 Eric Bavier <bavier@member.fsf.org>
   3 ;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
   4 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
   5 ;;; Copyright © 2018 Rutger Helling <rhelling@mykolab.com>
   6 ;;; Copyright © 2019 Pkill -9 <pkill9@runbox.com>
   7 ;;;
   8 ;;; This file is part of GNU Guix.
   9 ;;;
  10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  11 ;;; under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or (at
  13 ;;; your option) any later version.
  14 ;;;
  15 ;;; GNU Guix is distributed in the hope that it will be useful, but
  16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 (define-module (gnu packages debug)
  24   #:use-module (guix packages)
  25   #:use-module (guix licenses)
  26   #:use-module (guix download)
  27   #:use-module (guix git-download)
  28   #:use-module (guix utils)
  29   #:use-module (guix build-system gnu)
  30   #:use-module (gnu packages autotools)
  31   #:use-module (gnu packages base)
  32   #:use-module (gnu packages bash)
  33   #:use-module (gnu packages flex)
  34   #:use-module (gnu packages glib)
  35   #:use-module (gnu packages golang)
  36   #:use-module (gnu packages code)
  37   #:use-module (gnu packages llvm)
  38   #:use-module (gnu packages perl)
  39   #:use-module (gnu packages pretty-print)
  40   #:use-module (gnu packages readline)
  41   #:use-module (gnu packages virtualization)
  42   #:use-module (ice-9 match)
  43   #:use-module (srfi srfi-1))
  44
  45 (define-public delta
  46   (package
  47     (name "delta")
  48     (version "2006.08.03")
  49     (source
  50      (origin
  51       (method url-fetch)
  52       (uri (list
  53             (string-append "http://ftp.de.debian.org/debian/pool/main/d/delta/"
  54                            "delta_" version ".orig.tar.gz")
  55             ;; This uri seems to send guix download into an infinite loop
  56             (string-append "http://delta.tigris.org/files/documents/3103/"
  57                            "33566/delta-" version ".tar.gz")))
  58       (sha256
  59        (base32
  60         "184wh35pf2ddx97319s6sgkzpz48xxkbwzcjpycv009bm53lh61q"))))
  61     (build-system gnu-build-system)
  62     (inputs                             ;Installed programs are perl scripts
  63      `(("perl" ,perl)))
  64     (arguments
  65      `(#:phases
  66        (modify-phases %standard-phases
  67          (replace 'install
  68            (lambda* (#:key outputs #:allow-other-keys)
  69              ;; Makefile contains no install target
  70              (let* ((out (assoc-ref outputs "out"))
  71                     (bin (string-append out "/bin"))
  72                     (doc (string-append out "/share/doc/delta-" ,version)))
  73                (begin
  74                  (for-each (lambda (h)
  75                              (install-file h doc))
  76                            `("License.txt" ,@(find-files "www" ".*\\.html")))
  77                  (for-each (lambda (b)
  78                              (install-file b bin))
  79                            `("delta" "multidelta" "topformflat"))))
  80              #t))
  81          (delete 'configure))))         ; no configure script
  82     (home-page "http://delta.tigris.org/")
  83     (synopsis "Heuristical file minimizer")
  84     (description
  85      "Delta assists you in minimizing \"interesting\" files subject to a test
  86 of their interestingness.  A common such situation is when attempting to
  87 isolate a small failure-inducing substring of a large input that causes your
  88 program to exhibit a bug.")
  89     ;; See License.txt, which is a bsd-3 license, despite the project's
  90     ;; home-page pointing to a bsd-2 license.
  91     (license bsd-3)))
  92
  93 ;; Newer versions depend on LLVM and Clang >= 4, which have yet to be packaged.
  94 (define-public c-reduce
  95   (package
  96     (name "c-reduce")
  97     (version "2.6.0")
  98     (source
  99      (origin
 100       (method url-fetch)
 101       (uri (list
 102             (string-append "http://embed.cs.utah.edu/creduce/"
 103                            "creduce-" version ".tar.gz")))
 104       (sha256
 105        (base32
 106         "0pf5q0n8vkdcr1wrkxn2jzxv0xkrir13bwmqfw3jpbm3dh2c3b6d"))))
 107     (build-system gnu-build-system)
 108     (inputs
 109      `(("astyle"          ,astyle)
 110        ("llvm"            ,llvm-3.9.1)
 111        ("clang"           ,clang-3.9.1)
 112        ("flex"            ,flex)
 113        ("indent"          ,indent)
 114        ("perl"            ,perl)
 115        ("exporter-lite"   ,perl-exporter-lite)
 116        ("file-which"      ,perl-file-which)
 117        ("getopt-tabular"  ,perl-getopt-tabular)
 118        ("regex-common"    ,perl-regexp-common)
 119        ("sys-cpu"         ,perl-sys-cpu)
 120        ("term-readkey"    ,perl-term-readkey)))
 121     (arguments
 122      `(#:phases
 123        (modify-phases %standard-phases
 124          (add-after 'install 'set-load-paths
 125            (lambda* (#:key inputs outputs #:allow-other-keys)
 126              ;; Tell creduce where to find the perl modules it needs.
 127              (let* ((out (assoc-ref outputs "out"))
 128                     (prog (string-append out "/bin/creduce")))
 129                (wrap-program
 130                    prog
 131                  `("PERL5LIB" ":" prefix
 132                    ,(map (lambda (p)
 133                            (string-append (assoc-ref inputs p)
 134                                           "/lib/perl5/site_perl/"
 135                                           ,(package-version perl)))
 136                          '("term-readkey"    "exporter-lite"
 137                            "file-which"      "getopt-tabular"
 138                            "regex-common"    "sys-cpu")))))
 139              #t)))))
 140     (home-page "https://embed.cs.utah.edu/creduce")
 141     (synopsis "Reducer for interesting code")
 142     (description
 143      "C-Reduce is a tool that takes a large C or C++ program that has a
 144 property of interest (such as triggering a compiler bug) and automatically
 145 produces a much smaller C/C++ program that has the same property.  It is
 146 intended for use by people who discover and report bugs in compilers and other
 147 tools that process C/C++ code.")
 148     (license ncsa)))
 149
 150 (define-public american-fuzzy-lop
 151   (let ((machine (match (or (%current-target-system)
 152                             (%current-system))
 153                    ("x86_64-linux"   "x86_64")
 154                    ("i686-linux"     "i386")
 155                    ("aarch64-linux"  "aarch64")
 156                    ("armhf-linux"    "arm")
 157                    ("mips64el-linux" "mips64el")
 158                    ;; Prevent errors when querying this package on unsupported
 159                    ;; platforms, e.g. when running "guix package --search="
 160                    (_                "UNSUPPORTED"))))
 161     (package
 162       (name "american-fuzzy-lop")
 163       (version "2.52b")             ;It seems all releases have the 'b' suffix
 164       (source
 165        (origin
 166          (method url-fetch)
 167          (uri (string-append "http://lcamtuf.coredump.cx/afl/releases/"
 168                              "afl-" version ".tgz"))
 169          (sha256
 170           (base32
 171            "0ig0ij4n1pwry5dw1hk4q88801jzzy2cric6y2gd6560j55lnqa3"))))
 172       (build-system gnu-build-system)
 173       (inputs
 174        `(("custom-qemu"
 175           ;; The afl-qemu tool builds qemu 2.10.0 with a few patches applied.
 176           ,(package (inherit qemu-minimal-2.10)
 177              (name "afl-qemu")
 178              (inputs
 179               `(("afl-src" ,source)
 180                 ,@(package-inputs qemu-minimal)))
 181              ;; afl only supports using a single afl-qemu-trace executable, so
 182              ;; we only build qemu for the native target.
 183              (arguments
 184               `(#:modules ((srfi srfi-1)
 185                            ,@%gnu-build-system-modules)
 186                 ,@(substitute-keyword-arguments (package-arguments qemu-minimal)
 187                     ((#:configure-flags config-flags)
 188                      ``(,(string-append "--target-list=" ,machine "-linux-user")
 189                         ,@(remove (λ (f) (string-prefix? "--target-list=" f))
 190                                   ,config-flags)))
 191                     ((#:phases qemu-phases)
 192                      `(modify-phases ,qemu-phases
 193                         (add-after
 194                          'unpack 'apply-afl-patches
 195                          (lambda* (#:key inputs #:allow-other-keys)
 196                            (let* ((afl-dir (string-append "afl-" ,version))
 197                                   (patch-dir
 198                                    (string-append afl-dir
 199                                                   "/qemu_mode/patches")))
 200                              (invoke "tar" "xf"
 201                                      (assoc-ref inputs "afl-src"))
 202                              (install-file (string-append patch-dir
 203                                                           "/afl-qemu-cpu-inl.h")
 204                                            ".")
 205                              (copy-file (string-append afl-dir "/config.h")
 206                                         "./afl-config.h")
 207                              (install-file (string-append afl-dir "/types.h")
 208                                            ".")
 209                              (substitute* "afl-qemu-cpu-inl.h"
 210                                (("\\.\\./\\.\\./config.h") "afl-config.h"))
 211                              (substitute* (string-append patch-dir
 212                                                          "/cpu-exec.diff")
 213                                (("\\.\\./patches/") ""))
 214                              (for-each (lambda (patch-file)
 215                                          (invoke "patch" "--force" "-p1"
 216                                                  "--input" patch-file))
 217                                        (find-files patch-dir
 218                                                    "\\.diff$"))
 219                              #t))))))))))))
 220       (arguments
 221        `(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
 222                             "CC=gcc")
 223          #:phases (modify-phases %standard-phases
 224                     (delete 'configure)
 225                     ,@(if (string=? (%current-system) (or "x86_64-linux"
 226                                                           "i686-linux"))
 227                         '()
 228                         '((add-before 'build 'set-afl-flag
 229                             (lambda _ (setenv "AFL_NO_X86" "1") #t))
 230                           (add-after 'install 'remove-x86-programs
 231                             (lambda* (#:key outputs #:allow-other-keys)
 232                               (let* ((out (assoc-ref outputs "out"))
 233                                      (bin (string-append out "/bin/")))
 234                                 (delete-file (string-append bin "afl-gcc"))
 235                                 (delete-file (string-append bin "afl-g++"))
 236                                 (delete-file (string-append bin "afl-clang"))
 237                                 (delete-file (string-append bin "afl-clang++")))
 238                               #t))))
 239                     (add-after
 240                      ;; TODO: Build and install the afl-llvm tool.
 241                      'install 'install-qemu
 242                      (lambda* (#:key inputs outputs #:allow-other-keys)
 243                        (let ((qemu (assoc-ref inputs "custom-qemu"))
 244                              (out  (assoc-ref outputs "out")))
 245                          (symlink (string-append qemu "/bin/qemu-" ,machine)
 246                                   (string-append out "/bin/afl-qemu-trace"))
 247                          #t)))
 248                     (delete 'check)))) ; Tests are run during 'install phase.
 249       (home-page "http://lcamtuf.coredump.cx/afl")
 250       (synopsis "Security-oriented fuzzer")
 251       (description
 252        "American fuzzy lop is a security-oriented fuzzer that employs a novel
 253 type of compile-time instrumentation and genetic algorithms to automatically
 254 discover clean, interesting test cases that trigger new internal states in the
 255 targeted binary.  This substantially improves the functional coverage for the
 256 fuzzed code.  The compact synthesized corpora produced by the tool are also
 257 useful for seeding other, more labor- or resource-intensive testing regimes
 258 down the road.")
 259       (license asl2.0))))
 260
 261 (define-public stress-make
 262   (let ((commit "506e6cfd98d165f22bee91c408b7c20117a682c4")
 263         (revision "0"))                 ;No official source distribution
 264     (package
 265       (name "stress-make")
 266       (version (string-append "1.0-" revision "." (string-take commit 7)))
 267       (source
 268        (origin
 269          (method git-fetch)
 270          (uri (git-reference
 271                (url "https://github.com/losalamos/stress-make.git")
 272                (commit commit)))
 273          (file-name (string-append name "-" version "-checkout"))
 274          (sha256
 275           (base32
 276            "1j330yqhc7plwin04qxbh8afpg5nfnw1xvnmh8rk6mmqg9w6ik70"))))
 277       (build-system gnu-build-system)
 278       (native-inputs
 279        `(("autoconf" ,autoconf)
 280          ("automake" ,automake)
 281          ("go" ,go)))
 282       (inputs
 283        `(("make-source" ,(package-source gnu-make))))
 284       (arguments
 285        ;; stress-make's configure script insists on having a tarball and does
 286        ;; not accept a directory name instead.  To let the gnu-build-system's
 287        ;; patch-* phases work properly, we unpack the source first, then
 288        ;; repack before the configure phase.
 289        (let ((make-dir (string-append "make-" (package-version gnu-make))))
 290          `(#:configure-flags '("--with-make-tar=./make.tar.xz"
 291                                "make_cv_sys_gnu_glob=yes")
 292            #:phases
 293            (modify-phases %standard-phases
 294              (add-after 'unpack 'unpack-make
 295                (lambda* (#:key inputs #:allow-other-keys)
 296                  (invoke "tar" "xf" (assoc-ref inputs "make-source"))))
 297              (add-after 'unpack-make 'set-default-shell
 298                (lambda _
 299                  ;; Taken mostly directly from (@ (gnu packages base) gnu-make)
 300                  (substitute* (string-append ,make-dir "/job.c")
 301                    (("default_shell = .*$")
 302                     (format #f "default_shell = \"~a\";\n"
 303                             (which "sh"))))))
 304              (add-before 'configure 'repack-make
 305                (lambda _
 306                  (invoke "tar" "cJf" "./make.tar.xz" ,make-dir)))))))
 307       (home-page "https://github.com/losalamos/stress-make")
 308       (synopsis "Expose race conditions in Makefiles")
 309       (description
 310        "Stress Make is a customized GNU Make that explicitely manages the order
 311 in which concurrent jobs are run to provoke erroneous behavior into becoming
 312 manifest.  It can run jobs in the order in which they're launched, in backwards
 313 order, or in random order.  The thought is that if code builds correctly with
 314 Stress Make, then it is likely that the @code{Makefile} contains no race
 315 conditions.")
 316       ;; stress-make wrapper is under BSD-3-modifications-must-be-indicated,
 317       ;; and patched GNU Make is under its own license.
 318       (license (list (non-copyleft "COPYING.md")
 319                      (package-license gnu-make))))))
 320
 321 (define-public zzuf
 322   (package
 323     (name "zzuf")
 324     (version "0.15")
 325     (source
 326      (origin
 327        (method url-fetch)
 328        (uri (string-append
 329              "https://github.com/samhocevar/zzuf/releases/download/v"
 330              version "/" name "-" version ".tar.gz"))
 331        (file-name (string-append name "-" version ".tar.gz"))
 332        (sha256
 333         (base32
 334          "1mpzjaksc2qg2hzqflf39pl06p53qam2dn3hkhkcv6p00d2n4kx3"))))
 335     (build-system gnu-build-system)
 336     (home-page "https://github.com/samhocevar/zzuf")
 337     (synopsis "Transparent application input fuzzer")
 338     (description "Zzuf is a transparent application input fuzzer.  It works by
 339 intercepting file operations and changing random bits in the program's
 340 input.  Zzuf's behaviour is deterministic, making it easy to reproduce bugs.")
 341     (license (non-copyleft "http://www.wtfpl.net/txt/copying/"))))
 342
 343 (define-public scanmem
 344   (package
 345     (name "scanmem")
 346     (version "0.17")
 347     (source
 348      (origin
 349        (method git-fetch)
 350        (uri (git-reference
 351              (url "https://github.com/scanmem/scanmem")
 352              (commit (string-append "v" version))))
 353        (file-name (git-file-name name version))
 354        (sha256
 355         (base32
 356          "17p8sh0rj8yqz36ria5bp48c8523zzw3y9g8sbm2jwq7sc27i7s9"))))
 357     (build-system gnu-build-system)
 358     (native-inputs
 359      `(("libtool" ,libtool)
 360        ("intltool" ,intltool)
 361        ("automake" ,automake)
 362        ("autoconf" ,autoconf)))
 363     (inputs
 364      `(("readline" ,readline)))
 365     (home-page "https://github.com/scanmem/scanmem")
 366     (synopsis "Memory scanner")
 367     (description "Scanmem is a debugging utility designed to isolate the
 368 address of an arbitrary variable in an executing process.  Scanmem simply
 369 needs to be told the pid of the process and the value of the variable at
 370 several different times.  After several scans of the process, scanmem isolates
 371 the position of the variable and allows you to modify its value.")
 372     ;; The library is covered by LGPLv3 or later; the application is covered
 373     ;; by GPLv3 or later.
 374     (license (list lgpl3+ gpl3+))))