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