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