gnu/packages/backup.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
   3 ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
   4 ;;; Copyright © 2015, 2016, 2017 Leo Famulari <leo@famulari.name>
   5 ;;; Copyright © 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
   6 ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
   7 ;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
   8 ;;; Copyright © 2017 Kei Kebreau <kkebreau@posteo.net>
   9 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
  10 ;;; Copyright © 2017 Christopher Allan Webber <cwebber@dustycloud.org>
  11 ;;; Copyright © 2017 Rutger Helling <rhelling@mykolab.com>
  12 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
  13 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
  14 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
  15 ;;; Copyright © 2019 Alex Vong <alexvong1995@gmail.com>
  16 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
  17 ;;;
  18 ;;; This file is part of GNU Guix.
  19 ;;;
  20 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  21 ;;; under the terms of the GNU General Public License as published by
  22 ;;; the Free Software Foundation; either version 3 of the License, or (at
  23 ;;; your option) any later version.
  24 ;;;
  25 ;;; GNU Guix is distributed in the hope that it will be useful, but
  26 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  27 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  28 ;;; GNU General Public License for more details.
  29 ;;;
  30 ;;; You should have received a copy of the GNU General Public License
  31 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  32
  33 (define-module (gnu packages backup)
  34   #:use-module (guix packages)
  35   #:use-module ((guix licenses) #:prefix license:)
  36   #:use-module (guix git-download)
  37   #:use-module (guix download)
  38   #:use-module (guix utils)
  39   #:use-module (guix build-system gnu)
  40   #:use-module (guix build-system go)
  41   #:use-module (guix build-system python)
  42   #:use-module (gnu packages)
  43   #:use-module (gnu packages acl)
  44   #:use-module (gnu packages autotools)
  45   #:use-module (gnu packages base)
  46   #:use-module (gnu packages check)
  47   #:use-module (gnu packages compression)
  48   #:use-module (gnu packages crypto)
  49   #:use-module (gnu packages databases)
  50   #:use-module (gnu packages datastructures)
  51   #:use-module (gnu packages dbm)
  52   #:use-module (gnu packages dejagnu)
  53   #:use-module (gnu packages ftp)
  54   #:use-module (gnu packages glib)
  55   #:use-module (gnu packages gnupg)
  56   #:use-module (gnu packages golang)
  57   #:use-module (gnu packages gperf)
  58   #:use-module (gnu packages guile)
  59   #:use-module (gnu packages linux)
  60   #:use-module (gnu packages mcrypt)
  61   #:use-module (gnu packages nettle)
  62   #:use-module (gnu packages onc-rpc)
  63   #:use-module (gnu packages pcre)
  64   #:use-module (gnu packages perl)
  65   #:use-module (gnu packages pkg-config)
  66   #:use-module (gnu packages python)
  67   #:use-module (gnu packages python-crypto)
  68   #:use-module (gnu packages python-web)
  69   #:use-module (gnu packages python-xyz)
  70   #:use-module (gnu packages rsync)
  71   #:use-module (gnu packages ssh)
  72   #:use-module (gnu packages tls)
  73   #:use-module (gnu packages xml))
  74
  75 (define-public duplicity
  76   (package
  77     (name "duplicity")
  78     (version "0.7.19")
  79     (source
  80      (origin
  81       (method url-fetch)
  82       (uri (string-append "https://code.launchpad.net/duplicity/"
  83                           (version-major+minor version)
  84                           "-series/" version "/+download/duplicity-"
  85                           version ".tar.gz"))
  86       (sha256
  87        (base32 "0ag9dknslxlasslwfjhqgcqbkb1mvzzx93ry7lch2lfzcdd91am6"))))
  88     (build-system python-build-system)
  89     (native-inputs
  90      `(("util-linux" ,util-linux)       ; setsid command, for the tests
  91        ("par2cmdline" ,par2cmdline)
  92        ("python-pexpect" ,python2-pexpect)
  93        ("python-fasteners" ,python2-fasteners)
  94        ("tzdata" ,tzdata-for-tests)
  95        ("mock" ,python2-mock)))
  96     (propagated-inputs
  97      `(("lockfile" ,python2-lockfile)
  98        ("urllib3" ,python2-urllib3)))
  99     (inputs
 100      `(("librsync" ,librsync-0.9)
 101        ("lftp" ,lftp)
 102        ("gnupg" ,gnupg)                 ; gpg executable needed
 103        ("util-linux" ,util-linux)))     ; for setsid
 104     (arguments
 105      `(#:python ,python-2               ; setup assumes Python 2
 106        #:test-target "test"
 107        #:phases
 108        (modify-phases %standard-phases
 109          (add-before 'build 'use-store-file-names
 110            (lambda* (#:key inputs #:allow-other-keys)
 111              (substitute* "duplicity/gpginterface.py"
 112                (("self.call = 'gpg'")
 113                 (string-append "self.call = '" (assoc-ref inputs "gnupg") "/bin/gpg'")))
 114
 115              (substitute* '("testing/functional/__init__.py"
 116                             "testing/overrides/bin/lftp")
 117                (("/bin/sh") (which "sh")))
 118              #t))
 119          (add-before 'check 'check-setup
 120            (lambda* (#:key inputs #:allow-other-keys)
 121              (setenv "HOME" (getcwd))   ; gpg needs to write to $HOME
 122              (setenv "TZDIR"            ; some timestamp checks need TZDIR
 123                      (string-append (assoc-ref inputs "tzdata")
 124                                     "/share/zoneinfo"))
 125              #t)))))
 126     (home-page "http://duplicity.nongnu.org/index.html")
 127     (synopsis "Encrypted backup using rsync algorithm")
 128     (description
 129      "Duplicity backs up directories by producing encrypted tar-format volumes
 130 and uploading them to a remote or local file server.  Because duplicity uses
 131 librsync, the incremental archives are space efficient and only record the
 132 parts of files that have changed since the last backup.  Because duplicity
 133 uses GnuPG to encrypt and/or sign these archives, they will be safe from
 134 spying and/or modification by the server.")
 135     (license license:gpl2+)))
 136
 137 (define-public par2cmdline
 138   (package
 139     (name "par2cmdline")
 140     (version "0.8.0")
 141     (source (origin
 142               (method git-fetch)
 143               (uri (git-reference
 144                     (url "https://github.com/Parchive/par2cmdline.git")
 145                     (commit (string-append "v" version))))
 146               (file-name (git-file-name name version))
 147               (sha256
 148                (base32
 149                 "0f1jsd5sw2wynjzi7yjqjaf13yhyjfdid91p8yh0jn32y03kjyrz"))))
 150     (native-inputs
 151      `(("automake" ,automake)
 152        ("autoconf" ,autoconf)))
 153     (build-system gnu-build-system)
 154     (synopsis "File verification and repair tools")
 155     (description "Par2cmdline uses Reed-Solomon error-correcting codes to
 156 generate and verify PAR2 recovery files.  These files can be distributed
 157 alongside the source files or stored together with back-ups to protect against
 158 transmission errors or @dfn{bit rot}, the degradation of storage media over
 159 time.
 160 Unlike a simple checksum, PAR2 doesn't merely detect errors: as long as the
 161 damage isn't too extensive (and smaller than the size of the recovery file), it
 162 can even repair them.")
 163     (home-page "https://github.com/Parchive/par2cmdline")
 164     (license license:gpl3+)))
 165
 166 (define-public hdup
 167   (package
 168     (name "hdup")
 169     (version "2.0.14")
 170     (source
 171      (origin
 172       (method url-fetch)
 173       (uri "https://fossies.org/linux/privat/old/hdup-2.0.14.tar.bz2")
 174       (sha256
 175        (base32
 176         "02bnczg01cyhajmm4rhbnc0ja0dd9ikv9fwv28asxh1rlx9yr0b7"))))
 177     (build-system gnu-build-system)
 178     (native-inputs `(("pkg-config" ,pkg-config)))
 179     (inputs
 180      `(("glib" ,glib)
 181        ("tar" ,tar)
 182        ("lzop" ,lzop)
 183        ("mcrypt" ,mcrypt)
 184        ("openssh" ,openssh)
 185        ("gnupg" ,gnupg-1)))
 186     (arguments
 187      `(#:configure-flags
 188        `(,(string-append "--sbindir=" (assoc-ref %outputs "out") "/bin"))
 189        #:tests? #f))
 190     (home-page (string-append "http://web.archive.org/web/20150925223424/"
 191                               "http://archive.miek.nl/projects/hdup/index.html"))
 192     (synopsis "Simple incremental backup tool")
 193     (description
 194      "Hdup2 is a backup utility, its aim is to make backup really simple.  The
 195 backup scheduling is done by means of a cron job.  It supports an
 196 include/exclude mechanism, remote backups, encrypted backups and split
 197 backups (called chunks) to allow easy burning to CD/DVD.")
 198     (license license:gpl2)))
 199
 200 (define-public libarchive
 201   (package
 202     (name "libarchive")
 203     (version "3.4.0")
 204     (source
 205      (origin
 206        (method url-fetch)
 207        (uri (list (string-append "https://libarchive.org/downloads/libarchive-"
 208                                  version ".tar.gz")
 209                   (string-append "https://github.com/libarchive/libarchive"
 210                                  "/releases/download/v" version "/libarchive-"
 211                                  version ".tar.gz")))
 212        (sha256
 213         (base32
 214          "0pl25mmz1b1cnwf35kxmygyy9g7z7hslxbx329a9yx8csh7dahw6"))))
 215     (build-system gnu-build-system)
 216     (inputs
 217      `(("bzip2" ,bzip2)
 218        ("libxml2" ,libxml2)
 219        ("lzo" ,lzo)
 220        ("nettle" ,nettle)
 221        ("xz" ,xz)
 222        ("zlib" ,zlib)
 223        ("zstd" ,zstd "lib")))
 224     (arguments
 225      `(#:configure-flags '("--disable-static")
 226        #:phases
 227        (modify-phases %standard-phases
 228          (add-before 'build 'patch-pwd
 229            (lambda _
 230              (substitute* "Makefile"
 231                (("/bin/pwd") (which "pwd")))
 232              #t))
 233          (replace 'check
 234            (lambda _
 235              ;; XXX: The test_owner_parse, test_read_disk, and
 236              ;; test_write_disk_lookup tests expect user 'root' to exist, but
 237              ;; the chroot's /etc/passwd doesn't have it.  Turn off those tests.
 238              ;;
 239              ;; XXX: Adjust test that fails with zstd 1.4.1 because the default
 240              ;; options compresses two bytes better than this test expects.
 241              ;; https://github.com/libarchive/libarchive/issues/1226
 242              (substitute* "libarchive/test/test_write_filter_zstd.c"
 243                (("compression-level\", \"6\"")
 244                 "compression-level\", \"7\""))
 245
 246              ;; The tests allow one to disable tests matching a globbing pattern.
 247              (invoke "make" "libarchive_test" "bsdcpio_test" "bsdtar_test")
 248              ;; XXX: This glob disables too much.
 249              (invoke "./libarchive_test" "^test_*_disk*")
 250              (invoke "./bsdcpio_test" "^test_owner_parse")
 251              (invoke "./bsdtar_test")))
 252          (add-after 'install 'add--L-in-libarchive-pc
 253            (lambda* (#:key inputs outputs #:allow-other-keys)
 254              (let* ((out     (assoc-ref outputs "out"))
 255                     (lib     (string-append out "/lib"))
 256                     (nettle  (assoc-ref inputs "nettle"))
 257                     (libxml2 (assoc-ref inputs "libxml2"))
 258                     (xz      (assoc-ref inputs "xz"))
 259                     (zlib    (assoc-ref inputs "zlib"))
 260                     (zstd    (assoc-ref inputs "zstd"))
 261                     (bzip2   (assoc-ref inputs "bzip2")))
 262                ;; Embed absolute references to these inputs to avoid propagation.
 263                (substitute* (list (string-append lib "/pkgconfig/libarchive.pc")
 264                                   (string-append lib "/libarchive.la"))
 265                  (("-lnettle")
 266                   (string-append "-L" nettle "/lib -lnettle"))
 267                  (("-lxml2")
 268                   (string-append "-L" libxml2 "/lib -lxml2"))
 269                  (("-llzma")
 270                   (string-append "-L" xz "/lib -llzma"))
 271                  (("-lz")
 272                   (string-append "-L" zlib "/lib -lz"))
 273                  (("-lzstd")
 274                   (string-append "-L" zstd "/lib -lzstd"))
 275                  (("-lbz2")
 276                   (string-append "-L" bzip2 "/lib -lbz2")))
 277                #t))))))
 278     (home-page "https://libarchive.org/")
 279     (synopsis "Multi-format archive and compression library")
 280     (description
 281      "Libarchive provides a flexible interface for reading and writing
 282 archives in various formats such as tar and cpio.  Libarchive also supports
 283 reading and writing archives compressed using various compression filters such
 284 as gzip and bzip2.  The library is inherently stream-oriented; readers
 285 serially iterate through the archive, writers serially add things to the
 286 archive.  In particular, note that there is currently no built-in support for
 287 random access nor for in-place modification.")
 288     (license license:bsd-2)))
 289
 290 (define-public rdup
 291   (package
 292     (name "rdup")
 293     (version "1.1.15")
 294     (source
 295      (origin
 296        (method git-fetch)
 297        (uri (git-reference
 298              (url "https://github.com/miekg/rdup.git")
 299              (commit version)))
 300        (file-name (git-file-name name version))
 301        (sha256
 302         (base32 "0bzyv6qmnivxnv9nw7lnfn46k0m1dlxcjj53zcva6v8y8084l1iw"))))
 303     (build-system gnu-build-system)
 304     (native-inputs
 305      `(("autoconf" ,autoconf)
 306        ("automake" ,automake)
 307        ("pkg-config" ,pkg-config)
 308
 309        ;; For tests.
 310        ("dejagnu" ,dejagnu)))
 311     (inputs
 312      ;; XXX Compiling with nettle (encryption) support requires patching out
 313      ;; -Werror from GNUmakefile.in.  Then, rdup-tr-{en,de}crypt tests fail:
 314      ;; free(): invalid pointer
 315      ;; ** rdup-tr: SIGPIPE received, exiting
 316      `(("glib" ,glib)
 317        ("pcre" ,pcre)
 318        ("libarchive" ,libarchive)
 319        ("mcrypt" ,mcrypt)))
 320     (arguments
 321      `(#:parallel-build? #f             ;race conditions
 322        #:phases
 323        (modify-phases %standard-phases
 324          (add-before 'build 'qualify-inputs
 325            (lambda* (#:key inputs #:allow-other-keys)
 326              ;; This script is full of pitfalls.  Fix some that particularly
 327              ;; affect Guix users & leave the rest as reader excercises.
 328              (substitute* "rdup-simple"
 329                ;; Use the input ‘mcrypt’, not whatever's in $PATH at run time.
 330                (("([' ])mcrypt " all delimiter)
 331                 (string-append delimiter (which "mcrypt") " "))
 332                ;; Avoid frivolous dependency on ‘which’ with a shell builtin.
 333                (("which") "command -v"))
 334              #t))
 335          (add-before 'check 'disable-encryption-tests
 336            (lambda _
 337              (for-each delete-file
 338                        (list "testsuite/rdup/rdup.rdup-tr-crypt.exp"
 339                              "testsuite/rdup/rdup.rdup-tr-decrypt.exp"
 340                              "testsuite/rdup/rdup.rdup-tr-encrypt.exp"))
 341              #t))
 342          (add-before 'check 'pre-check
 343            (lambda _
 344              (setenv "HOME" (getcwd))
 345              (substitute* "testsuite/rdup/rdup.rdup-up-t-with-file.exp"
 346                (("/bin/cat") (which "cat")))
 347              #t)))))
 348     (home-page "https://github.com/miekg/rdup")
 349     (synopsis "Provide a list of files to backup")
 350     (description
 351      "Rdup is a utility inspired by rsync and the plan9 way of doing backups.
 352 Rdup itself does not backup anything, it only print a list of absolute
 353 file names to standard output.  Auxiliary scripts are needed that act on this
 354 list and implement the backup strategy.")
 355     (license license:gpl3+)))
 356
 357 (define-public btar
 358   (package
 359     (name "btar")
 360     (version "1.1.1")
 361     (source
 362      (origin
 363        (method url-fetch)
 364        (uri (string-append "http://vicerveza.homeunix.net/~viric/soft/btar/"
 365                            "btar-" version ".tar.gz"))
 366        (sha256
 367         (base32
 368          "0miklk4bqblpyzh1bni4x6lqn88fa8fjn15x1k1n8bxkx60nlymd"))))
 369     (build-system gnu-build-system)
 370     (inputs
 371      `(("librsync" ,librsync-0.9)))
 372     (arguments
 373      `(#:make-flags `(,(string-append "PREFIX=" (assoc-ref %outputs "out"))
 374                       "CC=gcc")
 375        #:tests? #f                      ;test input not distributed
 376        #:phases
 377        ;; no configure phase
 378        (modify-phases %standard-phases
 379          (delete 'configure))))
 380     (home-page "http://viric.name/cgi-bin/btar/doc/trunk/doc/home.wiki")
 381     (synopsis "Tar-compatible archiver")
 382     (description
 383      "Btar is a tar-compatible archiver which allows arbitrary compression and
 384 ciphering, redundancy, differential backup, indexed extraction, multicore
 385 compression, input and output serialisation, and tolerance to partial archive
 386 errors.")
 387     (license license:gpl3+)))
 388
 389 (define-public rdiff-backup
 390   (package
 391     (name "rdiff-backup")
 392     (version "1.2.8")
 393     (source
 394      (origin
 395        (method url-fetch)
 396        (uri (string-append "mirror://savannah/rdiff-backup/rdiff-backup-"
 397                            version ".tar.gz"))
 398        (sha256
 399         (base32
 400          "1nwmmh816f96h0ff1jxk95ad38ilbhbdl5dgibx1d4cl81dsi48d"))))
 401     (build-system python-build-system)
 402     (inputs
 403      `(("python" ,python-2)
 404        ("librsync" ,librsync-0.9)))
 405     (arguments
 406      `(#:python ,python-2
 407        #:tests? #f))
 408     (home-page "https://www.nongnu.org/rdiff-backup/")
 409     (synopsis "Local/remote mirroring+incremental backup")
 410     (description
 411      "Rdiff-backup backs up one directory to another, possibly over a network.
 412 The target directory ends up a copy of the source directory, but extra reverse
 413 diffs are stored in a special subdirectory of that target directory, so you
 414 can still recover files lost some time ago.  The idea is to combine the best
 415 features of a mirror and an incremental backup.  Rdiff-backup also preserves
 416 subdirectories, hard links, dev files, permissions, uid/gid ownership,
 417 modification times, extended attributes, acls, and resource forks.  Also,
 418 rdiff-backup can operate in a bandwidth efficient manner over a pipe, like
 419 rsync.  Thus you can use rdiff-backup and ssh to securely back a hard drive up
 420 to a remote location, and only the differences will be transmitted.  Finally,
 421 rdiff-backup is easy to use and settings have sensible defaults.")
 422     (license license:gpl2+)))
 423
 424 (define-public rsnapshot
 425   (package
 426     (name "rsnapshot")
 427     (version "1.4.3")
 428     (source
 429      (origin
 430        (method url-fetch)
 431        (uri (string-append
 432              "https://github.com/rsnapshot/rsnapshot/releases/download/"
 433              version "/rsnapshot-" version ".tar.gz"))
 434        (sha256
 435         (base32 "1lavqmmsf53pim0nvming7fkng6p0nk2a51k2c2jdq0l7snpl31b"))))
 436     (build-system gnu-build-system)
 437     (arguments
 438      `(#:phases
 439        (modify-phases %standard-phases
 440          (replace 'check
 441            (lambda _
 442              (substitute* '("t/cmd-post_pre-exec/conf/pre-true-post-true.conf"
 443                             "t/backup_exec/conf/backup_exec_fail.conf"
 444                             "t/backup_exec/conf/backup_exec.conf")
 445                (("/bin/true") (which "true"))
 446                (("/bin/false") (which "false")))
 447
 448              ;; Disable a test that tries to connect to localhost on port 22.
 449              (delete-file "t/ssh_args/ssh_args.t.in")
 450
 451              (invoke "make" "test"))))))
 452     (inputs
 453      `(("perl" ,perl)
 454        ("rsync" ,rsync)))
 455     (home-page "https://rsnapshot.org")
 456     (synopsis "Deduplicating snapshot backup utility based on rsync")
 457     (description "rsnapshot is a file system snapshot utility based on rsync.
 458 rsnapshot makes it easy to make periodic snapshots of local machines, and
 459 remote machines over SSH.  To reduce the disk space required for each backup,
 460 rsnapshot uses hard links to deduplicate identical files.")
 461     (license license:gpl2+)))
 462
 463 (define-public libchop
 464   (package
 465     (name "libchop")
 466     (version "0.5.2")
 467     (source (origin
 468               (method url-fetch)
 469               (uri (string-append "mirror://savannah/libchop/libchop-"
 470                                   version ".tar.gz"))
 471               (sha256
 472                (base32
 473                 "0fpdyxww41ba52d98blvnf543xvirq1v9xz1i3x1gm9lzlzpmc2g"))
 474               (patches (search-patches "diffutils-gets-undeclared.patch"))
 475               (modules '((guix build utils)))
 476               (snippet
 477                '(begin
 478                   ;; Include all the libtirpc headers necessary to get the
 479                   ;; definitions of 'u_int', etc.
 480                   (substitute* '("src/block-server.c"
 481                                  "include/chop/block-server.h"
 482                                  "utils/chop-block-server.c")
 483                     (("#include <rpc/(.*)\\.h>" _ header)
 484                      (string-append "#include <rpc/types.h>\n"
 485                                     "#include <rpc/rpc.h>\n"
 486                                     "#include <rpc/" header ".h>\n")))
 487                   #t))))
 488     (build-system gnu-build-system)
 489     (arguments
 490      '(;; Link against libtirpc.
 491        #:configure-flags '("LDFLAGS=-ltirpc -Wl,--as-needed")
 492
 493        #:phases (modify-phases %standard-phases
 494                   (add-before 'configure 'adjust-configure-script
 495                     (lambda _
 496                       ;; Mimic upstream commit
 497                       ;; 25750ab5ef82fd3cfce5205d5f1ef07b47098091.
 498                       (substitute* "configure"
 499                         (("GUILE=(.*)--variable bindir`" _ middle)
 500                          (string-append "GUILE=" middle
 501                                         "--variable bindir`/guile")))
 502                       #t))
 503                   (add-before 'build 'set-libtirpc-include-path
 504                     (lambda* (#:key inputs #:allow-other-keys)
 505                       ;; Allow <rpc/rpc.h> & co. to be found.
 506                       (let ((libtirpc (assoc-ref inputs "libtirpc")))
 507                         (setenv "CPATH"
 508                                 (string-append (getenv "CPATH")
 509                                                ":" libtirpc
 510                                                "/include/tirpc"))
 511                         #t)))
 512                   (add-before 'check 'skip-test
 513                     (lambda _
 514                       ;; XXX: This test fails (1) because current GnuTLS no
 515                       ;; longer supports OpenPGP authentication, and (2) for
 516                       ;; some obscure reason.  Better skip it.
 517                       (setenv "XFAIL_TESTS" "utils/block-server")
 518                       #t)))))
 519     (native-inputs
 520      `(("guile" ,guile-2.0)
 521        ("gperf" ,gperf-3.0)                  ;see <https://bugs.gnu.org/32382>
 522        ("pkg-config" ,pkg-config)
 523        ("rpcsvc-proto" ,rpcsvc-proto)))           ;for 'rpcgen'
 524     (inputs
 525      `(("guile" ,guile-2.0)
 526        ("util-linux" ,util-linux)
 527        ("libtirpc" ,libtirpc)
 528        ("gnutls" ,gnutls)
 529        ("tdb" ,tdb)
 530        ("bdb" ,bdb)
 531        ("gdbm" ,gdbm)
 532        ("libgcrypt" ,libgcrypt)
 533        ("lzo" ,lzo)
 534        ("bzip2" ,bzip2)
 535        ("zlib" ,zlib)))
 536     (home-page "https://nongnu.org/libchop/")
 537     (synopsis "Tools & library for data backup and distributed storage")
 538     (description
 539      "Libchop is a set of utilities and library for data backup and
 540 distributed storage.  Its main application is @command{chop-backup}, an
 541 encrypted backup program that supports data integrity checks, versioning,
 542 distribution among several sites, selective sharing of stored data, adaptive
 543 compression, and more.  The library itself implements storage techniques such
 544 as content-addressable storage, content hash keys, Merkle trees, similarity
 545 detection, and lossless compression.")
 546     (license license:gpl3+)))
 547
 548 (define-public borg
 549   (package
 550     (name "borg")
 551     (version "1.1.11")
 552     (source
 553      (origin
 554        (method url-fetch)
 555        (uri (pypi-uri "borgbackup" version))
 556        (sha256
 557         (base32
 558          "190gjzx83b6p64nqj840x382dgz9gfv0gm7wj585lnkrpa90j29n"))
 559        (modules '((guix build utils)))
 560        (snippet
 561         '(begin
 562            ;; Delete files generated by Cython.  We used to have a regex
 563            ;; that created the list of generated files but Borg has
 564            ;; added new non-generated C files that cause the regex to
 565            ;; generate the wrong list.
 566            (for-each delete-file
 567                      '("src/borg/algorithms/checksums.c"
 568                        "src/borg/chunker.c"
 569                        "src/borg/compress.c"
 570                        "src/borg/crypto/low_level.c"
 571                        "src/borg/hashindex.c"
 572                        "src/borg/item.c"
 573                        "src/borg/platform/darwin.c"
 574                        "src/borg/platform/freebsd.c"
 575                        "src/borg/platform/linux.c"
 576                        "src/borg/platform/posix.c"))
 577            ;; Remove bundled shared libraries.
 578            (with-directory-excursion "src/borg/algorithms"
 579              (for-each delete-file-recursively
 580                        (list "blake2" "lz4" "msgpack" "zstd")))
 581            ;; Purge some msgpack references from setup.py or the resulting
 582            ;; sources will be unbuildable.
 583            (substitute* "setup.py"
 584              ((".*Extension\\('borg\\.algorithms\\.msgpack\\..*") "")
 585              (("msgpack_packer_source, msgpack_unpacker_source") ""))
 586            #t))))
 587     (build-system python-build-system)
 588     (arguments
 589      `(#:modules ((srfi srfi-26) ; for cut
 590                   (guix build utils)
 591                   (guix build python-build-system))
 592        #:phases
 593        (modify-phases %standard-phases
 594          (add-after 'unpack 'set-env
 595            (lambda* (#:key inputs #:allow-other-keys)
 596              (let ((openssl (assoc-ref inputs "openssl"))
 597                    (libb2 (assoc-ref inputs "libb2"))
 598                    (lz4 (assoc-ref inputs "lz4"))
 599                    (zstd (assoc-ref inputs "zstd")))
 600                (setenv "BORG_OPENSSL_PREFIX" openssl)
 601                (setenv "BORG_LIBB2_PREFIX" libb2)
 602                (setenv "BORG_LIBLZ4_PREFIX" lz4)
 603                (setenv "BORG_LIBZSTD_PREFIX" zstd)
 604                (setenv "PYTHON_EGG_CACHE" "/tmp")
 605                ;; The test 'test_return_codes[python]' fails when
 606                ;; HOME=/homeless-shelter.
 607                (setenv "HOME" "/tmp")
 608                #t)))
 609          (add-after 'unpack 'use-system-msgpack
 610            (lambda _
 611              (substitute* "src/borg/helpers.py"
 612                (("prefer_system_msgpack = False")
 613                 "prefer_system_msgpack = True"))
 614              #t))
 615          ;; The tests need to be run after Borg is installed.
 616          (delete 'check)
 617          (add-after 'install 'check
 618            (lambda* (#:key inputs outputs #:allow-other-keys)
 619              ;; Make the installed package available for the test suite.
 620              (add-installed-pythonpath inputs outputs)
 621              ;; The tests should be run in an empty directory.
 622              (mkdir-p "tests")
 623              (with-directory-excursion "tests"
 624                (invoke "py.test" "-v" "--pyargs" "borg.testsuite" "-k"
 625                        (string-append
 626                         ;; These tests need to write to '/var'.
 627                         "not test_get_cache_dir "
 628                         "and not test_get_config_dir "
 629                         "and not test_get_keys_dir "
 630                         "and not test_get_security_dir "
 631                         ;; These tests assume there is a root user in
 632                         ;; '/etc/passwd'.
 633                         "and not test_access_acl "
 634                         "and not test_default_acl "
 635                         "and not test_non_ascii_acl "
 636                         ;; This test needs the unpackaged pytest-benchmark.
 637                         "and not benchmark "
 638                         ;; These tests assume the kernel supports FUSE.
 639                         "and not test_fuse "
 640                         "and not test_fuse_allow_damaged_files "
 641                         "and not test_mount_hardlinks")))))
 642          (add-after 'install 'install-doc
 643            (lambda* (#:key inputs outputs #:allow-other-keys)
 644              (let* ((out (assoc-ref outputs "out"))
 645                     (man (string-append out "/share/man/man1"))
 646                     (misc (string-append out "/share/borg/misc")))
 647                (for-each (cut install-file <> misc)
 648                          '("docs/misc/create_chunker-params.txt"
 649                            "docs/misc/internals-picture.txt"
 650                            "docs/misc/prune-example.txt"))
 651                (copy-recursively "docs/man" man)
 652                #t))))))
 653     (native-inputs
 654      `(("python-cython" ,python-cython)
 655        ("python-setuptools-scm" ,python-setuptools-scm)
 656        ("python-pytest" ,python-pytest)))
 657     (inputs
 658      `(("acl" ,acl)
 659        ("libb2" ,libb2)
 660        ("lz4" ,lz4)
 661        ("openssl" ,openssl)
 662        ("python-llfuse" ,python-llfuse)
 663        ;; The Python msgpack library changed its name so Borg requires this
 664        ;; transitional package for now:
 665        ;; <https://bugs.gnu.org/30662>
 666        ("python-msgpack" ,python-msgpack-transitional)
 667        ("zstd" ,zstd "lib")))
 668     (synopsis "Deduplicated, encrypted, authenticated and compressed backups")
 669     (description "Borg is a deduplicating backup program.  Optionally, it
 670 supports compression and authenticated encryption.  The main goal of Borg is to
 671 provide an efficient and secure way to backup data.  The data deduplication
 672 technique used makes Borg suitable for daily backups since only changes are
 673 stored.  The authenticated encryption technique makes it suitable for backups
 674 to not fully trusted targets.  Borg is a fork of Attic.")
 675     (home-page "https://www.borgbackup.org/")
 676     (license license:bsd-3)))
 677
 678 (define-public attic
 679   (package
 680     (name "attic")
 681     (version "0.16")
 682     (source (origin
 683               (method url-fetch)
 684               (uri (pypi-uri "Attic" version))
 685               (sha256
 686                (base32
 687                 "0b5skd36r4c0915lwpkqg5hxm49gls9pprs1b7hc40910wlcsl36"))))
 688     (build-system python-build-system)
 689     (arguments
 690      `(;; The tests assume they are run as root:
 691        ;; https://github.com/jborg/attic/issues/7
 692        #:tests? #f
 693        #:phases
 694        (modify-phases %standard-phases
 695          (add-before
 696           'build 'set-openssl-prefix
 697           (lambda* (#:key inputs #:allow-other-keys)
 698             (setenv "ATTIC_OPENSSL_PREFIX" (assoc-ref inputs "openssl"))
 699             #t)))))
 700     (inputs
 701      `(("acl" ,acl)
 702        ("openssl" ,openssl)
 703        ("python-msgpack" ,python-msgpack)
 704
 705        ;; Attic is probably incompatible with llfuse > 0.41.
 706        ;; These links are to discussions of llfuse compatibility from
 707        ;; the borg project. Borg is a recent fork of attic, and attic
 708        ;; has not been updated since the fork, so it's likely that
 709        ;; llfuse compatibility requirements are still the same.
 710        ;; https://github.com/borgbackup/borg/issues/642
 711        ;; https://github.com/borgbackup/borg/issues/643
 712        ("python-llfuse" ,python-llfuse-0.41)))
 713     (synopsis "Deduplicating backup program")
 714     (description "Attic is a deduplicating backup program.  The main goal of
 715 Attic is to provide an efficient and secure way to backup data.  The data
 716 deduplication technique used makes Attic suitable for daily backups since only
 717 changes are stored.")
 718     (home-page "https://attic-backup.org/")
 719     (license license:bsd-3)
 720     (properties `((superseded . ,borg)))))
 721
 722 (define-public wimlib
 723   (package
 724     (name "wimlib")
 725     (version "1.13.1")
 726     (source (origin
 727               (method url-fetch)
 728               (uri (string-append "https://wimlib.net/downloads/"
 729                                   "wimlib-" version ".tar.gz"))
 730               (sha256
 731                (base32
 732                 "0pxgrpr3dr81rcf2jh71aiiq3v4anc5sj1nld18f2vhvbijbrx27"))))
 733     (build-system gnu-build-system)
 734     (native-inputs
 735      `(("pkg-config" ,pkg-config)))
 736     (inputs
 737      `(("fuse" ,fuse)
 738        ("libxml2" ,libxml2)
 739        ("ntfs-3g" ,ntfs-3g)
 740        ("openssl" ,openssl)))
 741     (arguments
 742      `(#:configure-flags (list "--enable-test-support")))
 743     (home-page "https://wimlib.net/")
 744     (synopsis "WIM file manipulation library and utilities")
 745     (description "wimlib is a C library and set of command-line utilities for
 746 creating, modifying, extracting, and mounting archives in the Windows Imaging
 747 Format (@dfn{WIM files}).  It can capture and apply WIMs directly from and to
 748 NTFS volumes using @code{ntfs-3g}, preserving NTFS-specific attributes.")
 749     ;; wimlib is dual-licenced under version 3 or later of either the GPL or
 750     ;; LGPL, except those files explicitly marked as being released into the
 751     ;; public domain (CC0) in their headers.
 752     (license (list license:gpl3+
 753                    license:lgpl3+
 754                    license:cc0))))
 755
 756 (define-public dirvish
 757   (package
 758     (name "dirvish")
 759     (version "1.2.1")
 760     (build-system gnu-build-system)
 761     (source (origin
 762               (method url-fetch)
 763               (uri (string-append
 764                     "http://dirvish.org/dirvish-" version ".tgz"))
 765               (sha256
 766                (base32
 767                 "1kbxa1irszp2zw8hd5qzqnrrzb4vxfivs1vn64yxnj0lak1jjzvb"))))
 768     (arguments
 769      `(#:modules ((ice-9 match) (ice-9 rdelim)
 770                   ,@%gnu-build-system-modules)
 771        #:phases
 772        ;; This mostly mirrors the steps taken in the install.sh that ships
 773        ;; with dirvish, but simplified because we aren't prompting interactively
 774        (modify-phases %standard-phases
 775          (delete 'configure)
 776          (delete 'build)
 777          (delete 'check)
 778          (replace 'install
 779            (lambda* (#:key inputs outputs #:allow-other-keys)
 780              ;; These are mostly the same steps the install.sh that comes with
 781              ;; dirvish does
 782              (let* (;; Files we'll be copying
 783                     (executables
 784                      '("dirvish" "dirvish-runall"
 785                        "dirvish-expire" "dirvish-locate"))
 786                     (man-pages
 787                      '(("dirvish" "8") ("dirvish-runall" "8")
 788                        ("dirvish-expire" "8") ("dirvish-locate" "8")
 789                        ("dirvish.conf" "5")))
 790
 791                     (output-dir
 792                      (assoc-ref outputs "out"))
 793
 794                     ;; Just a default... not so useful on guixsd though
 795                     ;; You probably want to a service with file(s) to point to.
 796                     (confdir "/etc/dirvish")
 797
 798                     (perl (string-append (assoc-ref %build-inputs "perl")
 799                                          "/bin/perl"))
 800                     (loadconfig.pl (call-with-input-file "loadconfig.pl"
 801                                      read-string)))
 802
 803
 804                (define (write-pl filename)
 805                  (define pl-header
 806                    (string-append "#!" perl "\n\n"
 807                                   "$CONFDIR = \"" confdir "\";\n\n"))
 808                  (define input-file-location
 809                    (string-append filename ".pl"))
 810                  (define target-file-location
 811                    (string-append output-dir "/bin/" filename ".pl"))
 812                  (define text-to-write
 813                    (string-append pl-header
 814                                   (call-with-input-file input-file-location
 815                                     read-string)
 816                                   "\n" loadconfig.pl))
 817                  (with-output-to-file target-file-location
 818                    (lambda ()
 819                      (display text-to-write)))
 820                  (chmod target-file-location #o755)
 821                  (wrap-program target-file-location
 822                    `("PERL5LIB" ":" prefix
 823                      ,(map (lambda (l) (string-append (assoc-ref %build-inputs l)
 824                                                       "/lib/perl5/site_perl"))
 825                            '("perl-libtime-period"
 826                              "perl-libtime-parsedate")))))
 827
 828                (define write-man
 829                  (match-lambda
 830                    ((file-base man-num)
 831                     (let* ((filename
 832                             (string-append file-base "." man-num))
 833                            (output-path
 834                             (string-append output-dir
 835                                            "/share/man/man" man-num
 836                                            "/" filename)))
 837                       (copy-file filename output-path)))))
 838
 839                ;; Make directories
 840                (mkdir-p (string-append output-dir "/bin/"))
 841                (mkdir-p (string-append output-dir "/share/man/man8/"))
 842                (mkdir-p (string-append output-dir "/share/man/man5/"))
 843
 844                ;; Write out executables
 845                (for-each write-pl executables)
 846                ;; Write out man pages
 847                (for-each write-man man-pages)
 848                #t))))))
 849     (inputs
 850      `(("perl" ,perl)
 851        ("rsync" ,rsync)
 852        ("perl-libtime-period" ,perl-libtime-period)
 853        ("perl-libtime-parsedate" ,perl-libtime-parsedate)))
 854     (home-page "http://dirvish.org/")
 855     (synopsis "Fast, disk based, rotating network backup system")
 856     (description
 857      "With dirvish you can maintain a set of complete images of your
 858 file systems with unattended creation and expiration.  A dirvish backup vault
 859 is like a time machine for your data. ")
 860     (license (license:fsf-free "file://COPYING"
 861                                "Open Software License 2.0"))))
 862
 863 (define-public restic
 864   (package
 865     (name "restic")
 866     (version "0.9.6")
 867     ;; TODO Try packaging the bundled / vendored dependencies in the 'vendor/'
 868     ;; directory.
 869     (source (origin
 870               (method url-fetch)
 871               (uri (string-append
 872                     "https://github.com/restic/restic/releases/download/"
 873                     "v" version "/restic-" version ".tar.gz"))
 874               (file-name (string-append name "-" version ".tar.gz"))
 875               (sha256
 876                (base32
 877                 "1zmh42aah32ah8w5n6ilz9bci0y2xrf8p7qshy3yf1lzm5gnbj0w"))))
 878     (build-system go-build-system)
 879     (arguments
 880      `(#:import-path "github.com/restic/restic"
 881       ;; We don't need to install the source code for end-user applications.
 882        #:install-source? #f
 883        #:phases
 884        (modify-phases %standard-phases
 885          (replace 'build
 886            (lambda* (#:key inputs #:allow-other-keys)
 887              (with-directory-excursion "src/github.com/restic/restic"
 888                ;; Disable 'restic self-update'.  It makes little sense in Guix.
 889                (substitute* "build.go" (("selfupdate") ""))
 890                (setenv "HOME" (getcwd)) ; for $HOME/.cache/go-build
 891                (invoke "go" "run" "build.go"))))
 892
 893          (replace 'check
 894            (lambda _
 895              (with-directory-excursion "src/github.com/restic/restic"
 896                ;; Disable FUSE tests.
 897                (setenv "RESTIC_TEST_FUSE" "0")
 898                (invoke "go" "run" "build.go" "--test"))))
 899
 900          (replace 'install
 901            (lambda* (#:key outputs #:allow-other-keys)
 902              (let ((out (assoc-ref outputs "out"))
 903                    (src "src/github.com/restic/restic"))
 904                (install-file (string-append src "/restic")
 905                              (string-append out "/bin"))
 906                #t)))
 907
 908          (add-after 'install 'install-docs
 909            (lambda* (#:key outputs #:allow-other-keys)
 910              (let* ((out (assoc-ref outputs "out"))
 911                     (man "/share/man")
 912                     (man-section (string-append man "/man"))
 913                     (src "src/github.com/restic/restic/doc/man/"))
 914                ;; Install all the man pages to "out".
 915                (for-each
 916                  (lambda (file)
 917                    (install-file file
 918                                  (string-append out man-section
 919                                                 (string-take-right file 1))))
 920                  (find-files src "\\.[1-9]"))
 921                #t)))
 922
 923          (add-after 'install-docs 'install-shell-completion
 924            (lambda* (#:key outputs #:allow-other-keys)
 925              (let* ((out (assoc-ref outputs "out"))
 926                     (bin (string-append out "/bin"))
 927                     (etc (string-append out "/etc"))
 928                     (share (string-append out "/share")))
 929                (for-each
 930                 (lambda (shell)
 931                   (let* ((shell-name (symbol->string shell))
 932                          (dir (string-append "etc/completion/" shell-name)))
 933                     (mkdir-p dir)
 934                     (invoke (string-append bin "/restic") "generate"
 935                             (string-append "--" shell-name "-completion")
 936                             (string-append dir "/"
 937                                            (case shell
 938                                              ((bash) "restic")
 939                                              ((zsh) "_restic"))))))
 940                 '(bash zsh))
 941                (with-directory-excursion "etc/completion"
 942                  (install-file "bash/restic"
 943                                (string-append etc "/bash_completion.d"))
 944                  (install-file "zsh/_restic"
 945                                (string-append share "/zsh/site-functions")))
 946                #t))))))
 947     (home-page "https://restic.net/")
 948     (synopsis "Backup program with multiple revisions, encryption and more")
 949     (description "Restic is a program that does backups right and was designed
 950 with the following principles in mind:
 951
 952 @itemize
 953 @item Easy: Doing backups should be a frictionless process, otherwise you
 954 might be tempted to skip it.  Restic should be easy to configure and use, so
 955 that, in the event of a data loss, you can just restore it.  Likewise,
 956 restoring data should not be complicated.
 957
 958 @item Fast: Backing up your data with restic should only be limited by your
 959 network or hard disk bandwidth so that you can backup your files every day.
 960 Nobody does backups if it takes too much time.  Restoring backups should only
 961 transfer data that is needed for the files that are to be restored, so that
 962 this process is also fast.
 963
 964 @item Verifiable: Much more important than backup is restore, so restic
 965 enables you to easily verify that all data can be restored.  @item Secure:
 966 Restic uses cryptography to guarantee confidentiality and integrity of your
 967 data.  The location the backup data is stored is assumed not to be a trusted
 968 environment (e.g.  a shared space where others like system administrators are
 969 able to access your backups).  Restic is built to secure your data against
 970 such attackers.
 971
 972 @item Efficient: With the growth of data, additional snapshots should only
 973 take the storage of the actual increment.  Even more, duplicate data should be
 974 de-duplicated before it is actually written to the storage back end to save
 975 precious backup space.
 976 @end itemize")
 977     (license license:bsd-2)))
 978
 979 (define-public burp
 980   (package
 981     (name "burp")
 982     (version "2.3.24")
 983     (source (origin
 984               (method url-fetch)
 985               (uri (string-append "mirror://sourceforge/burp/burp-" version
 986                                   "/burp-" version ".tar.bz2"))
 987               (sha256
 988                (base32
 989                 "0dmahqx8ldqdrx9b47r7ag3m801n7h3kclcqja1cc1jzhfhfq27w"))))
 990     (build-system gnu-build-system)
 991     (arguments
 992      `(#:phases
 993        (modify-phases %standard-phases
 994          (add-before 'check 'extend-test-time-outs
 995            ;; The defaults are far too low for busy boxes & spinning storage.
 996            (lambda _
 997              (substitute* (find-files "utest" "\\.c$")
 998                (("(tcase_set_timeout\\(tc_core,)[ 0-9]*(\\);.*)$" _ prefix suffix)
 999                 (string-append prefix " 3600" suffix "\n")))
1000              #t)))))
1001     (inputs
1002      `(("librsync" ,librsync)
1003        ("openssl" ,openssl)
1004        ("uthash" ,uthash)
1005        ("zlib" ,zlib)))
1006     (native-inputs
1007      `(("check" ,check)
1008        ("pkg-config" ,pkg-config)))
1009     (home-page "https://burp.grke.org")
1010     (synopsis "Differential backup and restore")
1011     (description "Burp is a network backup and restore program.  It attempts
1012 to reduce network traffic and the amount of space that is used by each
1013 backup.")
1014     (license license:agpl3)))