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