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