;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2015 Roel Janssen <roel@gnu.org>
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2016, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 ng0 <ng0@n0.is>
;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2017 Rene Saavedra <rennes@openmailbox.org>
;;; Copyright © 2017,2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Kei Kebreau <kkebreau@posteo.net>
;;; Copyright © 2017 Alex Vong <alexvong1995@gmail.com>
;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2018 Meiyo Peng <meiyo.peng@gmail.com>
;;; Copyright © 2019 Yoshinori Arai <kumagusu08@gmail.com>
;;; Copyright © 2019 Mădălin Ionel Patrașcu <madalinionel.patrascu@mdc-berlin.de>
;;; Copyright © 2019 Wiktor Żelazny <wzelazny@vurv.cz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/l;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Christopher Baines &lt;mail@cbaines.net&gt;
;;; Copyright © 2020-2024 Ludovic Courtès &lt;ludo@gnu.org&gt;
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen &lt;janneke@gnu.org&gt;
;;; Copyright © 2021 Pierre Langlois &lt;pierre.langlois@gmx.com&gt;
;;; Copyright © 2022 Marius Bakke &lt;marius@gnu.org&gt;
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see &lt;http://www.gnu.org/licenses/&gt;.

(define-module (gnu tests virtualization)
  #:use-module (gnu tests)
  #:use-module (gnu image)
  #:use-module (gnu system)
  #:use-module (gnu system accounts)
  #:use-module (gnu system file-systems)
  #:use-module (gnu system image)
  #:use-module (gnu system images hurd)
  #:use-module ((gnu system shadow) #:select (%base-user-accounts))
  #:use-module (gnu system vm)
  #:use-module (gnu services)
  #:use-module (gnu services dbus)
  #:use-module (gnu services networking)
  #:use-module (gnu services ssh)
  #:use-module (gnu services virtualization)
  #:use-module (gnu packages ssh)
  #:use-module (gnu packages virtualization)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (guix store)
  #:use-module (guix modules)
  #:export (%test-libvirt
            %test-qemu-guest-agent
            %test-childhurd
            %test-build-vm))


;;;
;;; Libvirt.
;;;

(define %libvirt-os
  (simple-operating-system
   (service dhcp-client-service-type)
   (service dbus-root-service-type)
   (service polkit-service-type)
   (service libvirt-service-type)))

(define (run-libvirt-test)
  &quot;Run tests in %LIBVIRT-OS.&quot;
  (define os
    (marionette-operating-system
     %libvirt-os
     #:imported-modules &apos;((gnu services herd)
                          (guix combinators))))

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings &apos;())))

  (define test
    (with-imported-modules &apos;((gnu build marionette))
      #~(begin
          (use-modules (srfi srfi-11) (srfi srfi-64)
                       (gnu build marionette))

          (define marionette
            (make-marionette (list #$vm)))

          (test-runner-current (system-test-runner #$output))
          (test-begin &quot;libvirt&quot;)

          (test-assert &quot;service running&quot;
            (marionette-eval
             &apos;(begin
                (use-modules (gnu services herd))
                (match (start-service &apos;libvirtd)
                  (#f #f)
                  ((&apos;service response-parts ...)
                   (match (assq-ref response-parts &apos;running)
                     ((pid) (number? pid))))))
             marionette))

          ;; Give the libvirtd service time to start up.
          (sleep 1)

          (test-eq &quot;fetch version&quot;
            0
            (marionette-eval
             `(begin
                (chdir &quot;/tmp&quot;)
                (system* ,(string-append #$libvirt &quot;/bin/virsh&quot;)
                         &quot;-c&quot; &quot;qemu:///system&quot; &quot;version&quot;))
             marionette))

          (test-eq &quot;connect&quot;
            0
            (marionette-eval
             `(begin
                (chdir &quot;/tmp&quot;)
                (system* ,(string-append #$libvirt &quot;/bin/virsh&quot;)
                         &quot;-c&quot; &quot;qemu:///system&quot; &quot;connect&quot;))
             marionette))

          (test-eq &quot;create default network&quot;
            0
            (marionette-eval
             &apos;(begin
                (chdir &quot;/tmp&quot;)
                (system* #$(file-append libvirt &quot;/bin/virsh&quot;)
                         &quot;-c&quot; &quot;qemu:///system&quot; &quot;net-define&quot;
                         #$(file-append libvirt
                                        &quot;/etc/libvirt/qemu/networks/default.xml&quot;)))
             marionette))

          (test-eq &quot;start default network&quot;
            0
            (marionette-eval
             &apos;(begin
                (chdir &quot;/tmp&quot;)
                (system* #$(file-append libvirt &quot;/bin/virsh&quot;)
                         &quot;-c&quot; &quot;qemu:///system&quot; &quot;net-start&quot; &quot;default&quot;))
             marionette))

          (test-end))))

  (gexp-&gt;derivation &quot;libvirt-test&quot; test))

(define %test-libvirt
  (system-test
   (name &quot;libvirt&quot;)
   (description &quot;Connect to the running LIBVIRT service.&quot;)
   (value (run-libvirt-test))))


;;;
;;; QEMU Guest Agent service.
;;;

(define %qemu-guest-agent-os
  (simple-operating-system
   (service qemu-guest-agent-service-type)))

(define (run-qemu-guest-agent-test)
  &quot;Run tests in %QEMU-GUEST-AGENT-OS.&quot;
  (define os
    (marionette-operating-system
     %qemu-guest-agent-os
     #:imported-modules &apos;((gnu services herd))))

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings &apos;())))

  (define test
    (with-imported-modules &apos;((gnu build marionette))
      #~(begin
          (use-modules (gnu build marionette)
                       (ice-9 rdelim)
                       (srfi srfi-64))

          (define marionette
            ;; Ensure we look for the socket in the correct place below.
            (make-marionette (list #$vm) #:socket-directory &quot;/tmp&quot;))

          (define* (try-read port #:optional (attempts 10))
            ;; Try reading from a port several times before giving up.
            (cond ((char-ready? port)
                   (let ((response (read-line port)))
                     (close-port port)
                     response))
                  ((&gt; attempts 1)
                   (sleep 1)
                   (try-read port (- attempts 1)))
                  (else &quot;&quot;)))

          (define (run command)
            ;; Run a QEMU guest agent command and return the response.
            (let ((s (socket PF_UNIX SOCK_STREAM 0)))
              (connect s AF_UNIX &quot;/tmp/qemu-ga&quot;)
              (display command s)
              (try-read s)))

          (test-runner-current (system-test-runner #$output))
          (test-begin &quot;qemu-guest-agent&quot;)

          (test-assert &quot;service running&quot;
            (marionette-eval
             &apos;(begin
                (use-modules (gnu services herd))
                (match (start-service &apos;qemu-guest-agent)
                  (#f #f)
                  ((&apos;service response-parts ...)
                   (match (assq-ref response-parts &apos;running)
                     ((pid) (number? pid))))))
             marionette))

          (test-equal &quot;ping guest&quot;
            &quot;{\&quot;return\&quot;: {}}&quot;
            (run &quot;{\&quot;execute\&quot;: \&quot;guest-ping\&quot;}&quot;))

          (test-assert &quot;get network interfaces&quot;
            (string-contains
             (run &quot;{\&quot;execute\&quot;: \&quot;guest-network-get-interfaces\&quot;}&quot;)
             &quot;127.0.0.1&quot;))

          (test-end))))

  (gexp-&gt;derivation &quot;qemu-guest-agent-test&quot; test))

(define %test-qemu-guest-agent
  (system-test
   (name &quot;qemu-guest-agent&quot;)
   (description &quot;Run commands in a virtual machine using QEMU guest agent.&quot;)
   (value (run-qemu-guest-agent-test))))


;;;
;;; GNU/Hurd virtual machines, aka. childhurds.
;;;

(define %childhurd-os
  (simple-operating-system
   (service dhcp-client-service-type)
   (service hurd-vm-service-type
            (hurd-vm-configuration
             (os (operating-system
                   (inherit %hurd-vm-operating-system)
                   (users (cons (user-account
                                 (name &quot;test&quot;)
                                 (group &quot;users&quot;)
                                 (password &quot;&quot;))   ;empty password
                                %base-user-accounts))))))))

(define* (run-command-over-ssh command
                               #:key (port 10022) (user &quot;test&quot;))
  &quot;Return a program that runs COMMAND over SSH and prints the result on standard
output.&quot;
  (define run
    (with-extensions (list guile-ssh)
      #~(begin
          (use-modules (ssh session)
                       (ssh auth)
                       (ssh popen)
                       (ice-9 match)
                       (ice-9 textual-ports))

          (let ((session (make-session #:user #$user
                                       #:port #$port
                                       #:host &quot;localhost&quot;
                                       #:timeout 120
                                       #:log-verbosity &apos;rare)))
            (match (connect! session)
              (&apos;ok
               (userauth-password! session &quot;&quot;)
               (display
                (get-string-all
                 (open-remote-input-pipe* session #$@command))))
              (status
               (error &quot;could not connect to guest over SSH&quot;
                      session status)))))))

  (program-file &quot;run-command-over-ssh&quot; run))

(define (run-childhurd-test)
  (define (import-module? module)
    ;; This module is optional and depends on Guile-Gcrypt, do skip it.
    (and (guix-module-name? module)
         (not (equal? module &apos;(guix store deduplication)))))

  (define os
    (marionette-operating-system
     %childhurd-os
     #:imported-modules (source-module-closure
                         &apos;((gnu services herd)
                           (guix combinators)
                           (gnu build install))
                         #:select? import-module?)))

  (define vm
    (virtual-machine
     (operating-system os)
     (memory-size (* 1024 3))))

  (define test
    (with-imported-modules &apos;((gnu build marionette))
      #~(begin
          (use-modules (gnu build marionette)
                       (srfi srfi-64)
                       (ice-9 match))

          (define marionette
            ;; Emulate as much as the host CPU supports so that, possibly, KVM
            ;; is available inside as well (&quot;nested KVM&quot;), provided
            ;; /sys/module/kvm_intel/parameters/nested (or similar) allows it.
            (make-marionette (list #$vm &quot;-cpu&quot; &quot;max&quot;)))

          (test-runner-current (system-test-runner #$output))
          (test-begin &quot;childhurd&quot;)

          (test-assert &quot;service running&quot;
            (marionette-eval
             &apos;(begin
                (use-modules (gnu services herd)
                             (ice-9 match))

                (match (start-service &apos;childhurd)
                  (#f #f)
                  ((&apos;service response-parts ...)
                   (match (assq-ref response-parts &apos;running)
                     ((pid) (number? pid))))))
             marionette))

          (test-equal &quot;childhurd SSH server replies&quot;
            &quot;SSH&quot;
            ;; Check from within the guest whether its childhurd&apos;s SSH
            ;; server is reachable.  Do that from the guest: port forwarding
            ;; to the host won&apos;t work because QEMU listens on 127.0.0.1.
            (marionette-eval
             &apos;(begin
                (use-modules (ice-9 match)
                             (ice-9 textual-ports))

                (let loop ((n 60))
                  (if (zero? n)
                      &apos;all-attempts-failed
                      (let ((s (socket PF_INET SOCK_STREAM 0))
                            (a (make-socket-address AF_INET
                                                    INADDR_LOOPBACK
                                                    10022)))
                        (format #t &quot;connecting to childhurd SSH server...~%&quot;)
                        (connect s a)
                        (match (get-string-n s 3)
                          ((? eof-object?)
                           (close-port s)
                           (sleep 1)
                           (loop (- n 1)))
                          (str
                           (close-port s)
                           str))))))
             marionette))

          (test-equal &quot;SSH up and running&quot;
            &quot;childhurd GNU\n&quot;

            ;; Connect from the guest to the chidhurd over SSH and run the
            ;; &apos;uname&apos; command.
            (marionette-eval
             &apos;(begin
                (use-modules (ice-9 popen)
                             (ice-9 textual-ports))

                (get-string-all
                 (open-input-pipe #$(run-command-over-ssh &apos;(&quot;uname&quot; &quot;-on&quot;)))))
             marionette))

          (test-assert &quot;guix-daemon up and running&quot;
            (let ((drv (marionette-eval
                        &apos;(begin
                           (use-modules (ice-9 popen)
                                        (ice-9 textual-ports))

                           (get-string-all
                            (open-input-pipe
                             #$(run-command-over-ssh
                                &apos;(&quot;guix&quot; &quot;build&quot; &quot;coreutils&quot;
                                  &quot;--no-grafts&quot; &quot;-d&quot;)))))
                        marionette)))
              ;; We cannot compare the .drv with (raw-derivation-file
              ;; coreutils) on the host: they may differ due to fixed-output
              ;; derivations and changes introduced compared to the &apos;guix&apos;
              ;; package snapshot.
              (and (string-suffix? &quot;.drv&quot;
                                   (pk &apos;drv (string-trim-right drv)))
                   drv)))

          (test-assert &quot;copy-on-write store&quot;
            ;; Set up a writable store.  The root partition is already an
            ;; overlayfs, which is not suitable as the bottom part of this
            ;; additional overlayfs; thus, create a tmpfs for the backing
            ;; store.
            ;; TODO: Remove this when &lt;virtual-machine&gt; creates a writable
            ;; store.
            (marionette-eval
             &apos;(begin
                (use-modules (gnu build install)
                             (guix build syscalls))

                (mkdir &quot;/run/writable-store&quot;)
                (mount &quot;none&quot; &quot;/run/writable-store&quot; &quot;tmpfs&quot;)
                (mount-cow-store &quot;/run/writable-store&quot; &quot;/backing-store&quot;)
                (system* &quot;df&quot; &quot;-hT&quot;))
             marionette))

          (test-equal &quot;offloading&quot;
            0
            (marionette-eval
             &apos;(and (file-exists? &quot;/etc/guix/machines.scm&quot;)
                   (system* &quot;guix&quot; &quot;offload&quot; &quot;test&quot;))
             marionette))

          (test-end))))

  (gexp-&gt;derivation &quot;childhurd-test&quot; test))

(define %test-childhurd
  (system-test
   (name &quot;childhurd&quot;)
   (description
    &quot;Connect to the GNU/Hurd virtual machine service, aka. a childhurd, making
sure that the childhurd boots and runs its SSH server.&quot;)
   (value (run-childhurd-test))))


;;;
;;; Virtual build machine.
;;;

(define %build-vm-os
  (simple-operating-system
   (service virtual-build-machine-service-type
            (virtual-build-machine
             (cpu-count 1)
             (memory-size (* 1 1024))))))

(define (run-build-vm-test)
  (define (import-module? module)
    ;; This module is optional and depends on Guile-Gcrypt, do skip it.
    (and (guix-module-name? module)
         (not (equal? module &apos;(guix store deduplication)))))

  (define os
    (marionette-operating-system
     %build-vm-os
     #:imported-modules (source-module-closure
                         &apos;((gnu services herd)
                           (gnu build install))
                         #:select? import-module?)))

  (define vm
    (virtual-machine
     (operating-system os)
     (memory-size (* 1024 3))))

  (define test
    (with-imported-modules &apos;((gnu build marionette))
      #~(begin
          (use-modules (gnu build marionette)
                       (srfi srfi-64)
                       (ice-9 match))

          (define marionette
            ;; Emulate as much as the host CPU supports so that, possibly, KVM
            ;; is available inside as well (&quot;nested KVM&quot;), provided
            ;; /sys/module/kvm_intel/parameters/nested (or similar) allows it.
            (make-marionette (list #$vm &quot;-cpu&quot; &quot;max&quot;)))

          (test-runner-current (system-test-runner #$output))
          (test-begin &quot;build-vm&quot;)

          (test-assert &quot;service running&quot;
            (marionette-eval
             &apos;(begin
                (use-modules (gnu services herd)
                             (ice-9 match))

                (start-service &apos;build-vm))
             marionette))

          (test-assert &quot;guest SSH up and running&quot;
            ;; Note: Pass #:peek? #t because due to the way QEMU port
            ;; forwarding works, connecting to 11022 always works even if the
            ;; &apos;sshd&apos; service hasn&apos;t been started yet in the guest.
            (wait-for-tcp-port 11022 marionette
                               #:peek? #t))

          (test-assert &quot;copy-on-write store&quot;
            ;; Set up a writable store.  The root partition is already an
            ;; overlayfs, which is not suitable as the bottom part of this
            ;; additional overlayfs; thus, create a tmpfs for the backing
            ;; store.
            ;; TODO: Remove this when &lt;virtual-machine&gt; creates a writable
            ;; store.
            (marionette-eval
             &apos;(begin
                (use-modules (gnu build install)
                             (guix build syscalls))

                (mkdir &quot;/run/writable-store&quot;)
                (mount &quot;none&quot; &quot;/run/writable-store&quot; &quot;tmpfs&quot;)
                (mount-cow-store &quot;/run/writable-store&quot; &quot;/backing-store&quot;)
                (system* &quot;df&quot; &quot;-hT&quot;))
             marionette))

          (test-equal &quot;offloading&quot;
            0
            (marionette-eval
             &apos;(and (file-exists? &quot;/etc/guix/machines.scm&quot;)
                   (system* &quot;guix&quot; &quot;offload&quot; &quot;test&quot;))
             marionette))

          (test-end))))

  (gexp-&gt;derivation &quot;build-vm-test&quot; test))

(define %test-build-vm
  (system-test
   (name &quot;build-vm&quot;)
   (description
    &quot;Offload to a virtual build machine over SSH.&quot;)
   (value (run-build-vm-test))))
</pre>
</div></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
erybody, because they believe that everybody runs Windows and therefore
runs Word\".")
    (license license:gpl2+)))

(define-public catdoc
  (package
    (name "catdoc")
    (version "0.95")
    (source (origin
              (method url-fetch)
              (uri (string-append "http://ftp.wagner.pp.ru/pub/catdoc/"
                                  "catdoc-" version ".tar.gz"))
              (patches (search-patches "catdoc-CVE-2017-11110.patch"))
              (sha256
               (base32
                "15h7v3bmwfk4z8r78xs5ih6vd0pskn0rj90xghvbzdjj0cc88jji"))))
    (build-system gnu-build-system)
    ;; TODO: Also build `wordview` which requires `tk` – make a separate
    ;; package for this.
    (arguments
     '(#:tests? #f ; There are no tests
       #:configure-flags '("--disable-wordview")
       #:phases
       (modify-phases %standard-phases
         (add-before 'install 'fix-install
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (mkdir-p (string-append out "/share/man/man1"))))))))
    (home-page "https://www.wagner.pp.ru/~vitus/software/catdoc/")
    (synopsis "MS-Word to TeX or plain text converter")
    (description "@command{catdoc} extracts text from MS-Word files, trying to
preserve as many special printable characters as possible.  It supports
everything up to Word-97. Also supported are MS Write documents and RTF files.

@command{catdoc} does not preserve complex word formatting, but it can
translate some non-ASCII characters into TeX escape codes.  It's goal is to
extract plain text and allow you to read it and, probably, reformat with TeX,
according to TeXnical rules.

This package also provides @command{xls2csv}, which extracts data from Excel
spreadsheets and outputs it in comma-separated-value format, and
@command{catppt}, which extracts data from PowerPoint presentations.")
    (license license:gpl2+)))

(define-public utfcpp
  (package
    (name "utfcpp")
    (version "2.3.5")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                     (url "https://github.com/nemtrif/utfcpp")
                     (commit (string-append "v" version))))
              (file-name (git-file-name name version))
              (sha256
               (base32
                "1gr98d826z6wa58r1s5i7rz7q2x3r31v7zj0pjjlrc7gfxwklr4s"))))
    (build-system cmake-build-system)
    (arguments
     `(#:out-of-source? #f
       #:phases
       (modify-phases %standard-phases
         (replace 'install              ; no install target
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (include (string-append out "/include"))
                    (doc (string-append out "/share/doc/" ,name)))
               (copy-recursively "source" include)
               (install-file "README.md" doc)
               #t))))))
    (home-page "https://github.com/nemtrif/utfcpp")
    (synopsis "Portable C++ library for handling UTF-8")
    (description "UTF8-CPP is a C++ library for handling UTF-8 encoded text
in a portable way.")
    (license license:boost1.0)))

(define-public dbacl
  (package
    (name "dbacl")
    (version "1.14")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "http://www.lbreyer.com/gpl/"
                           "dbacl-" version ".tar.gz"))
       (sha256
        (base32
         "0224g6x71hyvy7jikfxmgcwww1r5lvk0jx36cva319cb9nmrbrq7"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags
       (list
        (string-append "-I" (assoc-ref %build-inputs "slang")
                       "/include/slang")
        (string-append "-I" (assoc-ref %build-inputs "ncurses")
                       "/include/ncurses"))
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'delete-sample6-and-japanese
           (lambda _
             (substitute* "doc/Makefile.am"
               (("sample6.txt") "")
               (("japanese.txt") ""))
             (delete-file "doc/sample6.txt")
             (delete-file "doc/japanese.txt")
             (substitute* (list "src/tests/Makefile.am"
                                "src/tests/Makefile.in")
               (("dbacl-jap.shin") "")
               (("dbacl-jap.sh") ""))
             #t))
         (add-after 'unpack 'delete-test
           ;; See comments about the license.
           (lambda _
             (delete-file "src/tests/dbacl-jap.shin")
             #t))
         (add-after 'delete-sample6-and-japanese 'autoreconf
           (lambda _
             (invoke "autoreconf" "-vif")
             #t))
         (add-after 'unpack 'fix-test-files
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (bin (string-append out "/bin")))
               (substitute* (find-files "src/tests/" "\\.shin$")
                 (("PATH=/bin:/usr/bin")
                  "#PATH=/bin:/usr/bin")
                 (("diff") (string-append (which "diff")))
                 (("tr") (string-append (which "tr"))))
               #t))))))
    (inputs
     `(("ncurses" ,ncurses)
       ("perl" ,perl)
       ("readline" ,readline)
       ("slang" ,slang)))
    (native-inputs
     `(("libtool" ,libtool)
       ("autoconf" ,autoconf)
       ("automake" ,automake)
       ("pkg-config" ,pkg-config)))
    (home-page "https://www.lbreyer.com/dbacl.html")
    (synopsis "Bayesian text and email classifier")
    (description
     "dbacl is a fast Bayesian text and email classifier.  It builds a variety
of language models using maximum entropy (minimum divergence) principles, and
these can then be used to categorize input data automatically among multiple
categories.")
    ;; The software is licensed as GPLv3 or later, but
    ;; includes various sample texts in the doc dir:
    ;; - sample1.txt, sample3 and sampe5.txt are in the public domain,
    ;;   by Mark Twain.
    ;; - sample2.txt, sample4.txt are in the public domain, by Aristotle.
    ;; - sample6.txt is a forwarded email, copyright unknown.
    ;;   Guix does exclude sample6.txt.
    ;; - japanese.txt is a Japanese unoffical translation of the
    ;;   GNU General Public License, (c) by the Free Software Foundation.
    ;;   Guix excludes this file.
    (license (list license:gpl3+ license:public-domain))))

(define-public dotconf
  (package
    (name "dotconf")
    (version "1.3")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url "https://github.com/williamh/dotconf.git")
                    (commit (string-append "v" version))))
              (file-name (git-file-name name version))
              (sha256
               (base32
                "1sc95hw5k2xagpafny0v35filmcn05k1ds5ghkldfpf6xw4hakp7"))))
    (build-system gnu-build-system)
    (arguments `(#:tests? #f))  ; FIXME maketest.sh does not work.
    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("libtool" ,libtool)))
    (home-page "https://github.com/williamh/dotconf")
    (synopsis "Configuration file parser library")
    (description
     "C library for creating and parsing configuration files.")
    (license (list license:lgpl2.1         ; Main distribution.
                   license:asl1.1))))      ; src/readdir.{c,h}

(define-public java-rsyntaxtextarea
  (package
    (name "java-rsyntaxtextarea")
    (version "2.6.1")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://github.com/bobbylight/"
                                  "RSyntaxTextArea/archive/"
                                  version ".tar.gz"))
              (file-name (string-append name "-" version ".tar.gz"))
              (sha256
               (base32
                "0c5mqg2klj5rvf8fhycrli8rf6s37l9p7a8knw9gpp65r1c120q2"))))
    (build-system ant-build-system)
    (arguments
     `(;; FIXME: some tests fail because locale resources cannot be found.
       ;; Even when I add them to the class path,
       ;; RSyntaxTextAreaEditorKitDumbCompleteWordActionTest fails.
       #:tests? #f
       #:jar-name "rsyntaxtextarea.jar"))
    (native-inputs
     `(("java-junit" ,java-junit)
       ("java-hamcrest-core" ,java-hamcrest-core)))
    (home-page "https://bobbylight.github.io/RSyntaxTextArea/")
    (synopsis "Syntax highlighting text component for Java Swing")
    (description "RSyntaxTextArea is a syntax highlighting, code folding text
component for Java Swing.  It extends @code{JTextComponent} so it integrates
completely with the standard @code{javax.swing.text} package.  It is fast and
efficient, and can be used in any application that needs to edit or view
source code.")
    (license license:bsd-3)))

;; We use the sources from git instead of the tarball from pypi, because the
;; latter does not include the Cython source file from which bycython.cpp is
;; generated.
(define-public python-editdistance
  (let ((commit "3ea84a7dd3258c76aa3be851ef3d50e59c886846")
        (revision "1"))
    (package
      (name "python-editdistance")
      (version (string-append "0.3.1-" revision "." (string-take commit 7)))
      (source
       (origin
         (method git-fetch)
         (uri (git-reference
               (url "https://github.com/aflc/editdistance.git")
               (commit commit)))
         (file-name (git-file-name name version))
         (sha256
          (base32
           "1l43svsv12crvzphrgi6x435z6xg8m086c64armp8wzb4l8ccm7g"))))
      (build-system python-build-system)
      (arguments
       `(#:phases
         (modify-phases %standard-phases
           (add-after 'unpack 'build-cython-code
             (lambda _
               (with-directory-excursion "editdistance"
                 (delete-file "bycython.cpp")
                 (invoke "cython" "--cplus" "bycython.pyx")))))))
      (native-inputs
       `(("python-cython" ,python-cython)))
      (home-page "https://www.github.com/aflc/editdistance")
      (synopsis "Fast implementation of the edit distance (Levenshtein distance)")
      (description
       "This library simply implements Levenshtein distance algorithm with C++
and Cython.")
      (license license:expat))))

(define-public go-github.com-mattn-go-runewidth
  (let ((commit "703b5e6b11ae25aeb2af9ebb5d5fdf8fa2575211")
        (version "0.0.4")
        (revision "1"))
    (package
      (name "go-github.com-mattn-go-runewidth")
      (version (git-version version revision commit))
      (source
       (origin
         (method git-fetch)
         (uri (git-reference
               (url "https://github.com/mattn/runewidth")
               (commit commit)))
         (file-name (git-file-name name version))
         (sha256
          (base32
           "0znpyz71gajx3g0j2zp63nhjj2c07g16885vxv4ykwnrfmzbgk4w"))))
      (build-system go-build-system)
      (arguments
       '(#:import-path "github.com/mattn/go-runewidth"))
      (synopsis "@code{runewidth} provides Go functions to work with string widths")
      (description
       "The @code{runewidth} library provides Go functions for padding,
measuring and checking the width of strings, with support for East Asian
text.")
      (home-page "https://github.com/mattn/runewidth")
      (license license:expat))))

(define-public docx2txt
  (package
    (name "docx2txt")
    (version "1.4")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "mirror://sourceforge/docx2txt/docx2txt/v"
                    version "/docx2txt-" version ".tgz"))
              (sha256
               (base32
                "06vdikjvpj6qdb41d8wzfnyj44jpnknmlgbhbr1w215420lpb5xj"))))
    (build-system gnu-build-system)
    (inputs
     `(("unzip" ,unzip)
       ("perl" ,perl)))
    (arguments
     `(#:tests? #f                      ; No tests.
       #:make-flags (list (string-append "BINDIR="
                                         (assoc-ref %outputs "out") "/bin")
                          (string-append "CONFIGDIR="
                                         (assoc-ref %outputs "out") "/etc")
                          ;; Makefile seems to be a bit dumb at guessing.
                          (string-append "INSTALL=install")
                          (string-append "PERL=perl"))
       #:phases
       (modify-phases %standard-phases
         (delete 'configure)
         (add-after 'install 'fix-install
           (lambda* (#:key outputs inputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (bin (string-append out "/bin"))
                    (config (string-append out "/etc/docx2txt.config"))
                    (unzip (assoc-ref inputs "unzip")))
               ;; According to INSTALL, the .sh wrapper can be skipped.
               (delete-file (string-append bin "/docx2txt.sh"))
               (rename-file (string-append bin "/docx2txt.pl")
                            (string-append bin "/docx2txt"))
               (substitute* config
                 (("config_unzip         => '/usr/bin/unzip',")
                  (string-append "config_unzip         => '"
                                 unzip
                                 "/bin/unzip',")))
               ;; Makefile is wrong.
               (chmod config #o644)
               #t))))))
    (synopsis "Recover text from @file{.docx} files, with good formatting")
    (description
     "@command{docx2txt} is a Perl based command line utility to convert
Microsoft Office @file{.docx} documents to equivalent text documents.  Latest
version supports following features during text extraction.

@itemize
@item Character conversions; currency characters are converted to respective
names like Euro.
@item Capitalisation of text blocks.
@item Center and right justification of text fitting in a line of
(configurable) 80 columns.
@item Horizontal ruler, line breaks, paragraphs separation, tabs.
@item Indicating hyperlinked text along with the hyperlink (configurable).
@item Handling (bullet, decimal, letter, roman) lists along with (attempt at)
indentation.
@end itemize\n")
    (home-page "http://docx2txt.sourceforge.net")
    (license license:gpl3+)))

(define-public odt2txt
  (package
    (name "odt2txt")
    (version "0.5")
    (source
      (origin
        (method git-fetch)
        (uri (git-reference
               (url "https://github.com/dstosberg/odt2txt/")
               (commit (string-append "v" version))))
        (file-name (git-file-name name version))
        (sha256
         (base32
          "0im3kzvhxkjlx57w6h13mc9584c74ma1dyymgvpq2y61av3gc35v"))))
    (build-system gnu-build-system)
    (arguments
     `(#:tests? #f ; no make check
       #:make-flags (list "CC=gcc"
                          (string-append "DESTDIR=" (assoc-ref %outputs "out")))
       #:phases
       (modify-phases %standard-phases
         ;; no configure script
         (delete 'configure))))
    (inputs
     `(("zlib" ,zlib)))
    (home-page "https://github.com/dstosberg/odt2txt/")
    (synopsis "Converter from OpenDocument Text to plain text")
    (description "odt2txt is a command-line tool which extracts the text out
of OpenDocument Texts, as produced by OpenOffice.org, KOffice, StarOffice and
others.

odt2txt can also extract text from some file formats similar to OpenDocument
Text, such as OpenOffice.org XML (*.sxw), which was used by OpenOffice.org
version 1.x and older StarOffice versions.  To a lesser extent, odt2txt may be
useful to extract content from OpenDocument spreadsheets (*.ods) and
OpenDocument presentations (*.odp).")
    (license license:gpl2)))

(define-public opencc
  (package
    (name "opencc")
    (version "1.0.5")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
              (url "https://github.com/BYVoid/OpenCC")
              (commit (string-append "ver." version))))
       (file-name (git-file-name name version))
       (sha256
        (base32
         "1pv5md225qwhbn8ql932zdg6gh1qlx3paiajaks8gfsa07yzvhr4"))
       (modules '((guix build utils)))
       (snippet
        '(begin
           ;; TODO: Unbundle tclap, darts-clone, gtest
           (delete-file-recursively "deps/rapidjson-0.11") #t))))
    (build-system cmake-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'patch-3rd-party-references
           (lambda* (#:key inputs #:allow-other-keys)
             (let ((rapidjson (assoc-ref inputs "rapidjson")))
               (substitute* "src/CMakeLists.txt"
                 (("../deps/rapidjson-0.11")
                  (string-append rapidjson "/include/rapidjson")))
             #t))))))
    (native-inputs
     `(("python" ,python-wrapper)
       ("rapidjson" ,rapidjson)))
    (home-page "https://github.com/BYVoid/OpenCC")
    (synopsis "Convert between Traditional Chinese and Simplified Chinese")
    (description "Open Chinese Convert (OpenCC) converts between Traditional
Chinese and Simplified Chinese, supporting character-level conversion,
phrase-level conversion, variant conversion, and regional idioms among
Mainland China, Taiwan, and Hong-Kong.")
    (license license:asl2.0)))

(define-public nkf
  (let ((commit "08043eadf4abdddcf277842217e3c77a24740dc2")
        (revision "1"))
    (package
      (name "nkf")
      ;; The commits corresponding to specific versions are published
      ;; here:
      ;; https://ja.osdn.net/projects/nkf/scm/git/nkf/
      (version "2.1.5")
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/nurse/nkf.git")
                      (commit commit)))
                (file-name (git-file-name name version))
                (sha256
                 (base32
                  "0anw0knr1iy4p9w3d3b3pbwzh1c43p1i2q4c28kw9zviw8kx2rly"))))
      (build-system gnu-build-system)
      (arguments
       `(#:tests? #f ; test for perl module
         #:make-flags (list "CC=gcc" "CFLAGS=-O2 -Wall -pedantic"
                            (string-append "prefix=" %output)
                            "MKDIR=mkdir -p")
         #:phases
         (modify-phases %standard-phases
           (delete 'configure)))) ; No ./configure script
      (home-page "https://ja.osdn.net/projects/nkf/")
      (synopsis "Network Kanji Filter")
      (description "Nkf is yet another kanji code converter among networks,
hosts and terminals.  It converts input kanji code to designated kanji code
such as ISO-2022-JP, Shift_JIS, EUC-JP, UTF-8, UTF-16 or UTF-32.")
      (license license:zlib))))

(define-public python-pandocfilters
  (package
    (name "python-pandocfilters")
    (version "1.4.2")
    (source
     (origin
       (method url-fetch)
       (uri (pypi-uri "pandocfilters" version))
       (sha256
        (base32
         "1a8d9b7s48gmq9zj0pmbyv2sivn5i7m6mybgpkk4jm5vd7hp1pdk"))))
    (build-system python-build-system)
    (home-page "https://github.com/jgm/pandocfilters")
    (synopsis "Python module for writing Pandoc filters")
    (description "Pandoc is a powerful utility to transform various
input formats into a wide range of output formats.  To alter the
exported output document, Pandoc allows the usage of filters, which
are pipes that read a JSON serialization of the Pandoc AST from stdin,
transform it in some way, and write it to stdout.  It allows therefore
to alter the processing of Pandoc's supported input formats, for
instance one can add new syntax elements to markdown, etc.

This package provides Python bindings.")
    (license license:bsd-3)))

(define-public aha
  (package
    (name "aha")
    (version "0.5")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/theZiz/aha")
             (commit version)))
       (sha256
        (base32
         "0byml4rmpiaalwx69jcixl3yvpvwmwiss1jzgsqwshilb2p4qnmz"))
       (file-name (git-file-name name version))))
    (build-system gnu-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (delete 'configure))
       #:make-flags (list "CC=gcc"
                          (string-append "PREFIX="
                                         (assoc-ref %outputs "out")))
       ;; no check target
       #:tests? #f))
    (home-page "https://github.com/theZiz/aha")
    (synopsis "Converts terminal escape sequences to HTML")
    (description "@command{aha} (Ansi Html Adapter) converts ANSI escape sequences
of a Unix terminal to HTML code.")
    (license (list license:lgpl2.0+ license:mpl1.1))))