code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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/licenses/>.

(define-module (gnu packages rush)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (guix licenses)
  #:use-module (gnu packages))

(define-public rush
  (package
    (name "rush")
    (version "1.8")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/rush/rush-"
                                 version ".tar.gz"))
             (sha256
              (base32
               "1vxdb81ify4xcyygh86250pi50krb16dkj42i5ii4ns3araiwckz"))))
    (build-system gnu-build-system)
    (home-page "https://www.gnu.org/software/rush/")
    (synopsis "Restricted user (login) shell")
    (description
     "GNU Rush is a restricted user shell, for systems on which users are to
be provided with only limited functionality or resources.  Administrators set
user rights via a configuration file which can be used to limit, for example,
the commands that can be executed, CPU time, or virtual memory usage.")
    (license gpl3+)))

license: mit


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016 Eric Le Bihan <eric.le.bihan.dev@free.fr>
;;; Copyright © 2016 Nils Gillmann <ng0@n0.is>
;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2017, 2018 Nikolai Merinov <nikolai.merinov@member.fsf.org>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Danny Milosavljevic <dannym+a@scratchpost.org>
;;;
;;; 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/licenses/>.

(define-module (gnu packages rust)
  #:use-module (gnu packages base)
  #:use-module (gnu packages bison)
  #:use-module (gnu packages bootstrap)
  #:use-module (gnu packages cmake)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages curl)
  #:use-module (gnu packages elf)
  #:use-module (gnu packages flex)
  #:use-module (gnu packages gcc)
  #:use-module (gnu packages gdb)
  #:use-module (gnu packages jemalloc)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages llvm)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages python)
  #:use-module (gnu packages ssh)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages version-control)
  #:use-module (gnu packages)
  #:use-module (guix build-system cargo)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system trivial)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module ((guix build utils) #:select (alist-replace))
  #:use-module (guix utils)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-26))

(define %cargo-reference-project-file "/dev/null")
(define %cargo-reference-hash
  "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")

(define* (nix-system->gnu-triplet-for-rust
          #:optional (system (%current-system)))
  (match system
    ("x86_64-linux"   "x86_64-unknown-linux-gnu")
    ("i686-linux"     "i686-unknown-linux-gnu")
    ("armhf-linux"    "armv7-unknown-linux-gnueabihf")
    ("aarch64-linux"  "aarch64-unknown-linux-gnu")
    ("mips64el-linux" "mips64el-unknown-linux-gnuabi64")
    (_                (nix-system->gnu-triplet system))))

(define rust-bootstrap
  (package
    (name "rust-bootstrap")
    (version "1.22.1")
    (source #f)
    (build-system gnu-build-system)
    (native-inputs
     `(("patchelf" ,patchelf)))
    (inputs
     `(("gcc" ,(canonical-package gcc))
       ("gcc:lib" ,(canonical-package gcc) "lib")
       ("zlib" ,zlib)
       ("source"
        ,(origin
           (method url-fetch)
           (uri (string-append
                 "https://static.rust-lang.org/dist/"
                 "rust-" version "-" (nix-system->gnu-triplet-for-rust)
                 ".tar.gz"))
           (sha256
            (base32
             (match (nix-system->gnu-triplet-for-rust)
               ("i686-unknown-linux-gnu"
                "15zqbx86nm13d5vq2gm69b7av4vg479f74b5by64hs3bcwwm08pr")
               ("x86_64-unknown-linux-gnu"
                "1yll78x6b3abnvgjf2b66gvp6mmcb9y9jdiqcwhmgc0z0i0fix4c")
               ("armv7-unknown-linux-gnueabihf"
                "138a8l528kzp5wyk1mgjaxs304ac5ms8vlpq0ggjaznm6bn2j7a5")
               ("aarch64-unknown-linux-gnu"
                "0z6m9m1rx4d96nvybbfmpscq4dv616m615ijy16d5wh2vx0p4na8")
               ("mips64el-unknown-linux-gnuabi64"
                "07k4pcv7jvfa48cscdj8752lby7m7xdl88v3a6na1vs675lhgja2")
               (_ ""))))))))
    (outputs '("out" "cargo"))
    (arguments
     `(#:tests? #f
       #:strip-binaries? #f
       #:phases
       (modify-phases %standard-phases
         (delete 'configure)
         (delete 'build)
         (replace 'install
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (cargo-out (assoc-ref outputs "cargo"))
                    (gcc:lib (assoc-ref inputs "gcc:lib"))
                    (libc (assoc-ref inputs "libc"))
                    (zlib (assoc-ref inputs "zlib"))
                    (ld-so (string-append libc ,(glibc-dynamic-linker)))
                    (rpath (string-append out "/lib:" zlib "/lib:"
                                          libc "/lib:" gcc:lib "/lib"))
                    (cargo-rpath (string-append cargo-out "/lib:" libc "/lib:"
                                                gcc:lib "/lib"))
                    (rustc (string-append out "/bin/rustc"))
                    (rustdoc (string-append out "/bin/rustdoc"))
                    (cargo (string-append cargo-out "/bin/cargo"))
                    (gcc (assoc-ref inputs "gcc")))
               ;; Install rustc/rustdoc.
               (invoke "bash" "install.sh"
                        (string-append "--prefix=" out)
                        (string-append "--components=rustc,"
                                       "rust-std-"
                                       ,(nix-system->gnu-triplet-for-rust)))
               ;; Install cargo.
               (invoke "bash" "install.sh"
                        (string-append "--prefix=" cargo-out)
                        (string-append "--components=cargo"))
               (for-each (lambda (file)
                           (invoke "patchelf" "--set-rpath" rpath file))
                         (cons* rustc rustdoc (find-files out "\\.so$")))
               (invoke "patchelf" "--set-rpath" cargo-rpath cargo)
               (for-each (lambda (file)
                           (invoke "patchelf" "--set-interpreter" ld-so file))
                         (list rustc rustdoc cargo))
               #t))))))
    (home-page "https://www.rust-lang.org")
    (synopsis "Prebuilt rust compiler and cargo package manager")
    (description "This package provides a pre-built @command{rustc} compiler
and a pre-built @command{cargo} package manager, which can
in turn be used to build the final Rust.")
    (license license:asl2.0)))

(define* (rust-source version hash #:key (patches '()))
  (origin
    (method url-fetch)
    (uri (string-append "https://static.rust-lang.org/dist/"
                        "rustc-" version "-src.tar.gz"))
    (sha256 (base32 hash))
    (modules '((guix build utils)))
    (snippet '(begin (delete-file-recursively "src/llvm") #t))
    (patches (map search-patch patches))))

(define* (rust-bootstrapped-package base-rust version checksum
                                    #:key (patches '()))
  "Bootstrap rust VERSION with source checksum CHECKSUM patched with PATCHES using BASE-RUST."
  (package
    (inherit base-rust)
    (version version)
    (source
     (rust-source version checksum #:patches patches))
    (native-inputs
     (alist-replace "cargo-bootstrap" (list base-rust "cargo")
                    (alist-replace "rustc-bootstrap" (list base-rust)
                                   (package-native-inputs base-rust))))))

(define-public mrustc
  (let ((rustc-version "1.19.0"))
    (package
      (name "mrustc")
      (version "0.8.0")
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/thepowersgang/mrustc.git")
                      (commit (string-append "v" version))))
                (file-name (git-file-name name version))
                (sha256
                 (base32
                  "0a7v8ccyzp1sdkwni8h1698hxpfz2sxhcpx42n6l2pbm0rbjp08i"))))
      (outputs '("out" "cargo"))
      (build-system gnu-build-system)
      (inputs
       `(("llvm" ,llvm-3.9.1)))
      (native-inputs
       `(("bison" ,bison)
         ("flex" ,flex)
         ;; Required for the libstd sources.
         ("rustc"
          ,(rust-source "1.19.0" "0l8c14qsf42rmkqy92ahij4vf356dbyspxcips1aswpvad81y8qm"))))
      (arguments
       `(#:test-target "local_tests"
         #:make-flags (list (string-append "LLVM_CONFIG="
                                           (assoc-ref %build-inputs "llvm")
                                           "/bin/llvm-config"))
         #:phases
         (modify-phases %standard-phases
          (add-after 'unpack 'patch-date
            (lambda _
              (substitute* "Makefile"
               (("shell date") "shell date -d @1"))
              #t))
           (add-after 'patch-date 'unpack-target-compiler
             (lambda* (#:key inputs outputs #:allow-other-keys)
               (substitute* "minicargo.mk"
                 ;; Don't try to build LLVM.
                 (("^[$][(]LLVM_CONFIG[)]:") "xxx:")
                 ;; Build for the correct target architecture.
                 (("^RUSTC_TARGET := x86_64-unknown-linux-gnu")
                  (string-append "RUSTC_TARGET := "
                                 ,(or (%current-target-system)
                                      (nix-system->gnu-triplet-for-rust)))))
               (invoke "tar" "xf" (assoc-ref inputs "rustc"))
               (chdir "rustc-1.19.0-src")
               (invoke "patch" "-p0" "../rust_src.patch")
               (chdir "..")
               #t))
           (replace 'configure
             (lambda* (#:key inputs #:allow-other-keys)
               (setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc"))
               #t))
           (add-after 'build 'build-minicargo
             (lambda _
               (for-each (lambda (target)
                           (invoke "make" "-f" "minicargo.mk" target))
                         '("output/libstd.hir" "output/libpanic_unwind.hir"
                           "output/libproc_macro.hir" "output/libtest.hir"))
               ;; Technically the above already does it - but we want to be clear.
               (invoke "make" "-C" "tools/minicargo")))
           (replace 'install
             (lambda* (#:key inputs outputs #:allow-other-keys)
               (let* ((out (assoc-ref outputs "out"))
                      (bin (string-append out "/bin"))
                      (tools-bin (string-append out "/tools/bin"))
                      (cargo-out (assoc-ref outputs "cargo"))
                      (cargo-bin (string-append cargo-out "/bin"))
                      (lib (string-append out "/lib"))
                      (lib/rust (string-append lib "/mrust"))
                      (gcc (assoc-ref inputs "gcc")))
                 ;; These files are not reproducible.
                 (for-each delete-file (find-files "output" "\\.txt$"))
                 (delete-file-recursively "output/local_tests")
                 (mkdir-p lib)
                 (copy-recursively "output" lib/rust)
                 (mkdir-p bin)
                 (mkdir-p tools-bin)
                 (install-file "bin/mrustc" bin)
                 ;; minicargo uses relative paths to resolve mrustc.
                 (install-file "tools/bin/minicargo" tools-bin)
                 (install-file "tools/bin/minicargo" cargo-bin)
                 #t))))))
      (synopsis "Compiler for the Rust progamming language")
      (description "Rust is a systems programming language that provides memory
safety and thread safety guarantees.")
      (home-page "https://github.com/thepowersgang/mrustc")
      ;; Dual licensed.
      (license (list license:asl2.0 license:expat)))))

(define rust-1.19
  (package
    (name "rust")
    (version "1.19.0")
    (source (rust-source version "0l8c14qsf42rmkqy92ahij4vf356dbyspxcips1aswpvad81y8qm"
            #:patches '("rust-1.19-mrustc.patch")))
    (outputs '("out" "cargo"))
    (arguments
     `(#:imported-modules ,%cargo-build-system-modules ;for `generate-checksums'
       #:modules ((guix build utils) (ice-9 match) (guix build gnu-build-system))
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'set-env
           (lambda* (#:key inputs #:allow-other-keys)
             ;; Disable test for cross compilation support.
             (setenv "CFG_DISABLE_CROSS_TESTS" "1")
             (setenv "SHELL" (which "sh"))
             (setenv "CONFIG_SHELL" (which "sh"))
             (setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc"))
             ;; guix llvm-3.9.1 package installs only shared libraries
             (setenv "LLVM_LINK_SHARED" "1")
             #t))
         (add-after 'unpack 'patch-cargo-tomls
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (substitute* "src/librustc_errors/Cargo.toml"
               (("[[]dependencies[]]") "
[dependencies]
term = \"0.4.4\"
"))
             (substitute* "src/librustc/Cargo.toml"
               (("[[]dependencies[]]") "
[dependencies]
getopts = { path = \"../libgetopts\" }
"))
             (substitute* "src/librustdoc/Cargo.toml"
               (("[[]dependencies[]]") "
[dependencies]
test = { path = \"../libtest\" }
"))
             #t))
         (add-after 'unpack 'patch-tests
           (lambda* (#:key inputs #:allow-other-keys)
             (let ((bash (assoc-ref inputs "bash")))
               (substitute* "src/libstd/process.rs"
                 ;; The newline is intentional.
                 ;; There's a line length "tidy" check in Rust which would
                 ;; fail otherwise.
                 (("\"/bin/sh\"") (string-append "\n\"" bash "/bin/sh\"")))
               (substitute* "src/libstd/net/tcp.rs"
                 ;; There is no network in build environment
                 (("fn connect_timeout_unroutable")
                  "#[ignore]\nfn connect_timeout_unroutable"))
               ;; <https://lists.gnu.org/archive/html/guix-devel/2017-06/msg00222.html>
               (substitute* "src/libstd/sys/unix/process/process_common.rs"
                (("fn test_process_mask") "#[allow(unused_attributes)]
    #[ignore]
    fn test_process_mask"))
               #t)))
         (add-after 'patch-tests 'patch-aarch64-test
           (lambda* _
             (substitute* "src/librustc_back/dynamic_lib.rs"
               ;; This test is known to fail on aarch64 and powerpc64le:
               ;; https://github.com/rust-lang/rust/issues/45410
               (("fn test_loading_cosine") "#[ignore]\nfn test_loading_cosine"))
             #t))
         (add-after 'patch-tests 'use-readelf-for-tests
           (lambda* _
             ;; nm doesn't recognize the file format because of the
             ;; nonstandard sections used by the Rust compiler, but readelf
             ;; ignores them.
             (substitute* "src/test/run-make/atomic-lock-free/Makefile"
               (("\tnm ")
                "\treadelf -c "))
             #t))
         (add-after 'patch-tests 'remove-unsupported-tests
           (lambda* _
             ;; Our ld-wrapper cannot process non-UTF8 bytes in LIBRARY_PATH.
             ;; <https://lists.gnu.org/archive/html/guix-devel/2017-06/msg00193.html>
             (delete-file-recursively "src/test/run-make/linker-output-non-utf8")
             #t))
         (add-after 'patch-source-shebangs 'patch-cargo-checksums
           (lambda* _
             (substitute* "src/Cargo.lock"
               (("(\"checksum .* = )\".*\"" all name)
                (string-append name "\"" ,%cargo-reference-hash "\"")))
             (for-each
              (lambda (filename)
                (use-modules (guix build cargo-build-system))
                (delete-file filename)
                (let* ((dir (dirname filename)))
                  (display (string-append
                            "patch-cargo-checksums: generate-checksums for "
                            dir "\n"))
                  (generate-checksums dir ,%cargo-reference-project-file)))
              (find-files "src/vendor" ".cargo-checksum.json"))
             #t))
         ;; This phase is overridden by newer versions.
         (replace 'configure
           (const #t))
         ;; This phase is overridden by newer versions.
         (replace 'build
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let ((rustc-bootstrap (assoc-ref inputs "rustc-bootstrap")))
               (setenv "CFG_COMPILER_HOST_TRIPLE"
                ,(nix-system->gnu-triplet (%current-system)))
               (setenv "CFG_RELEASE" "")
               (setenv "CFG_RELEASE_CHANNEL" "stable")
               (setenv "CFG_LIBDIR_RELATIVE" "lib")
               (setenv "CFG_VERSION" "1.19.0-stable-mrustc")
               ; bad: (setenv "CFG_PREFIX" "mrustc") ; FIXME output path.
               (mkdir-p "output")
               (invoke (string-append rustc-bootstrap "/tools/bin/minicargo")
                       "src/rustc" "--vendor-dir" "src/vendor"
                       "--output-dir" "output/rustc-build"
                       "-L" (string-append rustc-bootstrap "/lib/mrust")
                       "-j" "1")
               (setenv "CFG_COMPILER_HOST_TRIPLE" #f)
               (setenv "CFG_RELEASE" #f)
               (setenv "CFG_RELEASE_CHANNEL" #f)
               (setenv "CFG_VERSION" #f)
               (setenv "CFG_PREFIX" #f)
               (setenv "CFG_LIBDIR_RELATIVE" #f)
               (invoke (string-append rustc-bootstrap "/tools/bin/minicargo")
                       "src/tools/cargo" "--vendor-dir" "src/vendor"
                       "--output-dir" "output/cargo-build"
                       "-L" "output/"
                       "-L" (string-append rustc-bootstrap "/lib/mrust")
                       "-j" "1")
               ;; Now use the newly-built rustc to build the libraries.
               ;; One day that could be replaced by:
               ;; (invoke "output/cargo-build/cargo" "build"
               ;;         "--manifest-path" "src/bootstrap/Cargo.toml"
               ;;         "--verbose") ; "--locked" "--frozen"
               ;; but right now, Cargo has problems with libstd's circular
               ;; dependencies.
               (mkdir-p "output/target-libs")
               (for-each (match-lambda
                          ((name . flags)
                            (write name)
                            (newline)
                            (apply invoke
                                   "output/rustc-build/rustc"
                                   "-C" (string-append "linker="
                                                       (getenv "CC"))
                                   ;; Required for libterm.
                                   "-Z" "force-unstable-if-unmarked"
                                   "-L" "output/target-libs"
                                   (string-append "src/" name "/lib.rs")
                                   "-o"
                                   (string-append "output/target-libs/"
                                                  (car (string-split name #\/))
                                                  ".rlib")
                                   flags)))
                         '(("libcore")
                           ("libstd_unicode")
                           ("liballoc")
                           ("libcollections")
                           ("librand")
                           ("liblibc/src" "--cfg" "stdbuild")
                           ("libunwind" "-l" "gcc_s")
                           ("libcompiler_builtins")
                           ("liballoc_system")
                           ("libpanic_unwind")
                           ;; Uses "cc" to link.
                           ("libstd" "-l" "dl" "-l" "rt" "-l" "pthread")
                           ("libarena")

                           ;; Test dependencies:

                           ("libgetopts")
                           ("libterm")
                           ("libtest")))
               #t)))
         ;; This phase is overridden by newer versions.
         (replace 'check
           (const #t))
         ;; This phase is overridden by newer versions.
         (replace 'install
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (target-system ,(or (%current-target-system)
                                        (nix-system->gnu-triplet
                                         (%current-system))))
                    (out-libs (string-append out "/lib/rustlib/"
                                             target-system "/lib")))
                                        ;(setenv "CFG_PREFIX" out)
               (mkdir-p out-libs)
               (copy-recursively "output/target-libs" out-libs)
               (install-file "output/rustc-build/rustc"
                             (string-append out "/bin"))
               (install-file "output/rustc-build/rustdoc"
                             (string-append out "/bin"))
               (install-file "output/cargo-build/cargo"
                             (string-append (assoc-ref outputs "cargo")
                                            "/bin")))
             #t)))))
    (build-system gnu-build-system)
    (native-inputs
     `(("bison" ,bison) ; For the tests
       ("cmake" ,cmake)
       ("flex" ,flex) ; For the tests
       ("gdb" ,gdb)   ; For the tests
       ("git" ,git)
       ("procps" ,procps) ; For the tests
       ("python-2" ,python-2)
       ("rustc-bootstrap" ,mrustc)
       ("cargo-bootstrap" ,mrustc "cargo")
       ("pkg-config" ,pkg-config) ; For "cargo"
       ("which" ,which)))
    (inputs
     `(("jemalloc" ,jemalloc-4.5.0)
       ("llvm" ,llvm-3.9.1)
       ("openssl" ,openssl)
       ("libcurl" ,curl))) ; For "cargo"

    ;; rustc invokes gcc, so we need to set its search paths accordingly.
    ;; Note: duplicate its value here to cope with circular dependencies among
    ;; modules (see <https://bugs.gnu.org/31392>).
    (native-search-paths
     (list (search-path-specification
            (variable "C_INCLUDE_PATH")
            (files '("include")))
           (search-path-specification
            (variable "CPLUS_INCLUDE_PATH")
            (files '("include")))
           (search-path-specification
            (variable "LIBRARY_PATH")
            (files '("lib" "lib64")))))

    (synopsis "Compiler for the Rust progamming language")
    (description "Rust is a systems programming language that provides memory
safety and thread safety guarantees.")
    (home-page "https://www.rust-lang.org")
    ;; Dual licensed.
    (license (list license:asl2.0 license:expat))))

(define-public rust-1.20
  (let ((base-rust
         (rust-bootstrapped-package rust-1.19 "1.20.0"
          "0542y4rnzlsrricai130mqyxl8r6rd991frb4qsnwb27yigqg91a")))
    (package
      (inherit base-rust)
      (outputs '("out" "doc" "cargo"))
      (arguments
       (substitute-keyword-arguments (package-arguments rust-1.19)
         ((#:phases phases)
          `(modify-phases ,phases
             (add-after 'patch-tests 'patch-cargo-tests
               (lambda _
                 (substitute* "src/tools/cargo/tests/build.rs"
                  (("/usr/bin/env") (which "env"))
                  ;; Guix llvm is compiled without asmjs-unknown-emscripten.
                  (("fn wasm32_final_outputs") "#[ignore]\nfn wasm32_final_outputs"))
                 (substitute* "src/tools/cargo/tests/death.rs"
                  ;; This is stuck when built in container.
                  (("fn ctrl_c_kills_everyone") "#[ignore]\nfn ctrl_c_kills_everyone"))
                 ;; Prints test output in the wrong order when built on
                 ;; i686-linux.
                 (substitute* "src/tools/cargo/tests/test.rs"
                   (("fn cargo_test_env") "#[ignore]\nfn cargo_test_env"))
                 #t))
             (add-after 'patch-cargo-tests 'ignore-glibc-2.27-incompatible-test
               ;; https://github.com/rust-lang/rust/issues/47863
               (lambda _
                 (substitute* "src/test/run-pass/out-of-stack.rs"
                   (("// ignore-android") "// ignore-test\n// ignore-android"))
                 #t))
             (replace 'configure
               (lambda* (#:key inputs outputs #:allow-other-keys)
                 (let* ((out (assoc-ref outputs "out"))
                        (doc (assoc-ref outputs "doc"))
                        (gcc (assoc-ref inputs "gcc"))
                        (gdb (assoc-ref inputs "gdb"))
                        (binutils (assoc-ref inputs "binutils"))
                        (python (assoc-ref inputs "python-2"))
                        (rustc (assoc-ref inputs "rustc-bootstrap"))
                        (cargo (assoc-ref inputs "cargo-bootstrap"))
                        (llvm (assoc-ref inputs "llvm"))
                        (jemalloc (assoc-ref inputs "jemalloc")))
                   (call-with-output-file "config.toml"
                     (lambda (port)
                       (display (string-append "
[llvm]
[build]
cargo = \"" cargo "/bin/cargo" "\"
rustc = \"" rustc "/bin/rustc" "\"
docs = true
python = \"" python "/bin/python2" "\"
gdb = \"" gdb "/bin/gdb" "\"
vendor = true
submodules = false
[install]
prefix = \"" out "\"
docdir = \"" doc "/share/doc/rust" "\"
sysconfdir = \"etc\"
[rust]
default-linker = \"" gcc "/bin/gcc" "\"
channel = \"stable\"
rpath = true
" ;; There are 2 failed codegen tests:
;; codegen/mainsubprogram.rs and codegen/mainsubprogramstart.rs
;; These tests require a patched LLVM
"codegen-tests = false
[target." ,(nix-system->gnu-triplet-for-rust) "]
llvm-config = \"" llvm "/bin/llvm-config" "\"
cc = \"" gcc "/bin/gcc" "\"
cxx = \"" gcc "/bin/g++" "\"
ar = \"" binutils "/bin/ar" "\"
jemalloc = \"" jemalloc "/lib/libjemalloc_pic.a" "\"
[dist]
") port)))
                   #t)))
             (add-after 'configure 'provide-cc
               (lambda* (#:key inputs #:allow-other-keys)
                 (symlink (string-append (assoc-ref inputs "gcc") "/bin/gcc")
                          "/tmp/cc")
                 (setenv "PATH" (string-append "/tmp:" (getenv "PATH")))
                 #t))
             (add-after 'provide-cc 'configure-archiver
               (lambda* (#:key inputs #:allow-other-keys)
                 (substitute* "src/build_helper/lib.rs"
                  ;; Make sure "ar" is always used as the archiver.
                  (("\"musl\"") "\"\"")
                  ;; Then substitute "ar" by our name.
                  (("\"ar\"") (string-append "\""
                               (assoc-ref inputs "binutils")
                               "/bin/ar\"")))
                 #t))
             (delete 'patch-cargo-tomls)
             (add-before 'build 'reset-timestamps-after-changes
               (lambda* _
                 (for-each
                  (lambda (filename)
                    ;; Rust 1.20.0 treats timestamp 0 as "file doesn't exist".
                    ;; Therefore, use timestamp 1.
                    (utime filename 1 1 1 1))
                  (find-files "." #:directories? #t))
                 #t))
             (replace 'build
               (lambda* _
                 (invoke "./x.py" "build")
                 (invoke "./x.py" "build" "src/tools/cargo")))
             (replace 'check
               (lambda* _
                 ;; Disable parallel execution to prevent EAGAIN errors when
                 ;; running tests.
                 (invoke "./x.py" "-j1" "test" "-vv")
                 (invoke "./x.py" "-j1" "test" "src/tools/cargo")
                 #t))
             (replace 'install
               (lambda* (#:key outputs #:allow-other-keys)
                 (invoke "./x.py" "install")
                 (substitute* "config.toml"
                   ;; replace prefix to specific output
                   (("prefix = \"[^\"]*\"")
                    (string-append "prefix = \"" (assoc-ref outputs "cargo") "\"")))
                 (invoke "./x.py" "install" "cargo")))
             (add-after 'install 'wrap-rustc
               (lambda* (#:key inputs outputs #:allow-other-keys)
                 (let ((out (assoc-ref outputs "out"))
                       (libc (assoc-ref inputs "libc"))
                       (ld-wrapper (assoc-ref inputs "ld-wrapper")))
                   ;; Let gcc find ld and libc startup files.
                   (wrap-program (string-append out "/bin/rustc")
                     `("PATH" ":" prefix (,(string-append ld-wrapper "/bin")))
                     `("LIBRARY_PATH" ":" suffix (,(string-append libc "/lib"))))
                   #t))))))))))

(define-public rust-1.21
  (rust-bootstrapped-package rust-1.20 "1.21.0"
                             "1yj8lnxybjrybp00fqhxw8fpr641dh8wcn9mk44xjnsb4i1c21qp"))

(define-public rust-1.22
  (rust-bootstrapped-package rust-1.21 "1.22.1"
                             "1lrzzp0nh7s61wgfs2h6ilaqi6iq89f1pd1yaf65l87bssyl4ylb"))

(define-public rust-1.23
  (package
    (inherit rust-1.20)
    (name "rust")
    (version "1.23.0")
    (source (rust-source version "14fb8vhjzsxlbi6yrn1r6fl5dlbdd1m92dn5zj5gmzfwf4w9ar3l"))
    (native-inputs
     `(("bison" ,bison) ; For the tests
       ("cmake" ,cmake)
       ("flex" ,flex) ; For the tests
       ("gdb" ,gdb)   ; For the tests
       ("git" ,git)
       ("procps" ,procps) ; For the tests
       ("python-2" ,python-2)
       ("rustc-bootstrap" ,rust-bootstrap)
       ("cargo-bootstrap" ,rust-bootstrap "cargo")
       ("pkg-config" ,pkg-config) ; For "cargo"
       ("which" ,which)))
    (arguments
     (substitute-keyword-arguments (package-arguments rust-1.20)
       ((#:phases phases)
        `(modify-phases ,phases
           (delete 'configure-archiver)
           (add-after 'unpack 'dont-build-native
             (lambda _
               ;; XXX: Revisit this when we use gcc 6.
               (substitute* "src/binaryen/CMakeLists.txt"
                 (("ADD_COMPILE_FLAG\\(\\\"-march=native\\\"\\)") ""))
               #t))))))))

(define-public rust-1.24
  (let ((base-rust
         (rust-bootstrapped-package rust-1.23 "1.24.1"
                                    "1vv10x2h9kq7fxh2v01damdq8pvlp5acyh1kzcda9sfjx12kv99y")))
    (package
      (inherit base-rust)
      (arguments
       (substitute-keyword-arguments (package-arguments base-rust)
         ((#:phases phases)
          `(modify-phases ,phases
             (delete 'use-readelf-for-tests)
             (replace 'patch-aarch64-test
               (lambda* _
                 (substitute* "src/librustc_metadata/dynamic_lib.rs"
                   ;; This test is known to fail on aarch64 and powerpc64le:
                   ;; https://github.com/rust-lang/rust/issues/45410
                   (("fn test_loading_cosine") "#[ignore]\nfn test_loading_cosine"))
                 #t)))))))))

(define-public rust-1.25
  (let ((base-rust
         (rust-bootstrapped-package rust-1.24 "1.25.0"
          "0baxjr99311lvwdq0s38bipbnj72pn6fgbk6lcq7j555xq53mxpf"
          #:patches '("rust-1.25-accept-more-detailed-gdb-lines.patch"))))
    (package
      (inherit base-rust)
      (inputs
       ;; Use LLVM 6.0
       (alist-replace "llvm" (list llvm)
                      (package-inputs base-rust)))
      (arguments
       (substitute-keyword-arguments (package-arguments base-rust)
         ((#:phases phases)
          `(modify-phases ,phases
             (add-after 'patch-cargo-tests 'patch-cargo-index-update
               (lambda _
                 (substitute* "src/tools/cargo/tests/generate-lockfile.rs"
                   ;; This test wants to update the crate index.
                   (("fn no_index_update") "#[ignore]\nfn no_index_update"))
                 #t))
             (add-after 'configure 'enable-codegen-tests
               (lambda _
                 (substitute* "config.toml"
                   (("codegen-tests = false") ""))
                 #t))
             ;; FIXME: Re-enable this test if it's indeed supposed to work.
             ;; See <https://github.com/rust-lang/rust/issues/54178>.
             (add-after 'enable-codegen-tests 'disable-nil-enum-test
               (lambda _
                 (substitute* "src/test/debuginfo/nil-enum.rs"
                   (("ignore-lldb") "ignore-gdb"))
                 #t))
             (replace 'patch-aarch64-test
               (lambda _
                 (substitute* "src/librustc_metadata/dynamic_lib.rs"
                   ;; This test is known to fail on aarch64 and powerpc64le:
                   ;; https://github.com/rust-lang/rust/issues/45410
                   (("fn test_loading_cosine") "#[ignore]\nfn test_loading_cosine"))
                 ;; This test fails on aarch64 with llvm@6.0:
                 ;; https://github.com/rust-lang/rust/issues/49807
                 ;; other possible solution:
                 ;; https://github.com/rust-lang/rust/pull/47688
                 (delete-file "src/test/debuginfo/by-value-self-argument-in-trait-impl.rs")
                 #t))
             (delete 'ignore-glibc-2.27-incompatible-test))))))))

(define-public rust-1.26
  (let ((base-rust
         (rust-bootstrapped-package rust-1.25 "1.26.2"
          "0047ais0fvmqvngqkdsxgrzhb0kljg8wy85b01kbbjc88hqcz7pv"
          #:patches '("rust-coresimd-doctest.patch"
                      "rust-1.25-accept-more-detailed-gdb-lines.patch"))))
    (package
      (inherit base-rust)
      (arguments
       (substitute-keyword-arguments (package-arguments base-rust)
         ((#:phases phases)
          `(modify-phases ,phases
             ;; binaryen was replaced with LLD project from LLVM
             (delete 'dont-build-native)
             (replace 'remove-unsupported-tests
               (lambda* _
                 ;; Our ld-wrapper cannot process non-UTF8 bytes in LIBRARY_PATH.
                 ;; <https://lists.gnu.org/archive/html/guix-devel/2017-06/msg00193.html>
                 (delete-file-recursively "src/test/run-make-fulldeps/linker-output-non-utf8")
                 #t))
             (replace 'patch-cargo-tests
               (lambda* _
                 (substitute* "src/tools/cargo/tests/testsuite/build.rs"
                   (("/usr/bin/env") (which "env"))
                   ;; Guix llvm is compiled without asmjs-unknown-emscripten.
                   (("fn wasm32_final_outputs") "#[ignore]\nfn wasm32_final_outputs"))
                 (substitute* "src/tools/cargo/tests/testsuite/death.rs"
                   ;; This is stuck when built in container.
                   (("fn ctrl_c_kills_everyone") "#[ignore]\nfn ctrl_c_kills_everyone"))
                 ;; Prints test output in the wrong order when built on
                 ;; i686-linux.
                 (substitute* "src/tools/cargo/tests/testsuite/test.rs"
                   (("fn cargo_test_env") "#[ignore]\nfn cargo_test_env"))
                 #t))
             (add-after 'patch-cargo-tests 'disable-cargo-test-for-nightly-channel
               (lambda* _
                 ;; This test failed to work on "nightly" channel builds
                 ;; https://github.com/rust-lang/cargo/issues/5648
                 (substitute* "src/tools/cargo/tests/testsuite/resolve.rs"
                   (("fn test_resolving_minimum_version_with_transitive_deps")
                    "#[ignore]\nfn test_resolving_minimum_version_with_transitive_deps"))
                 #t))
             (replace 'patch-cargo-index-update
               (lambda* _
                 (substitute* "src/tools/cargo/tests/testsuite/generate_lockfile.rs"
                   ;; This test wants to update the crate index.
                   (("fn no_index_update") "#[ignore]\nfn no_index_update"))
                 #t)))))))))

(define-public rust
  (let ((base-rust
         (rust-bootstrapped-package rust-1.26 "1.27.2"
                                    "0pg1s37bhx9zqbynxyydq5j6q7kij9vxkcv8maz0m25prm88r0cs"
                                    #:patches
                                    '("rust-coresimd-doctest.patch"
                                      "rust-bootstrap-stage0-test.patch"
                                      "rust-1.25-accept-more-detailed-gdb-lines.patch"))))
    (package
      (inherit base-rust)
      (arguments
       (substitute-keyword-arguments (package-arguments base-rust)
         ((#:phases phases)
          `(modify-phases ,phases
             (add-before 'install 'mkdir-prefix-paths
               (lambda* (#:key outputs #:allow-other-keys)
                 ;; As result of https://github.com/rust-lang/rust/issues/36989
                 ;; `prefix' directory should exist before `install' call
                 (mkdir-p (assoc-ref outputs "out"))
                 (mkdir-p (assoc-ref outputs "cargo"))
                 #t)))))))))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; 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/licenses/>.

(define-module (gnu packages samba)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (guix licenses)
  #:use-module (guix utils)
  #:use-module (gnu packages acl)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages check)
  #:use-module (gnu packages crypto)
  #:use-module (gnu packages cups)
  #:use-module (gnu packages databases)
  #:use-module (gnu packages docbook)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages popt)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages openldap)
  #:use-module (gnu packages readline)
  #:use-module (gnu packages kerberos)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages python)
  #:use-module (gnu packages xml))

(define-public cifs-utils
  (package
    (name "cifs-utils")
    (version "6.8")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://download.samba.org/pub/linux-cifs/"
                           name "/" name "-" version ".tar.bz2"))
       (sha256 (base32
                "0ygz3pagjpaj5ky11hzh4byyymb7fpmqiqkprn11zwj31h2zdlg7"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("pkg-config" ,pkg-config)))
    (inputs
     `(("keytuils" ,keyutils)
       ("linux-pam" ,linux-pam)
       ("libcap-ng" ,libcap-ng)
       ("mit-krb5" ,mit-krb5)
       ("samba" ,samba)
       ("talloc" ,talloc)))
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         ;; The 6.7 tarball is missing ‘install.sh’. Create it.
         (add-after 'unpack 'autoreconf
           (lambda _
             (invoke "autoreconf" "-i")))
         (add-before 'configure 'set-root-sbin
           (lambda _ ; Don't try to install in "/sbin".
             (setenv "ROOTSBINDIR"
                     (string-append (assoc-ref %outputs "out") "/sbin"))
             #t)))))
    (synopsis "User-space utilities for Linux CIFS (Samba) mounts")
    (description "@code{cifs-utils} is a set of user-space utilities for
mounting and managing @dfn{Common Internet File System} (CIFS) shares using
the Linux kernel CIFS client.")
    (home-page "https://wiki.samba.org/index.php/LinuxCIFS_utils")
    ;; cifs-utils is licensed as GPL3 or later, but 3 files contain LGPL code.
    (license gpl3+)))

(define-public iniparser
  (package
    (name "iniparser")
    (version "4.1")
    (source (origin
             (method url-fetch)
             (uri (string-append "https://github.com/ndevilla/iniparser/archive/v"
                                 version ".tar.gz"))
             (file-name (string-append name "-" version ".tar.gz"))
             (sha256
              (base32
               "1bpk8dj9d5cl64lg6jsk0qlzrpg848nymwxc3fx707fk1n0al3cn"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags
       (list "CC=gcc")
       #:phases
       (modify-phases %standard-phases
         (replace 'configure
           (lambda* (#:key outputs #:allow-other-keys)
             (substitute* '("Makefile" "test/Makefile")
               (("/usr/lib")
                (string-append (assoc-ref outputs "out") "/lib")))
             #t))
         (replace 'build
           (lambda* (#:key make-flags #:allow-other-keys)
             (apply invoke "make" "libiniparser.so.1"
                    make-flags)))
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out  (assoc-ref outputs "out"))
                    (lib  (string-append out "/lib"))
                    (inc  (string-append out "/include"))
                    (doc  (string-append out "/share/doc/" ,name))
                    (html (string-append doc "/html")))
               (define (install dir)
                 (lambda (file)
                   (install-file file dir)))
               (for-each (install lib)
                         (find-files "." "^lib.*\\.so"))
               (with-directory-excursion lib
                 (symlink "libiniparser.so.1" "libiniparser.so"))
               (for-each (install inc)
                         (find-files "src" "\\.h$"))
               (for-each (install html)
                         (find-files "html" ".*"))
               (for-each (install doc)
                         '("AUTHORS" "INSTALL" "LICENSE" "README.md"))
               #t))))))
    (home-page "https://github.com/ndevilla/iniparser")
    (synopsis "Standalone ini file parsing library")
    (description
     "iniparser is a free stand-alone `ini' file parsing library (Windows
configuration files).  It is written in portable ANSI C and should compile
anywhere.")
    (license x11)))

(define-public samba
  (package
    (name "samba")
    (version "4.8.5")
    (source (origin
             (method url-fetch)
             (uri (string-append "https://download.samba.org/pub/samba/stable/"
                                 "samba-" version ".tar.gz"))
             (sha256
              (base32
               "0mailvhjsma19k6b6zjl02z9n2hbbyfybvicjfw2hh9d4sqyd3p5"))))
    (build-system gnu-build-system)
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-before 'configure 'locate-docbook-stylesheets
           (lambda* (#:key inputs #:allow-other-keys)
             ;; XXX for some reason XML_CATALOG_FILES is not respected.
             (substitute* '("buildtools/wafsamba/samba_conftests.py"
                            "buildtools/wafsamba/wafsamba.py"
                            "docs-xml/xslt/man.xsl")
               (("http://docbook.sourceforge.net/release/xsl/current/")
                (string-append (assoc-ref inputs "docbook-xsl")
                               "/xml/xsl/docbook-xsl-"
                               ,(package-version docbook-xsl) "/")))
             #t))
         (replace 'configure
           ;; samba uses a custom configuration script that runs waf.
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out    (assoc-ref outputs "out"))
                    (libdir (string-append out "/lib")))
               (invoke "./configure"
                       "--enable-fhs"
                       ;; XXX: heimdal not packaged.
                       "--bundled-libraries=com_err"
                       (string-append "--prefix=" out)
                       "--sysconfdir=/etc"
                       ;; Install public and private libraries into
                       ;; a single directory to avoid RPATH issues.
                       (string-append "--libdir=" libdir)
                       (string-append "--with-privatelibdir=" libdir)))))
         (add-before 'install 'disable-etc-samba-directory-creation
           (lambda _
             (substitute* "dynconfig/wscript"
               (("bld\\.INSTALL_DIR\\(\"\\$\\{CONFIGDIR\\}\"\\)")
                ""))
             #t)))
       ;; XXX: The test infrastructure attempts to set password with
       ;; smbpasswd, which fails with "smbpasswd -L can only be used by root."
       ;; So disable tests until there's a workaround.
       #:tests? #f))
    (inputs                                   ; TODO: Add missing dependencies
     `(("acl" ,acl)
       ("cups" ,cups)
       ;; ("gamin" ,gamin)
       ("gnutls" ,gnutls)
       ("iniparser" ,iniparser)
       ("libaio" ,libaio)
       ("linux-pam" ,linux-pam)
       ("openldap" ,openldap)
       ("popt" ,popt)
       ("readline" ,readline)
       ("tdb" ,tdb)))
    (propagated-inputs
     ;; In Requires or Requires.private of pkg-config files.
     `(("ldb" ,ldb)
       ("talloc" ,talloc)
       ("tevent" ,tevent)))
    (native-inputs
     `(("docbook-xsl" ,docbook-xsl)    ;for generating manpages
       ("xsltproc" ,libxslt)           ;ditto
       ("perl" ,perl)
       ("pkg-config" ,pkg-config)
       ("python" ,python-2))) ; incompatible with Python 3
    (home-page "https://www.samba.org/")
    (synopsis
     "The standard Windows interoperability suite of programs for GNU and Unix")
    (description
     "Since 1992, Samba has provided secure, stable and fast file and print
services for all clients using the SMB/CIFS protocol, such as all versions of
DOS and Windows, OS/2, GNU/Linux and many others.

Samba is an important component to seamlessly integrate Linux/Unix Servers and
Desktops into Active Directory environments using the winbind daemon.")
    (license gpl3+)))

(define-public talloc
  (package
    (name "talloc")
    (version "2.1.14")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://www.samba.org/ftp/talloc/talloc-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "1kk76dyav41ip7ddbbf04yfydb4jvywzi2ps0z2vla56aqkn11di"))))
    (build-system gnu-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (replace 'configure
           (lambda* (#:key outputs #:allow-other-keys)
             ;; talloc uses a custom configuration script that runs a Python
             ;; script called 'waf', and doesn't tolerate unknown options.
             (setenv "CONFIG_SHELL" (which "sh"))
             (let ((out (assoc-ref outputs "out")))
               (invoke "./configure"
                       (string-append "--prefix=" out))))))))
    (inputs
     `(("python" ,python-2)))
    (home-page "https://talloc.samba.org")
    (synopsis "Hierarchical, reference counted memory pool system")
    (description
     "Talloc is a hierarchical, reference counted memory pool system with
destructors.  It is the core memory allocator used in Samba.")
    (license gpl3+))) ;; The bundled "replace" library uses LGPL3.

(define-public talloc/static
  (package
    (inherit talloc)
    (name "talloc-static")
    (synopsis
     "Hierarchical, reference counted memory pool system (static library)")
    (arguments
     (substitute-keyword-arguments (package-arguments talloc)
       ((#:phases phases)
        ;; Since Waf, the build system talloc uses, apparently does not
        ;; support building static libraries from a ./configure flag, roll our
        ;; own build process.  No need to be ashamed, we're not the only ones
        ;; doing that:
        ;; <https://github.com/proot-me/proot-static-build/blob/master/GNUmakefile>.
        ;; :-)
        `(modify-phases ,phases
           (replace 'build
             (lambda _
               (letrec-syntax ((shell (syntax-rules ()
                                        ((_ (command ...) rest ...)
                                         (and (zero? (system* command ...))
                                              (shell rest ...)))
                                        ((_)
                                         #t))))
                 (shell ("gcc" "-c" "-Ibin/default" "-I" "lib/replace"
                         "-I." "-Wall" "-g" "talloc.c")
                        ("ar" "rc" "libtalloc.a" "talloc.o")))))
           (replace 'install
             (lambda* (#:key outputs #:allow-other-keys)
               (let* ((out     (assoc-ref outputs "out"))
                      (lib     (string-append out "/lib"))
                      (include (string-append out "/include")))
                 (mkdir-p lib)
                 (install-file "libtalloc.a" lib)
                 (install-file "talloc.h" include)
                 #t)))
           (delete 'check)))))))            ;XXX: tests rely on Python modules

(define-public tevent
  (package
    (name "tevent")
    (version "0.9.37")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://www.samba.org/ftp/tevent/tevent-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "1q77vbjic2bb79li2a54ffscnrnwwww55fbpry2kgh7acpnlb0qn"))))
    (build-system gnu-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (replace 'configure
           ;; tevent uses a custom configuration script that runs waf.
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (zero? (system* "./configure"
                               (string-append "--prefix=" out)
                               "--bundled-libraries=NONE"))))))))
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("python" ,python-2)))
    (propagated-inputs
     `(("talloc" ,talloc))) ; required by tevent.pc
    (synopsis "Event system library")
    (home-page "https://tevent.samba.org/")
    (description
     "Tevent is an event system based on the talloc memory management library.
It is the core event system used in Samba.  The low level tevent has support for
many event types, including timers, signals, and the classic file descriptor events.")
    (license lgpl3+)))

(define-public ldb
  (package
    (name "ldb")
    (version "1.3.6")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://www.samba.org/ftp/ldb/ldb-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "16lkz3gyvsm9als1wyimsl573hclr72xy6454mshwjanncs33lji"))
              (modules '((guix build utils)))
              (snippet
               '(begin
                  (for-each (lambda (file)
                              ;; Delete everything except the build tools.
                              (unless (or (string-prefix? "third_party/waf" file)
                                          (string-suffix? "wscript" file))
                                (delete-file file)))
                            (find-files "third_party"))
                  #t))))
    (build-system gnu-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (replace 'configure
           ;; ldb use a custom configuration script that runs waf.
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (zero? (system* "./configure"
                               (string-append "--prefix=" out)
                               (string-append "--with-modulesdir=" out
                                              "/lib/ldb/modules")
                               "--bundled-libraries=NONE"))))))))
    (native-inputs
     `(("cmocka" ,cmocka)
       ("pkg-config" ,pkg-config)
       ("python" ,python-2)))
    (propagated-inputs
     ;; ldb.pc refers to all these.
     `(("talloc" ,talloc)
       ("tdb" ,tdb)))
    (inputs
     `(("popt" ,popt)
       ("tevent" ,tevent)))
    (synopsis "LDAP-like embedded database")
    (home-page "https://ldb.samba.org/")
    (description
     "Ldb is a LDAP-like embedded database built on top of TDB.  What ldb does
is provide a fast database with an LDAP-like API designed to be used within an
application.  In some ways it can be seen as a intermediate solution between
key-value pair databases and a real LDAP database.")
    (license lgpl3+)))

(define-public ppp
  (package
    (name "ppp")
    (version "2.4.7")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://www.samba.org/ftp/ppp/ppp-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "0c7vrjxl52pdwi4ckrvfjr08b31lfpgwf3pp0cqy76a77vfs7q02"))))
    (build-system gnu-build-system)
    (arguments
     '(#:tests? #f ; no check target
       #:make-flags '("CC=gcc")
       #:phases
       (modify-phases %standard-phases
         (add-before 'configure 'patch-Makefile
           (lambda* (#:key inputs #:allow-other-keys)
             (let ((libc    (assoc-ref inputs "libc"))
                   (libpcap (assoc-ref inputs "libpcap")))
               (substitute* "pppd/Makefile.linux"
                 (("/usr/include/crypt\\.h")
                  (string-append libc "/include/crypt.h"))
                 (("/usr/include/pcap-bpf.h")
                  (string-append libpcap "/include/pcap-bpf.h")))
               #t))))))
    (inputs
     `(("libpcap" ,libpcap)))
    (synopsis "Implementation of the Point-to-Point Protocol")
    (home-page "https://ppp.samba.org/")
    (description
     "The Point-to-Point Protocol (PPP) provides a standard way to establish
a network connection over a serial link.  At present, this package supports IP
and IPV6 and the protocols layered above them, such as TCP and UDP.")
    ;; pppd, pppstats and pppdump are under BSD-style notices.
    ;; some of the pppd plugins are GPL'd.
    ;; chat is public domain.
    (license (list bsd-3 bsd-4 gpl2+ public-domain))))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; 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/licenses/>.

(define-module (gnu packages sawfish)
  #:use-module ((guix licenses) #:select (gpl2+))
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages databases)
  #:use-module (gnu packages gettext)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages libffi)
  #:use-module (gnu packages multiprecision)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages readline)
  #:use-module (gnu packages texinfo)
  #:use-module (gnu packages base)
  #:use-module (gnu packages xorg))

(define-public librep
  (package
    (name "librep")
    (version "0.92.7")
    (source (origin
              (method url-fetch)
              (uri (string-append "http://download.tuxfamily.org/" name "/"
                                  name "_" version ".tar.xz"))
              (sha256
               (base32
                "1bmcjl1x1rdh514q9z3hzyjmjmwwwkziipjpjsl301bwmiwrd8a8"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("makeinfo"   ,texinfo)
       ("pkg-config" ,pkg-config)

       ("autoconf" ,autoconf-wrapper)
       ("automake" ,automake)
       ("libtool"  ,libtool)))
    (inputs
     `(("gdbm"     ,gdbm)
       ("gmp"      ,gmp)
       ("libffi"   ,libffi)
       ("readline" ,readline)))
    (native-search-paths
     (list (search-path-specification
            (variable "REP_DL_LOAD_PATH")
            (files '("lib/rep")))))
    (home-page "http://sawfish.wikia.com/wiki/Librep")
    (synopsis "Lisp system for sawfish")
    (description
     "Librep is a dialect of Lisp, designed to be used both as an extension
language for applications and as a general purpose programming language.  It
was originally written to be mostly-compatible with Emacs Lisp, but has
subsequently diverged markedly.  Its aim is to combine the best features of
Scheme and Common Lisp and provide an environment that is comfortable for
implementing both small and large scale systems.")
    (license gpl2+)))

(define-public rep-gtk
  (package
    (name "rep-gtk")
    (version "0.90.8.2")
    (source (origin
              (method url-fetch)
              (uri (string-append "http://download.tuxfamily.org/librep/"
                                  name "/" name "_" version ".tar.xz"))
              (sha256
               (base32
                "0qslm2isyv22hffdpw0nh7xk8jw8cj3h5y7d40c9h5r833w7j6sz"))
              (modules '((guix build utils)))
              (snippet
               '(begin
                  (substitute* "Makefile.in"
                    (("installdir=\\$\\(repexecdir\\)")
                     ;; Install libraries for librep to $out/lib/rep.
                     "installdir=$(libdir)/rep"))
                  #t))))
    (build-system gnu-build-system)
    (arguments '(#:tests? #f)) ; no tests
    (native-inputs
     `(("pkg-config" ,pkg-config)))
    (propagated-inputs
     ;; required by rep-gtk.pc.
     `(("gtk+"   ,gtk+-2)
       ("librep" ,librep)))
    (home-page "http://sawfish.wikia.com/wiki/Rep-GTK")
    (synopsis "GTK+ binding for librep")
    (description
     "Rep-GTK is a GTK+ (and GLib, GDK) binding to the librep, and one of the
backend of Sawfish.")
    (license gpl2+)))

(define-public sawfish
  (package
    (name "sawfish")
    (version "1.11")
    (source (origin
              (method url-fetch)
              (uri (string-append "http://download.tuxfamily.org/sawfish/"
                                  name "_" version ".tar.xz"))
              (sha256
               (base32
                "0wp4m0p836a0rysbcdqb6z5hxlxqj3rgdbks3bs44rlssx0mcvyg"))
              (modules '((guix build utils)))
              (snippet
               '(begin
                  (substitute* "Makedefs.in"
                    (("/bin/sh") "@SHELL@")
                    (("REP_DL_LOAD_PATH=")
                     ;; To find rep-gtk when building sawfish.
                     "REP_DL_LOAD_PATH=$(REP_DL_LOAD_PATH):"))
                  (substitute* "src/Makefile.in"
                    ;; Install libraries for librep to $out/lib/rep.
                    (("\\$\\(repexecdir\\)") "$(libdir)/rep"))
                  #t))))
    (build-system gnu-build-system)
    (arguments
     '(#:tests? #f ; no tests
       #:phases
       (modify-phases %standard-phases
         (add-before 'configure 'patch-exec-rep
           (lambda _
             (substitute* '("lisp/sawfish/cfg/main.jl.in"
                            "scripts/sawfish-about.jl.in"
                            "scripts/sawfish-client.jl"
                            "scripts/sawfish-menu.jl")
               (("exec rep") (string-append "exec " (which "rep"))))
             #t))
         (add-after 'install 'wrap-scripts
           ;; Wrap scripts with REP_DL_LOAD_PATH for finding rep-gtk
           ;; and sawfish.client.
           (lambda* (#:key outputs #:allow-other-keys)
             (define (wrap-script script)
               (let ((out (assoc-ref outputs "out")))
                 (wrap-program (string-append out script)
                   `("REP_DL_LOAD_PATH" =
                     ,(list (getenv "REP_DL_LOAD_PATH")
                            (string-append out "/lib/rep"))))))
             (for-each wrap-script
                       (list "/bin/sawfish-about"
                             "/bin/sawfish-client"
                             "/bin/sawfish-config"
                             "/lib/sawfish/sawfish-menu"))
             #t)))))
    (native-inputs
     `(("gettext"     ,gettext-minimal)
       ("makeinfo"    ,texinfo)
       ("pkg-config"  ,pkg-config)
       ("which"       ,which)))
    (inputs
     `(("libsm"       ,libsm)
       ("libxft"      ,libxft)
       ("libxinerama" ,libxinerama)
       ("libxrandr"   ,libxrandr)
       ("libxtst"     ,libxtst)
       ("rep-gtk"     ,rep-gtk)))
    (home-page "http://sawfish.wikia.com/wiki/Main_Page")
    (synopsis "Configurable window manager")
    (description
     "Sawfish is an extensible window manager using a Lisp-based scripting
language.  Its policy is very minimal compared to most window managers.  Its aim
is simply to manage windows in the most flexible and attractive manner possible.
All high-level WM functions are implemented in Lisp for future extensibility or
redefinition.")
    (license gpl2+)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; 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/licenses/>.

(define-module (gnu packages scanner)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix utils)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages libusb)
  #:use-module ((guix licenses)
                #:prefix licence:))

(define-public sane-backends-minimal
  (package
    (name "sane-backends-minimal")
    (version "1.0.27")
    (source (origin
             (method url-fetch)
             (uri (string-append
                   "https://alioth.debian.org/frs/download.php/latestfile/176/"
                   "sane-backends-" version ".tar.gz"))
             (sha256
              (base32
               "1j9nbqspaj0rlgalafb5z6r606k0i22kz0rcpd744p176yzlfdr9"))
             (modules '((guix build utils)))
             (snippet
              ;; Generated HTML files and udev rules normally embed a
              ;; timestamp.  Work around that to build things reproducibly.
              '(begin
                 (substitute* "tools/sane-desc.c"
                   (("asctime \\(localtime \\(&current_time\\)\\)")
                    "\"1970-01-01\""))
                 #t))))
    (build-system gnu-build-system)
    (native-inputs
     `(("pkg-config" ,pkg-config)))
    (inputs
     `(("libusb-compat" ,libusb-compat)))
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-before 'configure 'disable-backends
           (lambda _
             (setenv "BACKENDS" " ")
             #t))
         ;; Disable unmaintained tests that that fail with errors resembling:
         ;;
         ;; < # by sane-desc 3.5 from sane-backends 1.0.24git on Jul 31 2013
         ;; ---
         ;; > # by sane-desc 3.5 from sane-backends 1.0.27 on 1970-01-01#
         ;; FAIL: sane-desc -m usermap -s ./data
         (add-before 'configure 'disable-failing-tests
           (lambda _
             (for-each
              (lambda (pattern)
                (substitute* "testsuite/tools/Makefile.in"
                  (((string-append " " pattern " ")) " ")))
              (list "usermap" "db" "udev" "udev\\+acl" "udev\\+hwdb" "hwdb"))
             #t))
         (add-after 'install 'install-udev-rules
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (mkdir-p (string-append out "/lib/udev/rules.d"))
               (copy-file "tools/udev/libsane.rules"
                          (string-append out
                                         "/lib/udev/rules.d/"
                                         "60-libsane.rules"))
               #t))))))
    (home-page "http://www.sane-project.org")
    (synopsis
     "Raster image scanner library and drivers, without scanner support")
    (description "SANE stands for \"Scanner Access Now Easy\" and is an API
proving access to any raster image scanner hardware (flatbed scanner,
hand-held scanner, video- and still-cameras, frame-grabbers, etc.).  The
package contains the library, but no drivers.")
    (license licence:gpl2+))) ; plus linking exception

;; This variant links in the hpaio backend, provided by hplip, which adds
;; support for HP scanners whose backends are not maintained by
;; 'sane-backends'. It also builds all of those backends.
(define-public sane-backends
  (package
    (inherit sane-backends-minimal)
    (name "sane-backends")
    (inputs
     `(("hplip" ,(@ (gnu packages cups) hplip-minimal))
       ,@(package-inputs sane-backends-minimal)))
    (arguments
     (substitute-keyword-arguments (package-arguments sane-backends-minimal)
       ((#:phases phases)
        `(modify-phases ,phases
           (delete 'disable-backends)
           (add-after 'unpack 'add-backends
             (lambda _
               (substitute* "backend/dll.conf.in"
                 (("hp5590" all) (format #f "~a~%~a" all "hpaio")))
               #t))
           (add-after 'install 'install-hpaio
             (lambda* (#:key inputs outputs #:allow-other-keys)
               (define hplip (string-append (assoc-ref inputs "hplip")
                                            "/lib/sane"))
               (define out (string-append (assoc-ref outputs "out")
                                          "/lib/sane"))
               (for-each
                (lambda (file)
                  (symlink file (string-append out "/" (basename file))))
                (find-files hplip))
               #t))))))
    (synopsis
     "Raster image scanner library and drivers, with scanner support")
    (description "SANE stands for \"Scanner Access Now Easy\" and is an API
proving access to any raster image scanner hardware (flatbed scanner,
hand-held scanner, video- and still-cameras, frame-grabbers, etc.).  The
package contains the library and drivers.")))