aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
;;; Copyright © 2016-2022, 2024 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/>.

;; Avoid interference.
(unsetenv "http_proxy")

(define-module (test-publish)
  #:use-module (guix scripts publish)
  #:use-module (guix tests)
  #:use-module (guix config)
  #:use-module ((guix utils) #:select (call-with-temporary-directory))
  #:use-module ((guix build utils) #:select (call-with-temporary-output-file))
  #:use-module (gcrypt hash)
  #:use-module (guix store)
  #:use-module (guix derivations)
  #:use-module (guix gexp)
  #:use-module (guix base32)
  #:use-module (guix base64)
  #:use-module ((guix records) #:select (recutils->alist))
  #:use-module ((guix serialization) #:select (restore-file))
  #:use-module (gcrypt pk-crypto)
  #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
  #:use-module (zlib)
  #:use-module (lzlib)
  #:autoload   (zstd) (call-with-zstd-input-port)
  #:use-module (web uri)
  #:use-module (web client)
  #:use-module (web request)
  #:use-module (web response)
  #:use-module ((guix http-client) #:select (http-multiple-get))
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 binary-ports)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (srfi srfi-71)
  #:use-module (ice-9 threads)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim))

(define %store
  (open-connection-for-tests))

(define (zstd-supported?)
  (resolve-module '(zstd) #t #f #:ensure #f))

(define %reference (add-text-to-store %store "ref" "foo"))

(define %item (add-text-to-store %store "item" "bar" (list %reference)))

(define (http-get-body uri)
  (call-with-values (lambda () (http-get uri))
    (lambda (response body) body)))

(define (http-get-port uri)
  (let ((socket (open-socket-for-uri uri)))
    ;; Make sure to use an unbuffered port so that we can then peek at the
    ;; underlying file descriptor via 'call-with-gzip-input-port'.
    (setvbuf socket 'none)
    (call-with-values
        (lambda ()
          (http-get uri #:port socket #:streaming? #t))
      (lambda (response port)
        ;; Don't (setvbuf port 'none) because of <http://bugs.gnu.org/19610>
        ;; (PORT might be a custom binary input port).
        port))))

(define (publish-uri route)
  (string-append "http://localhost:6789" route))

(define-syntax-rule (with-separate-output-ports exp ...)
  ;; Since ports aren't thread-safe in Guile 2.0, duplicate the output and
  ;; error ports to make sure the two threads don't end up stepping on each
  ;; other's toes.
  (with-output-to-port (duplicate-port (current-output-port) "w")
    (lambda ()
      (with-error-to-port (duplicate-port (current-error-port) "w")
        (lambda ()
          exp ...)))))

;; Run a local publishing server in a separate thread.
(with-separate-output-ports
 (call-with-new-thread
  (lambda ()
    (guix-publish "--port=6789" "-C0"))))     ;attempt to avoid port collision

(define (wait-until-ready port)
  ;; Wait until the server is accepting connections.
  (let ((conn (socket PF_INET SOCK_STREAM 0)))
    (let loop ()
      (unless (false-if-exception
               (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
        (loop)))))

(define (wait-for-file file)
  ;; Wait until FILE shows up.
  (let loop ((i 20))
    (cond ((file-exists? file)
           #t)
          ((zero? i)
           (error "file didn't show up" file))
          (else
           (pk 'wait-for-file file)
           (sleep 1)
           (loop (- i 1))))))

(define %gzip-magic-bytes
  ;; Magic bytes of gzip file.
  #vu8(#x1f #x8b))

;; Wait until the two servers are ready.
(wait-until-ready 6789)

;; Initialize the public/private key SRFI-39 parameters.
(%public-key (read-file-sexp %public-key-file))
(%private-key (read-file-sexp %private-key-file))


(test-begin "publish")

(test-equal "/nix-cache-info"
  (format #f "StoreDir: ~a\nWantMassQuery: 0\nPriority: 100\n"
          %store-directory)
  (http-get-body (publish-uri "/nix-cache-info")))

(test-equal "/*.narinfo"
  (let* ((info (query-path-info %store %item))
         (unsigned-info
          (format #f
                  "StorePath: ~a
NarHash: sha256:~a
NarSize: ~d
References: ~a~%"
                  %item
                  (bytevector->nix-base32-string
                   (path-info-hash info))
                  (path-info-nar-size info)
                  (basename (first (path-info-references info)))))
         (signature (base64-encode
                     (string->utf8
                      (canonical-sexp->string
                       (signed-string unsigned-info))))))
    (format #f "~aSignature: 1;~a;~a
URL: nar/~a
Compression: none
FileSize: ~a\n"
            unsigned-info (gethostname) signature
            (basename %item)
            (path-info-nar-size info)))
  (utf8->string
   (http-get-body
    (publish-uri
     (string-append "/" (store-path-hash-part %item) ".narinfo")))))

(test-equal "/*.narinfo pipeline"
  (make-list 500 200)
  ;; Make sure clients can pipeline requests and correct responses, in the
  ;; right order.  See <https://issues.guix.gnu.org/54723>.
  (let* ((uri (string->uri (publish-uri
                            (string-append "/"
                                           (store-path-hash-part %item)
                                           ".narinfo"))))
         (_ expected (http-get uri #:streaming? #f #:decode-body? #f)))
    (http-multiple-get (string->uri (publish-uri ""))
                       (lambda (request response port result)
                         (and (bytevector=? expected
                                            (get-bytevector-n port
                                                              (response-content-length
                                                               response)))
                              (cons (response-code response) result)))
                       '()
                       (make-list 500 (build-request uri))
                       #:batch-size 77)))

(test-equal "/*.narinfo with properly encoded '+' sign"
  ;; See <http://bugs.gnu.org/21888>.
  (let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
         (info (query-path-info %store item))
         (unsigned-info
          (format #f
                  "StorePath: ~a
NarHash: sha256:~a
NarSize: ~d
References: ~%"
                  item
                  (bytevector->nix-base32-string
                   (path-info-hash info))
                  (path-info-nar-size info)))
         (signature (base64-encode
                     (string->utf8
                      (canonical-sexp->string
                       (signed-string unsigned-info))))))
    (format #f "~aSignature: 1;~a;~a
URL: nar/~a
Compression: none
FileSize: ~a~%"
            unsigned-info (gethostname) signature
            (uri-encode (basename item))
            (path-info-nar-size info)))

  (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
    (utf8->string
     (http-get-body
      (publish-uri
       (string-append "/" (store-path-hash-part item) ".narinfo"))))))

(test-equal "/nar/*"
  "bar"
  (call-with-temporary-output-file
   (lambda (temp port)
     (let ((nar (utf8->string
                 (http-get-body
                  (publish-uri
                   (string-append "/nar/" (basename %item)))))))
       (call-with-input-string nar (cut restore-file <> temp)))
     (call-with-input-file temp read-string))))

(test-equal "/nar/gzip/*"
  "bar"
  (call-with-temporary-output-file
   (lambda (temp port)
     (let ((nar (http-get-port
                 (publish-uri
                  (string-append "/nar/gzip/" (basename %item))))))
       (call-with-gzip-input-port nar
         (cut restore-file <> temp)))
     (call-with-input-file temp read-string))))

(test-equal "/nar/gzip/* is really gzip"
  %gzip-magic-bytes
  ;; Since 'gzdopen' (aka. 'call-with-gzip-input-port') transparently reads
  ;; uncompressed gzip, the test above doesn't check whether it's actually
  ;; gzip.  This is what this test does.  See <https://bugs.gnu.org/30184>.
  (let ((nar (http-get-port
              (publish-uri
               (string-append "/nar/gzip/" (basename %item))))))
    (get-bytevector-n nar (bytevector-length %gzip-magic-bytes))))

(test-equal "/nar/lzip/*"
  "bar"
  (call-with-temporary-output-file
   (lambda (temp port)
     (let ((nar (http-get-port
                 (publish-uri
                  (string-append "/nar/lzip/" (basename %item))))))
       (call-with-lzip-input-port nar
         (cut restore-file <> temp)))
     (call-with-input-file temp read-string))))

(unless (zstd-supported?) (test-skip 1))
(test-equal "/nar/zstd/*"
  "bar"
  (call-with-temporary-output-file
   (lambda (temp port)
     (let ((nar (http-get-port
                 (publish-uri
                  (string-append "/nar/zstd/" (basename %item))))))
       (call-with-zstd-input-port nar
         (cut restore-file <> temp)))
     (call-with-input-file temp read-string))))

(test-equal "/*.narinfo with compression"
  `(("StorePath" . ,%item)
    ("URL" . ,(string-append "nar/gzip/" (basename %item)))
    ("Compression" . "gzip"))
  (let ((thread (with-separate-output-ports
                 (call-with-new-thread
                  (lambda ()
                    (guix-publish "--port=6799" "-C5"))))))
    (wait-until-ready 6799)
    (let* ((url  (string-append "http://localhost:6799/"
                                (store-path-hash-part %item) ".narinfo"))
           (body (http-get-port url)))
      (filter (lambda (item)
                (match item
                  (("Compression" . _) #t)
                  (("StorePath" . _)  #t)
                  (("URL" . _) #t)
                  (_ #f)))
              (recutils->alist body)))))

(test-equal "/*.narinfo with lzip compression"
  `(("StorePath" . ,%item)
    ("URL" . ,(string-append "nar/lzip/" (basename %item)))
    ("Compression" . "lzip"))
  (let ((thread (with-separate-output-ports
                 (call-with-new-thread
                  (lambda ()
                    (guix-publish "--port=6790" "-Clzip"))))))
    (wait-until-ready 6790)
    (let* ((url  (string-append "http://localhost:6790/"
                                (store-path-hash-part %item) ".narinfo"))
           (body (http-get-port url)))
      (filter (lambda (item)
                (match item
                  (("Compression" . _) #t)
                  (("StorePath" . _)  #t)
                  (("URL" . _) #t)
                  (_ #f)))
              (recutils->alist body)))))

(test-equal "/*.narinfo for a compressed file"
  '("none" "nar")          ;compression-less nar
  ;; Assume 'guix publish -C' is already running on port 6799.
  (let* ((item (add-text-to-store %store "fake.tar.gz"
                                  "This is a fake compressed file."))
         (url  (string-append "http://localhost:6799/"
                              (store-path-hash-part item) ".narinfo"))
         (body (http-get-port url))
         (info (recutils->alist body)))
    (list (assoc-ref info "Compression")
          (dirname (assoc-ref info "URL")))))

(test-equal "/*.narinfo with lzip + gzip"
  `((("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/gzip/" (basename %item)))
     ("Compression" . "gzip")
     ("URL" . ,(string-append "nar/lzip/" (basename %item)))
     ("Compression" . "lzip"))
    200
    200)
  (call-with-temporary-directory
   (lambda (cache)
     (let ((thread (with-separate-output-ports
                    (call-with-new-thread
                     (lambda ()
                       (guix-publish "--port=6793" "-Cgzip:2" "-Clzip:2"))))))
       (wait-until-ready 6793)
       (let* ((base "http://localhost:6793/")
              (part (store-path-hash-part %item))
              (url  (string-append base part ".narinfo"))
              (body (http-get-port url)))
         (list (filter (match-lambda
                         (("StorePath" . _) #t)
                         (("URL" . _) #t)
                         (("Compression" . _) #t)
                         (_ #f))
                       (recutils->alist body))
               (response-code
                (http-get (string-append base "nar/gzip/"
                                         (basename %item))))
               (response-code
                (http-get (string-append base "nar/lzip/"
                                         (basename %item))))))))))

(test-equal "custom nar path"
  ;; Serve nars at /foo/bar/chbouib instead of /nar.
  (list `(("StorePath" . ,%item)
          ("URL" . ,(string-append "foo/bar/chbouib/" (basename %item)))
          ("Compression" . "none"))
        200
        404)
  (let ((thread (with-separate-output-ports
                 (call-with-new-thread
                  (lambda ()
                    (guix-publish "--port=6798" "-C0"
                                  "--nar-path=///foo/bar//chbouib/"))))))
    (wait-until-ready 6798)
    (let* ((base    "http://localhost:6798/")
           (part    (store-path-hash-part %item))
           (url     (string-append base part ".narinfo"))
           (nar-url (string-append base "foo/bar/chbouib/"
                                   (basename %item)))
           (body    (http-get-port url)))
      (list (filter (lambda (item)
                      (match item
                        (("Compression" . _) #t)
                        (("StorePath" . _)  #t)
                        (("URL" . _) #t)
                        (_ #f)))
                    (recutils->alist body))
            (response-code (http-get nar-url))
            (response-code
             (http-get (string-append base "nar/" (basename %item))))))))

(test-equal "/nar/ with properly encoded '+' sign"
  "Congrats!"
  (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
    (call-with-temporary-output-file
     (lambda (temp port)
       (let ((nar (utf8->string
                   (http-get-body
                    (publish-uri
                     (string-append "/nar/" (uri-encode (basename item))))))))
         (call-with-input-string nar (cut restore-file <> temp)))
       (call-with-input-file temp read-string)))))

(test-equal "/nar/invalid"
  404
  (begin
    (call-with-output-file (string-append (%store-prefix) "/invalid")
      (lambda (port)
        (display "This file is not a valid store item." port)))
    (response-code (http-get (publish-uri (string-append "/nar/invalid"))))))

(test-equal "/file/NAME/sha256/HASH"
  "Hello, Guix world!"
  (let* ((data "Hello, Guix world!")
         (hash (call-with-input-string data port-sha256))
         (drv  (run-with-store %store
                 (gexp->derivation "the-file.txt"
                                   #~(call-with-output-file #$output
                                       (lambda (port)
                                         (display #$data port)))
                                   #:hash-algo 'sha256
                                   #:hash hash)))
         (out  (build-derivations %store (list drv))))
    (utf8->string
     (http-get-body
      (publish-uri
       (string-append "/file/the-file.txt/sha256/"
                      (bytevector->nix-base32-string hash)))))))

(test-equal "/file/NAME/sha256/INVALID-NIX-BASE32-STRING"
  404
  (let ((uri (publish-uri
              "/file/the-file.txt/sha256/not-a-nix-base32-string")))
    (response-code (http-get uri))))

(test-equal "/file/NAME/sha256/INVALID-HASH"
  404
  (let ((uri (publish-uri
              (string-append "/file/the-file.txt/sha256/"
                             (bytevector->nix-base32-string
                              (call-with-input-string "" port-sha256))))))
    (response-code (http-get uri))))

(test-equal "with cache"
  (list #t
        `(("StorePath" . ,%item)
          ("URL" . ,(string-append "nar/gzip/" (basename %item)))
          ("Compression" . "gzip"))
        200                                       ;nar/gzip/…
        #t                                        ;Content-Length
        #t                                        ;FileSize
        404)                                      ;nar/…
  (call-with-temporary-directory
   (lambda (cache)
     (let ((thread (with-separate-output-ports
                    (call-with-new-thread
                     (lambda ()
                       (guix-publish "--port=6797" "-C2"
                                     (string-append "--cache=" cache)
                                     "--cache-bypass-threshold=0"))))))
       (wait-until-ready 6797)
       (let* ((base     "http://localhost:6797/")
              (part     (store-path-hash-part %item))
              (url      (string-append base part ".narinfo"))
              (nar-url  (string-append base "nar/gzip/" (basename %item)))
              (cached   (string-append cache "/gzip/" (basename %item)
                                       ".narinfo"))
              (nar      (string-append cache "/gzip/"
                                       (basename %item) ".nar"))
              (response (http-get url)))
         (and (= 404 (response-code response))

              ;; We should get an explicitly short TTL for 404 in this case
              ;; because it's going to become 200 shortly.
              (match (assq-ref (response-headers response) 'cache-control)
                ((('max-age . ttl))
                 (< ttl 3600)))

              (wait-for-file cached)

              ;; Both the narinfo and nar should be world-readable.
              (= #o444 (logand #o444 (stat:perms (lstat cached))))
              (= #o444 (logand #o444 (stat:perms (lstat nar))))

              (let* ((body         (http-get-port url))
                     (compressed   (http-get nar-url))
                     (uncompressed (http-get (string-append base "nar/"
                                                            (basename %item))))
                     (narinfo      (recutils->alist body)))
                (list (file-exists? nar)
                      (filter (lambda (item)
                                (match item
                                  (("Compression" . _) #t)
                                  (("StorePath" . _)  #t)
                                  (("URL" . _) #t)
                                  (_ #f)))
                              narinfo)
                      (response-code compressed)
                      (= (response-content-length compressed)
                         (stat:size (stat nar)))
                      (= (string->number
                          (assoc-ref narinfo "FileSize"))
                         (stat:size (stat nar)))
                      (response-code uncompressed)))))))))

(test-equal "with cache, lzip + gzip"
  '(200 200 404)
  (call-with-temporary-directory
   (lambda (cache)
     (let ((thread (with-separate-output-ports
                    (call-with-new-thread
                     (lambda ()
                       (guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2"
                                     (string-append "--cache=" cache)
                                     "--cache-bypass-threshold=0"))))))
       (wait-until-ready 6794)
       (let* ((base     "http://localhost:6794/")
              (part     (store-path-hash-part %item))
              (url      (string-append base part ".narinfo"))
              (nar-url  (cute string-append "nar/" <> "/"
                              (basename %item)))
              (cached   (cute string-append cache "/" <> "/"
                              (basename %item) ".narinfo"))
              (nar      (cute string-append cache "/" <> "/"
                              (basename %item) ".nar"))
              (response (http-get url)))
         (wait-for-file (cached "gzip"))
         (let* ((body         (http-get-port url))
                (narinfo      (recutils->alist body))
                (uncompressed (string-append base "nar/"
                                             (basename %item))))
           (and (file-exists? (nar "gzip"))
                (file-exists? (nar "lzip"))
                (match (pk 'narinfo/gzip+lzip narinfo)
                  ((("StorePath" . path)
                    _ ...
                    ("Signature" . _)
                    ("URL" . gzip-url)
                    ("Compression" . "gzip")
                    ("FileSize" . (= string->number gzip-size))
                    ("URL" . lzip-url)
                    ("Compression" . "lzip")
                    ("FileSize" . (= string->number lzip-size)))
                   (and (string=? gzip-url (nar-url "gzip"))
                        (string=? lzip-url (nar-url "lzip"))
                        (= gzip-size
                           (stat:size (stat (nar "gzip"))))
                        (= lzip-size
                           (stat:size (stat (nar "lzip")))))))
                (list (response-code
                       (http-get (string-append base (nar-url "gzip"))))
                      (response-code
                       (http-get (string-append base (nar-url "lzip"))))
                      (response-code
                       (http-get uncompressed))))))))))

(let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
                               (random-text))))
  (test-equal "with cache, uncompressed"
    (list #t
          (* 42 3600)                             ;TTL on narinfo
          `(("StorePath" . ,item)
            ("URL" . ,(string-append "nar/" (basename item)))
            ("Compression" . "none"))
          200                                     ;nar/…
          (* 42 3600)                             ;TTL on nar/…
          (path-info-nar-size
           (query-path-info %store item))         ;FileSize
          404)                                    ;nar/gzip/…
    (call-with-temporary-directory
     (lambda (cache)
       (let ((thread (with-separate-output-ports
                      (call-with-new-thread
                       (lambda ()
                         (guix-publish "--port=6796" "-C2" "--ttl=42h"
                                       (string-append "--cache=" cache)
                                       "--cache-bypass-threshold=0"))))))
         (wait-until-ready 6796)
         (let* ((base     "http://localhost:6796/")
                (part     (store-path-hash-part item))
                (url      (string-append base part ".narinfo"))
                (cached   (string-append cache "/none/"
                                         (basename item) ".narinfo"))
                (nar      (string-append cache "/none/"
                                         (basename item) ".nar"))
                (response (http-get url)))
           (and (= 404 (response-code response))

                (wait-for-file cached)
                (let* ((response     (http-get url))
                       (body         (http-get-port url))
                       (compressed   (http-get (string-append base "nar/gzip/"
                                                              (basename item))))
                       (uncompressed (http-get (string-append base "nar/"
                                                              (basename item))))
                       (narinfo      (recutils->alist body)))
                  (list (file-exists? nar)
                        (match (assq-ref (response-headers response)
                                         'cache-control)
                          ((('max-age . ttl)) ttl)
                          (_ #f))

                        (filter (lambda (item)
                                  (match item
                                    (("Compression" . _) #t)
                                    (("StorePath" . _)  #t)
                                    (("URL" . _) #t)
                                    (_ #f)))
                                narinfo)
                        (response-code uncompressed)
                        (match (assq-ref (response-headers uncompressed)
                                         'cache-control)
                          ((('max-age . ttl)) ttl)
                          (_ #f))

                        (string->number
                         (assoc-ref narinfo "FileSize"))
                        (response-code compressed))))))))))

(test-equal "with cache, vanishing item"         ;<https://bugs.gnu.org/33897>
  200
  (call-with-temporary-directory
   (lambda (cache)
     (let ((thread (with-separate-output-ports
                    (call-with-new-thread
                     (lambda ()
                       (guix-publish "--port=6795"
                                     (string-append "--cache=" cache)))))))
       (wait-until-ready 6795)

       ;; Make sure that, even if ITEM disappears, we're still able to fetch
       ;; it.
       (let* ((base     "http://localhost:6795/")
              (item     (add-text-to-store %store "random" (random-text)))
              (part     (store-path-hash-part item))
              (url      (string-append base part ".narinfo"))
              (cached   (string-append cache "/gzip/"
                                       (basename item)
                                       ".narinfo"))
              (response (http-get url)))
         (and (= 200 (response-code response))    ;we're below the threshold
              (wait-for-file cached)
              (begin
                (delete-paths %store (list item))
                (response-code (pk 'response (http-get url))))))))))

(test-equal "with cache, cache bypass"
  200
  (call-with-temporary-directory
   (lambda (cache)
     (let ((thread (with-separate-output-ports
                    (call-with-new-thread
                     (lambda ()
                       (guix-publish "--port=6788" "-C" "gzip"
                                     (string-append "--cache=" cache)))))))
       (wait-until-ready 6788)

       (let* ((base     "http://localhost:6788/")
              (item     (add-text-to-store %store "random" (random-text)))
              (part     (store-path-hash-part item))
              (narinfo  (string-append base part ".narinfo"))
              (nar      (string-append base "nar/gzip/" (basename item)))
              (cached   (string-append cache "/gzip/" (basename item)
                                       ".narinfo")))
         ;; We're below the default cache bypass threshold, so NAR and NARINFO
         ;; should immediately return 200.  The NARINFO request should trigger
         ;; caching, and the next request to NAR should return 200 as well.
         (and (let ((response (pk 'r1 (http-get nar))))
                (and (= 200 (response-code response))
                     (not (response-content-length response)))) ;not known
              (= 200 (response-code (http-get narinfo)))
              (begin
                (wait-for-file cached)
                (let ((response (pk 'r2 (http-get nar))))
                  (and (> (response-content-length response)
                          (stat:size (stat item)))
                       (response-code response))))))))))

(test-equal "with cache, cache bypass, unmapped hash part"
  200

  ;; This test reproduces the bug described in <https://bugs.gnu.org/44442>:
  ;; the daemon connection would be closed as a side effect of a nar request
  ;; for a non-existing file name.
  (call-with-temporary-directory
   (lambda (cache)
     (let ((thread (with-separate-output-ports
                    (call-with-new-thread
                     (lambda ()
                       (guix-publish "--port=6787" "-C" "gzip"
                                     (string-append "--cache=" cache)))))))
       (wait-until-ready 6787)

       (let* ((base     "http://localhost:6787/")
              (item     (add-text-to-store %store "random" (random-text)))
              (part     (store-path-hash-part item))
              (narinfo  (string-append base part ".narinfo"))
              (nar      (string-append base "nar/gzip/" (basename item)))
              (cached   (string-append cache "/gzip/" (basename item)
                                       ".narinfo")))
         ;; The first response used to be 500 and to terminate the daemon
         ;; connection as a side effect.
         (and (= (response-code
                  (http-get (string-append base "nar/gzip/"
                                           (make-string 32 #\e)
                                           "-does-not-exist")))
                 404)
              (= 200 (response-code (http-get nar)))
              (= 200 (response-code (http-get narinfo)))
              (begin
                (wait-for-file cached)
                (response-code (http-get nar)))))))))

(test-equal "/log/NAME"
  `(200 #t text/plain (gzip))
  (let ((drv (run-with-store %store
               (gexp->derivation "with-log"
                                 #~(call-with-output-file #$output
                                     (lambda (port)
                                       (display "Hello, build log!"
                                                (current-error-port))
                                       (display #$(random-text) port)))))))
    (build-derivations %store (list drv))
    (let* ((response (http-get
                      (publish-uri (string-append "/log/"
                                                  (basename (derivation->output-path drv))))
                      #:decode-body? #f))
           (base     (basename (derivation-file-name drv)))
           (log      (string-append (dirname %state-directory)
                                    "/log/guix/drvs/" (string-take base 2)
                                    "/" (string-drop base 2) ".gz")))
      (list (response-code response)
            (= (response-content-length response) (stat:size (stat log)))
            (first (response-content-type response))
            (response-content-encoding response)))))

(test-equal "negative TTL"
  `(404 42)

  (call-with-temporary-directory
   (lambda (cache)
     (let ((thread (with-separate-output-ports
                    (call-with-new-thread
                     (lambda ()
                       (guix-publish "--port=6786" "-C0"
                                     "--negative-ttl=42s"))))))
       (wait-until-ready 6786)

       (let* ((base     "http://localhost:6786/")
              (url      (string-append base (make-string 32 #\z)
                                       ".narinfo"))
              (response (http-get url)))
         (list (response-code response)
               (match (assq-ref (response-headers response) 'cache-control)
                 ((('max-age . ttl)) ttl)
                 (_ #f))))))))

(test-equal "no negative TTL"
  `(404 #f)
  (let* ((uri      (publish-uri
                    (string-append "/" (make-string 32 #\z)
                                   ".narinfo")))
         (response (http-get uri)))
    (list (response-code response)
          (assq-ref (response-headers response) 'cache-control))))

(test-equal "/log/NAME not found"
  404
  (let ((uri (publish-uri "/log/does-not-exist")))
    (response-code (http-get uri))))

(test-equal "/signing-key.pub"
  200
  (response-code (http-get (publish-uri "/signing-key.pub"))))

(test-equal "non-GET query"
  '(200 404)
  (let ((path (string-append "/" (store-path-hash-part %item)
                             ".narinfo")))
    (map response-code
         (list (http-get (publish-uri path))
               (http-post (publish-uri path))))))

(test-end "publish")
='add' style='width: 0.0%;'/> -rw-r--r--gnu/services/messaging.scm5
-rw-r--r--gnu/services/networking.scm64
-rw-r--r--gnu/services/xorg.scm2
-rw-r--r--gnu/system/examples/bare-bones.tmpl2
-rw-r--r--gnu/system/examples/desktop.tmpl2
-rw-r--r--gnu/system/examples/lightweight-desktop.tmpl2
-rw-r--r--gnu/tests/messaging.scm194
80 files changed, 20673 insertions, 385 deletions
diff --git a/gnu/local.mk b/gnu/local.mk
index db15273eb6..e7db9a6052 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -342,6 +342,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/serveez.scm \
%D%/packages/shells.scm \
%D%/packages/shellutils.scm \
+ %D%/packages/simh.scm \
%D%/packages/skarnet.scm \
%D%/packages/skribilo.scm \
%D%/packages/slang.scm \
@@ -460,6 +461,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/nfs.scm \
%D%/tests/install.scm \
%D%/tests/mail.scm \
+ %D%/tests/messaging.scm \
%D%/tests/ssh.scm \
%D%/tests/web.scm
@@ -633,6 +635,7 @@ dist_patch_DATA = \
%D%/packages/patches/hdf-eos5-fortrantests.patch \
%D%/packages/patches/higan-remove-march-native-flag.patch \
%D%/packages/patches/hop-linker-flags.patch \
+ %D%/packages/patches/hubbub-sort-entities.patch \
%D%/packages/patches/hydra-disable-darcs-test.patch \
%D%/packages/patches/hypre-doc-tables.patch \
%D%/packages/patches/hypre-ldflags.patch \
@@ -765,7 +768,9 @@ dist_patch_DATA = \
%D%/packages/patches/net-tools-bitrot.patch \
%D%/packages/patches/netcdf-date-time.patch \
%D%/packages/patches/netcdf-tst_h_par.patch \
- %D%/packages/patches/netsurf-about.patch \
+ %D%/packages/patches/netsurf-system-utf8proc.patch \
+ %D%/packages/patches/netsurf-y2038-tests.patch \
+ %D%/packages/patches/netsurf-longer-test-timeout.patch \
%D%/packages/patches/ngircd-handle-zombies.patch \
%D%/packages/patches/ngircd-no-dns-in-tests.patch \
%D%/packages/patches/ninja-tests.patch \
@@ -864,7 +869,10 @@ dist_patch_DATA = \
%D%/packages/patches/qemu-CVE-2017-5552.patch \
%D%/packages/patches/qemu-CVE-2017-5578.patch \
%D%/packages/patches/qemu-CVE-2017-5579.patch \
+ %D%/packages/patches/qemu-CVE-2017-5667.patch \
%D%/packages/patches/qemu-CVE-2017-5856.patch \
+ %D%/packages/patches/qemu-CVE-2017-5898.patch \
+ %D%/packages/patches/qemu-CVE-2017-5931.patch \
%D%/packages/patches/qt4-ldflags.patch \
%D%/packages/patches/quickswitch-fix-dmenu-check.patch \
%D%/packages/patches/rapicorn-isnan.patch \
@@ -881,10 +889,12 @@ dist_patch_DATA = \
%D%/packages/patches/ruby-tzinfo-data-ignore-broken-test.patch\
%D%/packages/patches/scheme48-tests.patch \
%D%/packages/patches/scotch-test-threading.patch \
+ %D%/packages/patches/screen-CVE-2017-5618.patch \
%D%/packages/patches/sdl-libx11-1.6.patch \
%D%/packages/patches/seq24-rename-mutex.patch \
%D%/packages/patches/serf-comment-style-fix.patch \
%D%/packages/patches/serf-deflate-buckets-test-fix.patch \
+ %D%/packages/patches/shadow-4.4-su-snprintf-fix.patch \
%D%/packages/patches/slim-session.patch \
%D%/packages/patches/slim-config.patch \
%D%/packages/patches/slim-sigusr1.patch \
@@ -892,6 +902,9 @@ dist_patch_DATA = \
%D%/packages/patches/slim-login.patch \
%D%/packages/patches/slurm-configure-remove-nonfree-contribs.patch \
%D%/packages/patches/soprano-find-clucene.patch \
+ %D%/packages/patches/spice-CVE-2016-9577.patch \
+ %D%/packages/patches/spice-CVE-2016-9578-1.patch \
+ %D%/packages/patches/spice-CVE-2016-9578-2.patch \
%D%/packages/patches/steghide-fixes.patch \
%D%/packages/patches/superlu-dist-scotchmetis.patch \
%D%/packages/patches/swish-e-search.patch \
@@ -936,6 +949,8 @@ dist_patch_DATA = \
%D%/packages/patches/util-linux-tests.patch \
%D%/packages/patches/upower-builddir.patch \
%D%/packages/patches/valgrind-enable-arm.patch \
+ %D%/packages/patches/vdirsyncer-test-suite-slow-machines.patch \
+ %D%/packages/patches/vim-CVE-2017-5953.patch \
%D%/packages/patches/vorbis-tools-CVE-2014-9638+CVE-2014-9639.patch \
%D%/packages/patches/vorbis-tools-CVE-2014-9640.patch \
%D%/packages/patches/vorbis-tools-CVE-2015-6749.patch \
diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index dabb6cae74..baadbe5c60 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -12,7 +12,7 @@
;;; Copyright © 2016, 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Peter Feigl <peter.feigl@nexoid.at>
;;; Copyright © 2016 John J. Foerch <jjfoerch@earthlink.net>
-;;; Coypright © 2016 ng0 <ng0@we.make.ritual.n0.is>
+;;; Coypright © 2016, 2017 ng0 <contact.ng0@cryptolab.net>
;;; Coypright © 2016 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Coypright © 2016 John Darrington <jmd@gnu.org>
;;;
@@ -273,40 +273,41 @@ client and server, a telnet client and server, and an rsh client and server.")
(define-public shadow
(package
(name "shadow")
- (version "4.2.1")
+ (version "4.4")
(source (origin
(method url-fetch)
(uri (string-append
- "http://pkg-shadow.alioth.debian.org/releases/"
- name "-" version ".tar.xz"))
+ "https://github.com/shadow-maint/shadow/releases/"
+ "download/" version "/shadow-" version ".tar.xz"))
+ (patches (search-patches "shadow-4.4-su-snprintf-fix.patch"))
(sha256
(base32
- "0h9x1zdbq0pqmygmc1x459jraiqw4gqz8849v268crk78z8r621v"))))
+ "0g7hf55ar2pafg5g3ldx0fwzjk36wf4xb21p4ndanbjm3c2a9ab1"))))
(build-system gnu-build-system)
(arguments
'(;; Assume System V `setpgrp (void)', which is the default on GNU
;; variants (`AC_FUNC_SETPGRP' is not cross-compilation capable.)
- #:configure-flags '("--with-libpam" "ac_cv_func_setpgrp_void=yes")
+ #:configure-flags
+ '("--with-libpam" "ac_cv_func_setpgrp_void=yes")
- #:phases (alist-cons-before
- 'build 'set-nscd-file-name
- (lambda* (#:key inputs #:allow-other-keys)
- ;; Use the right file name for nscd.
- (let ((libc (assoc-ref inputs "libc")))
- (substitute* "lib/nscd.c"
- (("/usr/sbin/nscd")
- (string-append libc "/sbin/nscd")))))
- (alist-cons-after
- 'install 'remove-groups
- (lambda* (#:key outputs #:allow-other-keys)
- ;; Remove `groups', which is already provided by Coreutils.
- (let* ((out (assoc-ref outputs "out"))
- (bin (string-append out "/bin"))
- (man (string-append out "/share/man")))
- (delete-file (string-append bin "/groups"))
- (for-each delete-file (find-files man "^groups\\."))
- #t))
- %standard-phases))))
+ #:phases
+ (modify-phases %standard-phases
+ (add-before 'build 'set-nscd-file-name
+ (lambda* (#:key inputs #:allow-other-keys)
+ ;; Use the right file name for nscd.
+ (let ((libc (assoc-ref inputs "libc")))
+ (substitute* "lib/nscd.c"
+ (("/usr/sbin/nscd")
+ (string-append libc "/sbin/nscd"))))))
+ (add-after 'install 'remove-groups
+ (lambda* (#:key outputs #:allow-other-keys)
+ ;; Remove `groups', which is already provided by Coreutils.
+ (let* ((out (assoc-ref outputs "out"))
+ (bin (string-append out "/bin"))
+ (man (string-append out "/share/man")))
+ (delete-file (string-append bin "/groups"))
+ (for-each delete-file (find-files man "^groups\\."))
+ #t))))))
(inputs (if (string-suffix? "-linux"
(or (%current-target-system)
@@ -1919,3 +1920,65 @@ in order to be able to find it.
@item @command{sunxi-nand-image-builder}: Prepares raw NAND images.
@end enumerate")
(license license:gpl2+)))
+
+(define-public sedsed
+ (package
+ (name "sedsed")
+ (version "1.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://github.com/aureliojargas/sedsed/"
+ "archive/v" version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ "0139jkqvm8ipiwfj7k69ry2f9b1ffgpk79arpz4r7w9kf6h23bnh"))))
+ (build-system python-build-system)
+ (arguments
+ `(#:tests? #f ; No tests.
+ #:python ,python-2
+ #:phases
+ (modify-phases %standard-phases
+ (add-after 'unpack 'patch-sed-in
+ (lambda _
+ (substitute* "sedsed.py"
+ (("sedbin = 'sed'")
+ (string-append "sedbin = '" (which "sed") "'")))
+ #t))
+ (delete 'build)
+ (replace 'install
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (bin (string-append out "/bin")))
+ ;; Just one file to copy around
+ (install-file "sedsed.py" bin)
+ #t)))
+ (add-after 'install 'symlink
+ ;; Create 'sedsed' symlink to "sedsed.py".
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (bin (string-append out "/bin"))
+ (sed (string-append bin "/sedsed"))
+ (sedpy (string-append bin "/sedsed.py")))
+ (symlink sedpy sed)
+ #t))))))
+ (home-page "http://aurelio.net/projects/sedsed")
+ (synopsis "Sed sed scripts")
+ (description
+ "@code{sedsed} can debug, indent, tokenize and HTMLize your sed(1) script.
+
+In debug mode it reads your script and add extra commands to it. When
+executed you can see the data flow between the commands, revealing all the
+magic sed does on its internal buffers.
+
+In indent mode your script is reformatted with standard spacing.
+
+In tokenize mode you can see the elements of every command you use.
+
+In HTMLize mode your script is converted to a beautiful colored HTML file,
+with all the commands and parameters identified for your viewing pleasure.
+
+With sedsed you can master any sed script. No more secrets, no more hidden
+buffers.")
+ (license license:expat)))
diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm
index 84088a6b52..312fdd4e99 100644
--- a/gnu/packages/audio.scm
+++ b/gnu/packages/audio.scm
@@ -186,7 +186,7 @@ streams from live audio.")
(define-public ardour
(package
(name "ardour")
- (version "5.5")
+ (version "5.6")
(source (origin
(method git-fetch)
(uri (git-reference
@@ -203,7 +203,7 @@ streams from live audio.")
namespace ARDOUR { const char* revision = \"" version "\" ; }")))))
(sha256
(base32
- "1a3whv2dhl073pkd803hcp53rdmm31adjwn40qi06lkjb7rgwrlh"))
+ "1fgvjmvdyh61qn8azpmh19ac58ps5sl2dywwshr56v0svakhwwh9"))
(file-name (string-append name "-" version))))
(build-system waf-build-system)
(arguments
diff --git a/gnu/packages/backup.scm b/gnu/packages/backup.scm
index cc83a2ef79..c2dfc0fbbd 100644
--- a/gnu/packages/backup.scm
+++ b/gnu/packages/backup.scm
@@ -408,13 +408,13 @@ detection, and lossless compression.")
(define-public borg
(package
(name "borg")
- (version "1.0.9")
+ (version "1.0.10")
(source (origin
(method url-fetch)
(uri (pypi-uri "borgbackup" version))
(sha256
(base32
- "1ciwp9yilcibk0x82y5nn8ps95jrm8rxvff8mjrlp7a2w100i1im"))
+ "1sarmpzwr8dhbg0hsvaclcsjfax36ssb32d9klhhah4j8kqji3wp"))
(modules '((guix build utils)))
(snippet
'(for-each
diff --git a/gnu/packages/calendar.scm b/gnu/packages/calendar.scm
index 70d9991659..4726abffde 100644
--- a/gnu/packages/calendar.scm
+++ b/gnu/packages/calendar.scm
@@ -84,13 +84,13 @@ data units.")
(define-public khal
(package
(name "khal")
- (version "0.9.1")
+ (version "0.9.2")
(source (origin
(method url-fetch)
(uri (pypi-uri "khal" version))
(sha256
(base32
- "15rxjphjp46lz7gbs39d1ajd9flnhmhqicjh9bjpx3yi5xx4iawr"))))
+ "1ryh5c7408w8gpql5s9mkxkvz1ngnds3xm43p7r96ynx8prr9swp"))))
(build-system python-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
diff --git a/gnu/packages/crypto.scm b/gnu/packages/crypto.scm
index d7888e6042..fd2b5a36b7 100644
--- a/gnu/packages/crypto.scm
+++ b/gnu/packages/crypto.scm
@@ -314,14 +314,14 @@ no man page, refer to the home page for usage details.")
(define-public tomb
(package
(name "tomb")
- (version "2.2")
+ (version "2.3")
(source (origin
(method url-fetch)
(uri (string-append "https://files.dyne.org/tomb/"
- "tomb-" version ".tar.gz"))
+ "Tomb-" version ".tar.gz"))
(sha256
(base32
- "11msj38fdmymiqcmwq1883kjqi5zr01ybdjj58rfjjrw4zw2w5y0"))))
+ "1j90ab8x4cf10167yw4cs4frz694gb0qwkhgqiz1ly7mnr8ysmby"))))
(build-system gnu-build-system)
(inputs
`(("zsh" ,zsh)
@@ -382,7 +382,7 @@ user's graphical desktop.")
(define-public scrypt
(package
(name "scrypt")
- (version "1.2.0")
+ (version "1.2.1")
(source
(origin
(method url-fetch)
@@ -390,7 +390,7 @@ user's graphical desktop.")
version ".tgz"))
(sha256
(base32
- "1m39hpfby0fdjam842773i5w7pa0qaj7f0r22jnchxsj824vqm0p"))))
+ "0xy5yhrwwv13skv9im9vm76rybh9f29j2dh4hlh2x01gvbkza8a6"))))
(build-system gnu-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm
index f55b1b6d0e..93776c366c 100644
--- a/gnu/packages/databases.scm
+++ b/gnu/packages/databases.scm
@@ -396,14 +396,14 @@ as a drop-in replacement of MySQL.")
(define-public postgresql
(package
(name "postgresql")
- (version "9.5.5")
+ (version "9.5.6")
(source (origin
(method url-fetch)
(uri (string-append "https://ftp.postgresql.org/pub/source/v"
version "/postgresql-" version ".tar.bz2"))
(sha256
(base32
- "157kf6mdazmxfmd11f0akya2xcz6sfgprn7yqc26dpklps855ih2"))))
+ "0bz1b9r249ffjfvldaiah2g78ccwq30ddh8hdvlq61z26inmz7mv"))))
(build-system gnu-build-system)
(arguments
`(#:phases
@@ -1372,7 +1372,7 @@ development.")
(define-public python-pyodbc-c
(package
(name "python-pyodbc-c")
- (version "3.1.2")
+ (version "3.1.4")
(source
(origin
(method url-fetch)
@@ -1380,7 +1380,7 @@ development.")
"archive.tar.gz?ref=v" version))
(sha256
(base32
- "0nl11n3mgrcfnhimjqgv48rxqnb21l5m6s7p8ps2fa4nn4z6rzy0"))
+ "05aq2297k779xidmxcwkrrxjvj1bh2q7d9a1rcjv6zr15y764ga9"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system python-build-system)
(inputs
diff --git a/gnu/packages/dav.scm b/gnu/packages/dav.scm
index dd03d8964b..546597c617 100644
--- a/gnu/packages/dav.scm
+++ b/gnu/packages/dav.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2015, 2016, 2017 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,6 +21,7 @@
#:use-module (guix download)
#:use-module (guix licenses)
#:use-module (guix packages)
+ #:use-module (gnu packages)
#:use-module (gnu packages python))
(define-public radicale
@@ -58,14 +59,21 @@ clients.")
(source (origin
(method url-fetch)
(uri (pypi-uri name version))
+ (patches
+ (search-patches "vdirsyncer-test-suite-slow-machines.patch"))
(sha256
(base32
"044f01fjd8dpz4y9dm3qcc1a8cihcxxbr1sz6y6fkvglpb6k85y5"))))
(build-system python-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
- ;; vdirsyncer requires itself to be installed in order to build
- ;; the manpage.
+ (replace 'check
+ (lambda* (#:key inputs outputs #:allow-other-keys)
+ (add-installed-pythonpath inputs outputs)
+ (setenv "DETERMINISTIC_TESTS" "true")
+ (setenv "DAV_SERVER" "radicale")
+ (setenv "REMOTESTORAGE_SERVER" "skip")
+ (zero? (system* "make" "test"))))
(add-after 'install 'manpage
(lambda* (#:key inputs outputs #:allow-other-keys)
(add-installed-pythonpath inputs outputs)
@@ -74,16 +82,7 @@ clients.")
"docs/_build/man/vdirsyncer.1"
(string-append
(assoc-ref outputs "out")
- "/share/man/man1"))))
- ;; vdirsyncer requires itself to be installed in order to run the test
- ;; suite.
- (delete 'check)
- (add-after 'install 'check-later
- (lambda _
- (setenv "DETERMINISTIC_TESTS" "true")
- (setenv "DAV_SERVER" "radicale")
- (setenv "REMOTESTORAGE_SERVER" "skip")
- (zero? (system* "make" "test")))))))
+ "/share/man/man1")))))))
(native-inputs
`(("python-setuptools-scm" ,python-setuptools-scm)
("python-sphinx" ,python-sphinx)
diff --git a/gnu/packages/disk.scm b/gnu/packages/disk.scm
index 4cf9607a43..ec9632faca 100644
--- a/gnu/packages/disk.scm
+++ b/gnu/packages/disk.scm
@@ -139,11 +139,17 @@ tables, and it understands a variety of different formats.")
;; no install target
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
- (let ((bin (string-append (assoc-ref outputs "out") "/bin")))
+ (let* ((out (assoc-ref outputs "out"))
+ (bin (string-append out "/bin"))
+ (man (string-append out "/share/man/man8")))
(install-file "gdisk" bin)
(install-file "sgdisk" bin)
(install-file "cgdisk" bin)
- (install-file "fixparts" bin)))))))
+ (install-file "fixparts" bin)
+ (install-file "cgdisk.8" man)
+ (install-file "fixparts.8" man)
+ (install-file "gdisk.8" man)
+ (install-file "sgdisk.8" man)))))))
(home-page "http://www.rodsbooks.com/gdisk/")
(synopsis "Low-level GPT disk partitioning and formatting")
(description "GPT fdisk (aka gdisk) is a text-mode partitioning tool that
@@ -296,14 +302,14 @@ and can dramatically shorten the lifespan of the drive if left unchecked.")
(define-public gparted
(package
(name "gparted")
- (version "0.27.0")
+ (version "0.28.0")
(source
(origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/gparted/gparted/gparted-"
version "/gparted-" version ".tar.gz"))
(sha256
- (base32 "1gg7k63jd6128mmzciwqmgixqhyqnninimaqyvjbx1hv0q6gd310"))))
+ (base32 "1w9xsph6fpr7l96b3bxl1bgs94cfp9iisg694h8w3fahihwldzdr"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; Tests require a network connection.
diff --git a/gnu/packages/emacs.scm b/gnu/packages/emacs.scm
index b361fcc4a5..863624fc0f 100644
--- a/gnu/packages/emacs.scm
+++ b/gnu/packages/emacs.scm
@@ -438,7 +438,7 @@ on stdout instead of using a socket as the Emacsclient does.")
(define-public magit
(package
(name "magit")
- (version "2.10.1")
+ (version "2.10.2")
(source (origin
(method url-fetch)
(uri (string-append
@@ -446,7 +446,7 @@ on stdout instead of using a socket as the Emacsclient does.")
version "/" name "-" version ".tar.gz"))
(sha256
(base32
- "1a3gsarl0zrk1dydqn93kx7pnwm7pb7av7g17pj5m7b7kc66k7jv"))))
+ "09qcc3a61irxi89x7q82hdy8dk0liiwyz66632wzcd881mhrhx18"))))
(build-system gnu-build-system)
(native-inputs `(("texinfo" ,texinfo)
("emacs" ,emacs-minimal)))
@@ -574,7 +574,7 @@ support for Git-SVN.")
(file-name (string-append "magit-popup-" version ".el"))
(sha256
(base32
- "0s04jnskmggwn69ln05qfwwa32va0q5ri7dwx917wkqz17w5zi62"))))
+ "08b6ypfiq8zavjfq0wcdh26xziwq7rqvvv3lfpib9101146kzx6d"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-dash" ,emacs-dash)))
@@ -3410,14 +3410,14 @@ passive voice.")
(define-public emacs-org
(package
(name "emacs-org")
- (version "20170124")
+ (version "20170210")
(source (origin
(method url-fetch)
(uri (string-append "http://elpa.gnu.org/packages/org-"
version ".tar"))
(sha256
(base32
- "0mcnjwvily0xv1xl11dj18lg38llvrxja2j9mwn6vql8n5y1srxi"))))
+ "15415wh3w8d4c8hd7qfrfdjnjb1zppmrkg8cdp7hw2ilyr90c0bn"))))
(build-system emacs-build-system)
(home-page "http://orgmode.org/")
(synopsis "Outline-based notes management and organizer")
@@ -3501,6 +3501,30 @@ known loosely as deftheme. Many mode-specific customizations are included.")
"@code{danneskjold-theme} is a high-contrast theme for Emacs.")
(license license:gpl3+))))
+(define-public emacs-dream-theme
+ (let* ((commit "107a11d74365046f28a1802a2bdb5e69e4a7488b")
+ (revision "1"))
+ (package
+ (name "emacs-dream-theme")
+ (version (string-append "0.0.0-" revision "." (string-take commit 7)))
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/djcb/dream-theme")
+ (commit commit)))
+ (file-name (string-append name "-" version "-checkout"))
+ (sha256
+ (base32
+ "0za18nfkq4xqm35k6006vsixcbmvmxqgma4iw5sw37h8vmcsdylk"))))
+ (build-system emacs-build-system)
+ (home-page "https://github.com/djcb/dream-theme")
+ (synopsis "High-contrast Emacs theme")
+ (description
+ "@code{dream-theme} is a dark, clean theme for Emacs. It is inspired
+by zenburn, sinburn and similar themes, but slowly diverging from them.")
+ (license license:gpl3+))))
+
(define-public emacs-auto-complete
(package
(name "emacs-auto-complete")
@@ -3790,3 +3814,23 @@ customizable by the user.")
Additionally it can display the number of unread emails in the
mode-line.")
(license license:gpl3+)))
+
+(define-public emacs-pretty-mode
+ (package
+ (name "emacs-pretty-mode")
+ (version "2.0.3")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "https://github.com/akatov/pretty-mode/"
+ "archive/" version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
+ (sha256
+ (base32
+ "1fan7m4vnqs8kpg7r54kx3g7faadkpkf9kzarfv8n57kq8w157pl"))))
+ (build-system emacs-build-system)
+ (home-page "https://github.com/akatov/pretty-mode")
+ (synopsis "Redisplay parts of the buffer as Unicode symbols")
+ (description
+ "Emacs minor mode for redisplaying parts of the buffer as pretty symbols.")
+ (license license:gpl3+)))
diff --git a/gnu/packages/fonts.scm b/gnu/packages/fonts.scm
index 4105449c89..ce07accbf2 100644
--- a/gnu/packages/fonts.scm
+++ b/gnu/packages/fonts.scm
@@ -1142,3 +1142,51 @@ Holmes type foundry, released under the same license as the Go programming
language. It includes a set of proportional, sans-serif fonts, and a set of
monospace, slab-serif fonts.")
(license (package-license go-1.4)))))
+
+(define-public font-google-material-design-icons
+ (package
+ (name "font-google-material-design-icons")
+ (version "3.0.1")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append
+ "https://github.com/google/material-design-icons/archive/"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "183n0qv3q8w6n27libarq1fhc4mqv2d3sasbfmbn7x9r5pw9c6ga"))
+ (file-name (string-append name "-" version ".tar.gz"))))
+ (build-system trivial-build-system)
+ (native-inputs
+ `(("tar" ,tar)
+ ("gzip" ,gzip)))
+ (arguments
+ `(#:modules ((guix build utils))
+ #:builder (begin
+ (use-modules (guix build utils))
+ (let* ((font-dir (string-append %output
+ "/share/fonts/truetype"))
+ (source (assoc-ref %build-inputs "source"))
+ (font-filename "MaterialIcons-Regular.ttf")
+ (src-ttf-file (string-append "material-design-icons-"
+ ,version
+ "/iconfont/"
+ font-filename))
+ (dest-ttf-file (string-append font-dir font-filename))
+ (gzip (assoc-ref %build-inputs "gzip"))
+ (tar (assoc-ref %build-inputs "tar")))
+ (setenv "PATH" (string-append gzip "/bin:"
+ tar "/bin:"))
+ (system* "tar" "xf" source)
+ (mkdir-p font-dir)
+ (copy-file src-ttf-file dest-ttf-file)))))
+ (home-page "http://google.github.io/material-design-icons")
+ (synopsis "Icon font of Google Material Design icons")
+ (description
+ "Material design system icons are simple, modern, friendly, and sometimes
+quirky. Each icon is created using our design guidelines to depict in simple
+and minimal forms the universal concepts used commonly throughout a UI.
+Ensuring readability and clarity at both large and small sizes, these icons
+have been optimized for beautiful display on all common platforms and display
+resolutions.")
+ (license license:asl2.0)))
diff --git a/gnu/packages/games.scm b/gnu/packages/games.scm
index 0867089d5a..1d6a12a0f6 100644
--- a/gnu/packages/games.scm
+++ b/gnu/packages/games.scm
@@ -10,12 +10,12 @@
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 David Hashe <david.hashe@dhashe.com>
-;;; Copyright © 2015 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2015, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2015, 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2016, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
-;;; Copyright © 2016 Rodger Fox <thylakoid@openmailbox.org>
+;;; Copyright © 2016, 2017 Rodger Fox <thylakoid@openmailbox.org>
;;; Copyright © 2016 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
;;; Copyright © 2016, 2017 ng0 <contact.ng0@cryptolab.net>
;;; Copyright © 2016 Albin Söderqvist <albin@fripost.org>
@@ -227,6 +227,57 @@ them, called Jean Raymond, found an old church in which to hide, not knowing
that beneath its ruins lay buried an ancient evil.")
(license license:gpl3)))
+(define-public angband
+ (package
+ (name "angband")
+ (version "4.0.5")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append "http://rephial.org/downloads/4.0/"
+ "angband-" version ".tar.gz"))
+ (sha256
+ (base32
+ "0lpq2kms7hp421vrasx2bkkn9w08kr581ldwik3v0hlq6h7rlxhd"))
+ (modules '((guix build utils)))
+ (snippet
+ ;; So, some of the sounds/graphics/tilesets are under different
+ ;; licenses... some of them even nonfree! This is a console-only
+ ;; version of this package so we just remove them.
+ ;; In the future, if someone tries to make a graphical variant of
+ ;; this package, they can deal with that mess themselves. :)
+ '(begin
+ (for-each
+ (lambda (subdir)
+ (let ((lib-subdir (string-append "lib/" subdir)))
+ (delete-file-recursively lib-subdir)))
+ '("fonts" "icons" "sounds" "tiles"))
+ (substitute* "lib/Makefile"
+ ;; And don't try to invoke makefiles in the directories we removed
+ (("gamedata customize help screens fonts tiles sounds icons user")
+ "gamedata customize help screens user"))))))
+ (build-system gnu-build-system)
+ (arguments
+ `(#:tests? #f ;no check target
+ #:configure-flags (list (string-append "--bindir=" %output "/bin"))
+ #:phases
+ (modify-phases %standard-phases
+ (add-after 'unpack 'autogen.sh
+ (lambda _
+ (substitute* "acinclude.m4"
+ (("ncursesw5-config") "ncursesw6-config"))
+ (zero? (system* "sh" "autogen.sh")))))))
+ (native-inputs
+ `(("autoconf" ,autoconf)
+ ("automake" ,automake)))
+ (inputs `(("ncurses" ,ncurses)))
+ (home-page "http://rephial.org/")
+ (synopsis "Dungeon exploration roguelike")
+ (description "Angband is a Classic dungeon exploration roguelike. Explore
+the depths below Angband, seeking riches, fighting monsters, and preparing to
+fight Morgoth, the Lord of Darkness.")
+ (license license:gpl2)))
+
(define-public pingus
(package
(name "pingus")
@@ -1243,7 +1294,7 @@ on the screen and keyboard to display letters.")
("ghc-sdl" ,ghc-sdl)
("ghc-sdl-image" ,ghc-sdl-image)
("ghc-sdl-mixer" ,ghc-sdl-mixer)))
- (home-page "http://raincat.bysusanlin.com/")
+ (home-page "http://www.bysusanlin.com/raincat/")
(synopsis "Puzzle game with a cat in lead role")
(description "Project Raincat is a game developed by Carnegie Mellon
students through GCS during the Fall 2008 semester. Raincat features game
@@ -2031,14 +2082,14 @@ are only two levels to play with, but they are very addictive.")
(define-public pioneers
(package
(name "pioneers")
- (version "15.3")
+ (version "15.4")
(source (origin
(method url-fetch)
(uri (string-append "http://downloads.sourceforge.net/pio/"
"pioneers-" version ".tar.gz"))
(sha256
(base32
- "128s718nnraiznbg2rajjqb7cfkdg24hy6spdd9narb4f4dsbbv9"))))
+ "1p1d18hrfmqcnghip3shkzcs5qkz6j99jvkdkqfi7pqdvjc323cs"))))
(build-system gnu-build-system)
(inputs `(("gtk+" ,gtk+)
("librsvg" ,librsvg)
diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm
index 8c099ee0df..b673b3d402 100644
--- a/gnu/packages/gnome.scm
+++ b/gnu/packages/gnome.scm
@@ -3972,7 +3972,7 @@ metadata in photo and video files of various formats.")
(define-public shotwell
(package
(name "shotwell")
- (version "0.25.2")
+ (version "0.25.5")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnome/sources/" name "/"
@@ -3980,7 +3980,7 @@ metadata in photo and video files of various formats.")
name "-" version ".tar.xz"))
(sha256
(base32
- "1bih5hr3pvpkx3fck55bnhngn4fl92ryjizc34wb8pwigbkxnaj1"))))
+ "10pv3v789hky8h7ladqzzmgvkmgy3c41n4xz0nnyjmpycwl26g29"))))
(build-system glib-or-gtk-build-system)
(propagated-inputs
`(("dconf" ,dconf)))
@@ -5036,7 +5036,7 @@ like switching to windows and launching applications.")
(define-public gtk-vnc
(package
(name "gtk-vnc")
- (version "0.6.0")
+ (version "0.7.0")
(source
(origin
(method url-fetch)
@@ -5045,7 +5045,7 @@ like switching to windows and launching applications.")
name "-" version ".tar.xz"))
(sha256
(base32
- "0cq42dghjp4bhsxlj9hd2nz5s5rhd53fx7snmq6i6kg60n438ncm"))))
+ "0gj8dpy3sj4dp810gy67spzh5f0jd8aqg69clcwqjcskj1yawbiw"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--with-gtk=3.0")))
diff --git a/gnu/packages/golang.scm b/gnu/packages/golang.scm
index 9d8dcda545..4bb54f031d 100644
--- a/gnu/packages/golang.scm
+++ b/gnu/packages/golang.scm
@@ -4,7 +4,7 @@
;;; Copyright © 2016 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Petter <petter@mykolab.ch>
-;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -200,7 +200,7 @@ sequential processes (CSP) concurrent programming features added.")
(package
(inherit go-1.4)
(name "go")
- (version "1.7.4")
+ (version "1.7.5")
(source
(origin
(method url-fetch)
@@ -208,7 +208,7 @@ sequential processes (CSP) concurrent programming features added.")
name version ".src.tar.gz"))
(sha256
(base32
- "1k0lnsk5i9swi209wh535lpnpczsh6l8m1pfncmilrdsx48r262c"))))
+ "058q57zmi23rflingzhy1b87yl69mb62ql2psfxqr7q7l89lb0sf"))))
(arguments
(substitute-keyword-arguments (package-arguments go-1.4)
((#:phases phases)
@@ -282,18 +282,7 @@ sequential processes (CSP) concurrent programming features added.")
("os/exec/exec_test.go" "(.+)(TestExtraFilesRace.+)")
("net/lookup_test.go" "(.+)(TestLookupPort.+)")
("syscall/exec_linux_test.go"
- "(.+)(TestCloneNEWUSERAndRemapNoRootDisableSetgroups.+)")
- ;; This test broke when tzdata updated to 2016g:
- ;; https://github.com/golang/go/issues/17276
-
- ;; Applying the upstream patch causes the failure of another
- ;; test, because that test requires upstream's mtimes to be
- ;; preserved, but applying the patch and re-packing the
- ;; tarball causes mtimes to be set to Unix epoch.
- ;; https://github.com/golang/go/issues/17535
-
- ;; TODO Try re-enabling this test for Go > 1.7.3.
- ("time/time_test.go" "(.+)(TestLoadFixed.+)")))
+ "(.+)(TestCloneNEWUSERAndRemapNoRootDisableSetgroups.+)")))
(substitute* "../misc/cgo/testsanitizers/test.bash"
(("(CC=)cc" all var) (string-append var "gcc")))
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 98498ae087..0b12f3e1f8 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
-;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Erik Edrosa <erik.edrosa@gmail.com>
;;; Copyright © 2016 Eraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
@@ -27,7 +27,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages guile)
- #:use-module (guix licenses)
+ #:use-module ((guix licenses) #:prefix license:)
#:use-module (gnu packages)
#:use-module (gnu packages aspell)
#:use-module (gnu packages bash)
@@ -55,8 +55,10 @@
#:use-module (gnu packages sdl)
#:use-module (gnu packages maths)
#:use-module (gnu packages image)
+ #:use-module (gnu packages version-control)
#:use-module (gnu packages xdisorg)
#:use-module (gnu packages xorg)
+ #:use-module (gnu packages zip)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
@@ -129,7 +131,7 @@ the Scheme language which can be easily embedded in other applications to
provide a convenient means of extending the functionality of the application
without requiring the source code to be rewritten.")
(home-page "http://www.gnu.org/software/guile/")
- (license lgpl2.0+)))
+ (license license:lgpl2.0+)))
(define-public guile-2.0
(package
@@ -204,7 +206,7 @@ the Scheme language which can be easily embedded in other applications to
provide a convenient means of extending the functionality of the application
without requiring the source code to be rewritten.")
(home-page "http://www.gnu.org/software/guile/")
- (license lgpl3+)))
+ (license license:lgpl3+)))
(define-public guile-2.0/fixed
;; A package of Guile 2.0 that's rarely changed. It is the one used
@@ -307,6 +309,66 @@ applicable."
(files '("lib/guile/2.0/site-ccache"
"share/guile/site/2.0")))))))
+;; There has not been any release yet.
+(define-public guildhall
+ (let ((commit "2fe2cc539f4b811bbcd69e58738db03eb5a2b778")
+ (revision "1"))
+ (package
+ (name "guildhall")
+ (version (string-append "0-" revision "." (string-take commit 9)))
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/ijp/guildhall.git")
+ (commit commit)))
+ (file-name (string-append name "-" version "-checkout"))
+ (sha256
+ (base32
+ "115bym7bg66h3gs399yb2vkzc2ygriaqsn4zbrg8f054mgy8wzn1"))))
+ (build-system gnu-build-system)
+ (arguments
+ `(#:phases
+ (modify-phases %standard-phases
+ ;; Tests fail without this fix because they try to load the bash
+ ;; executable as a Scheme file. See bug report at
+ ;; https://github.com/ijp/guildhall/issues/22
+ (add-after 'unpack 'fix-bug-22
+ (lambda _
+ (substitute* "Makefile.am"
+ (("TESTS_ENVIRONMENT=.*")
+ "AM_TESTS_ENVIRONMENT=srcdir=$(abs_top_srcdir)/tests/
+TEST_EXTENSIONS = .scm
+SCM_LOG_COMPILER= $(top_builddir)/env $(GUILE)
+AM_SCM_LOG_FLAGS = --no-auto-compile -s")
+ ;; FIXME: one of the database tests fails for unknown
+ ;; reasons. It does not fail when run outside of Guix.
+ (("tests/database.scm") ""))
+ #t))
+ (add-before 'configure 'autogen
+ (lambda _
+ (zero? (system* "sh" "autogen.sh")))))))
+ (inputs
+ `(("guile" ,guile-2.0)))
+ (native-inputs
+ `(("zip" ,zip) ; for tests
+ ("autoconf" ,autoconf)
+ ("automake" ,automake)
+ ("texinfo" ,texinfo)))
+ (synopsis "Package manager for Guile")
+ (description
+ "Guildhall is a package manager written for Guile Scheme. A guild is
+an association of independent craftspeople. A guildhall is where they meet.
+This Guildhall aims to make a virtual space for Guile wizards and journeyfolk
+to share code.
+
+On a practical level, Guildhall lets you share Scheme modules and programs
+over the internet, and install code that has been shared by others. Guildhall
+can handle dependencies, so when a program requires several libraries, and
+each of those has further dependencies, all of the prerequisites for the
+program can be installed in one go.")
+ (home-page "https://github.com/ijp/guildhall")
+ (license license:gpl3+))))
+
;;;
;;; Extensions.
@@ -361,7 +423,7 @@ provides several tools for web development: database access, templating
frameworks, session management, URL-remapping for RESTful, page caching, and
more.")
(home-page "https://www.gnu.org/software/artanis/")
- (license (list gpl3+ lgpl3+)))) ;dual license
+ (license (list license:gpl3+ license:lgpl3+)))) ;dual license
(define-public guile-reader
(package
@@ -396,7 +458,7 @@ Guile-Reader’s approach is similar to Common Lisp’s “read table”, but
hopefully more powerful and flexible (for instance, one may instantiate as
many readers as needed).")
(home-page "http://www.nongnu.org/guile-reader/")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public guile-ncurses
(package
@@ -437,7 +499,7 @@ many readers as needed).")
(description
"guile-ncurses provides Guile language bindings for the ncurses
library.")
- (license lgpl3+)))
+ (license license:lgpl3+)))
(define-public mcron
(package
@@ -461,7 +523,7 @@ library.")
tasks on a schedule, such as every hour or every Monday. Mcron is written in
Guile, so its configuration can be written in Scheme; the original cron
format is also supported.")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public mcron2
;; This is mthl's mcron development branch, not yet merged in mcron.
@@ -550,7 +612,7 @@ format is also supported.")
pure Scheme. The library can be used to read and write iCalendar data.
The library is shipped with documentation in Info format and usage examples.")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public guile-lib
(package
@@ -594,7 +656,7 @@ for Guile\".")
;; The whole is under GPLv3+, but some modules are under laxer
;; distribution terms such as LGPL and public domain. See `COPYING' for
;; details.
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public guile-json
(package
@@ -632,7 +694,7 @@ specification. These are the main features:
@item Unicode support for strings.
@item Allows JSON pretty printing.
@end itemize\n")
- (license lgpl3+)))
+ (license license:lgpl3+)))
(define-public guile2.2-json
(package-for-guile-2.2 guile-json))
@@ -718,7 +780,7 @@ This is Ian Price's r6rs packaged version of miniKanren, which deviates
slightly from miniKanren mainline.
See http://minikanren.org/ for more on miniKanren generally.")
- (license expat)))
+ (license license:expat)))
(define-public guile2.2-minikanren
(package-for-guile-2.2 guile-minikanren))
@@ -803,7 +865,7 @@ See http://minikanren.org/ for more on miniKanren generally.")
"Irregex is an s-expression based alternative to your classic
string-based regular expressions. It implements SRFI 115 and is deeply
inspired by the SCSH regular expression system.")
- (license bsd-3)))
+ (license license:bsd-3)))
(define-public guile2.2-irregex
(package-for-guile-2.2 guile-irregex))
@@ -831,10 +893,22 @@ inspired by the SCSH regular expression system.")
#:builder
(begin
(use-modules (guix build utils)
- (system base compile))
+ (ice-9 rdelim)
+ (ice-9 popen))
+
+ ;; Avoid warnings we can safely ignore
+ (setenv "GUILE_AUTO_COMPILE" "0")
(let* ((out (assoc-ref %outputs "out"))
- (module-dir (string-append out "/share/guile/site/2.0"))
+ (effective-version
+ (read-line
+ (open-pipe* OPEN_READ
+ (string-append
+ (assoc-ref %build-inputs "guile")
+ "/bin/guile")
+ "-c" "(display (effective-version))")))
+ (module-dir (string-append out "/share/guile/site/"
+ effective-version))
(source (assoc-ref %build-inputs "source"))
(doc (string-append out "/share/doc"))
(guild (string-append (assoc-ref %build-inputs "guile")
@@ -842,7 +916,10 @@ inspired by the SCSH regular expression system.")
(gdbm.scm-dest
(string-append module-dir "/gdbm.scm"))
(gdbm.go-dest
- (string-append module-dir "/gdbm.go")))
+ (string-append module-dir "/gdbm.go"))
+ (compile-file
+ (lambda (in-file out-file)
+ (system* guild "compile" "-o" out-file in-file))))
;; Make installation directories.
(mkdir-p module-dir)
(mkdir-p doc)
@@ -860,8 +937,7 @@ inspired by the SCSH regular expression system.")
(assoc-ref %build-inputs "gdbm"))))
;; compile to the destination
- (compile-file gdbm.scm-dest
- #:output-file gdbm.go-dest)))))
+ (compile-file gdbm.scm-dest gdbm.go-dest)))))
(inputs
`(("guile" ,guile-2.0)))
(propagated-inputs
@@ -871,7 +947,10 @@ inspired by the SCSH regular expression system.")
(description
"Guile bindings to the GDBM key-value storage system, using
Guile's foreign function interface.")
- (license gpl3+)))
+ (license license:gpl3+)))
+
+(define-public guile2.2-gdbm-ffi
+ (package-for-guile-2.2 guile-gdbm-ffi))
(define-public guile-sqlite3
(let ((commit "607721fe1174a299e45d457acacf94eefb964071"))
@@ -922,7 +1001,7 @@ Guile's foreign function interface.")
(synopsis "Access SQLite databases from Guile")
(description
"This package provides Guile bindings to the SQLite database system.")
- (license gpl3+))))
+ (license license:gpl3+))))
(define-public haunt
(package
@@ -971,7 +1050,7 @@ Guile's foreign function interface.")
Scheme. Haunt features a functional build system and an extensible
interface for reading articles in any format.")
(home-page "http://haunt.dthompson.us")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public guile-config
(package
@@ -998,7 +1077,7 @@ parameter parsing using getopt-long; basic GNU command-line parameter
generation (--help, --usage, --version); automatic output generation for the
above command-line parameters.")
(home-page "https://github.com/a-sassmannshausen/guile-config")
- (license agpl3+)))
+ (license license:agpl3+)))
(define-public guile-redis
(package
@@ -1031,7 +1110,7 @@ above command-line parameters.")
(synopsis "Redis client library for Guile")
(description "Guile-redis provides a Scheme interface to the Redis
key-value cache and store.")
- (license lgpl3+)))
+ (license license:lgpl3+)))
(define-public guile2.2-redis
(package-for-guile-2.2 guile-redis))
@@ -1110,7 +1189,7 @@ key-value cache and store.")
(description "Wisp is a syntax for Guile which provides a Python-like
whitespace-significant language. It may be easier on the eyes for some
users and in some situations.")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public guile-sly
(package
@@ -1145,7 +1224,7 @@ users and in some situations.")
features a functional reactive programming interface and live coding
capabilities.")
(home-page "http://dthompson.us/pages/software/sly.html")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public g-wrap
(package
@@ -1183,7 +1262,7 @@ wrappers for C functions. Given a definition of the types and prototypes for
a given C interface, G-Wrap will automatically generate the C code that
provides access to that interface and its types from the Scheme level.")
(home-page "http://www.nongnu.org/g-wrap/index.html")
- (license lgpl2.1+)))
+ (license license:lgpl2.1+)))
(define-public guile-dbi
(package
@@ -1221,7 +1300,7 @@ provides access to that interface and its types from the Scheme level.")
SQL databases. Database programming with guile-dbi is generic in that the same
programming interface is presented regardless of which database system is used.
It currently supports MySQL, Postgres and SQLite3.")
- (license gpl2+)))
+ (license license:gpl2+)))
(define-public guile-dbd-sqlite3
(package
@@ -1248,7 +1327,7 @@ It currently supports MySQL, Postgres and SQLite3.")
(description
"guile-dbi is a library for Guile that provides a convenient interface to
SQL databases. This package implements the interface for SQLite.")
- (license gpl2+)))
+ (license license:gpl2+)))
(define-public guile-xosd
(package
@@ -1277,7 +1356,7 @@ SQL databases. This package implements the interface for SQLite.")
"Guile-XOSD provides Guile bindings for @code{libxosd},
@uref{http://sourceforge.net/projects/libxosd/, the X On Screen Display
library}.")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public guile-daemon
(package
@@ -1302,7 +1381,7 @@ library}.")
"Guile-Daemon is a small Guile program that loads your initial
configuration file, and then reads and evaluates Guile expressions that
you send to a FIFO file.")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public guile-commonmark
(package
@@ -1338,7 +1417,7 @@ to transform a CommonMark document to SXML. guile-commonmark tries to closely
follow the @uref{http://commonmark.org/, CommonMark spec}, the main difference
is no support for parsing block and inline level HTML.")
(home-page "https://github.com/OrangeShark/guile-commonmark")
- (license lgpl3+)))
+ (license license:lgpl3+)))
(define-public guile2.2-commonmark
(package-for-guile-2.2 guile-commonmark))
@@ -1421,7 +1500,7 @@ of the C programming language, to be used on bytevectors. C's type
system works on raw memory, and Guile works on bytevectors which are
an abstraction over raw memory. It's also more powerful than the C
type system, elevating types to first-class status.")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public guile-aspell
(package
@@ -1457,7 +1536,7 @@ type system, elevating types to first-class status.")
(description
"guile-aspell is a Guile Scheme library for comparing a string against a
dictionary and suggesting spelling corrections.")
- (license gpl3+)))
+ (license license:gpl3+)))
(define-public guile-bash
;; This project is currently retired. It was initially announced here:
@@ -1527,7 +1606,7 @@ enable -f ~/.guix-profile/lib/bash/libguile-bash.so scm
@end example
and then run @command{scm example.scm}.")
- (license gpl3+))))
+ (license license:gpl3+))))
(define-public guile-8sync
(package
@@ -1560,6 +1639,44 @@ and then run @command{scm example.scm}.")
library for GNU Guile based on the actor model.
Note that 8sync is only available for Guile 2.2 (guile-next in Guix).")
- (license lgpl3+)))
+ (license license:lgpl3+)))
+
+(define-public guile-git
+ (let ((revision "0")
+ (commit "969514aa7224217bc3c1a4c5312a9469ac5f13d5"))
+ (package
+ (name "guile-git")
+ (version (string-append "0.0-" revision "." (string-take commit 7)))
+ (home-page "https://gitlab.com/amirouche/guile-git")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference (url home-page) (commit commit)))
+ (sha256
+ (base32
+ "079l8y6pjkmahb4k6dfqh3hk34pg540rrl29aixyvv86w9bdfjil"))
+ (file-name (git-file-name name version))))
+ (build-system gnu-build-system)
+ (arguments
+ '(#:phases (modify-phases %standard-phases
+ (add-after 'unpack 'bootstrap
+ (lambda _
+ (zero? (system* "autoreconf" "-vfi")))))
+
+ ;; Test suite is not parallel-safe: the tests open same-named repos.
+ #:parallel-tests? #f))
+ (native-inputs
+ `(("autoconf" ,autoconf)
+ ("automake" ,automake)
+ ("pkg-config" ,pkg-config)))
+ (inputs
+ `(("guile" ,guile-2.0)
+ ("libgit2" ,libgit2)))
+ (propagated-inputs
+ `(("guile-bytestructures" ,guile-bytestructures)))
+ (synopsis "Guile bindings for libgit2")
+ (description
+ "This package provides Guile bindings to libgit2, a library to
+manipulate repositories of the Git version control system.")
+ (license license:gpl3+))))
;;; guile.scm ends here
diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm
index 37e35c45fd..d0f659f6e3 100644
--- a/gnu/packages/haskell.scm
+++ b/gnu/packages/haskell.scm