Merge branch 'master' into staging

12 files changed, 382 insertions, 28 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index f0a59a6b4b..c10fc649d1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12120,6 +12120,32 @@ Additional command line options to pass to @code{memcached}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} mongodb-service-type
+This is the service type for @uref{https://www.mongodb.com/, MongoDB}.
+The value for the service type is a @code{mongodb-configuration} object.
+@end defvr
+
+@example
+(service mongodb-service-type)
+@end example
+
+@deftp {Data Type} mongodb-configuration
+Data type representing the configuration of mongodb.
+
+@table @asis
+@item @code{mongodb} (default: @code{mongodb})
+The MongoDB package to use.
+
+@item @code{config-file} (default: @code{%default-mongodb-configuration-file})
+The configuration file for MongoDB.
+
+@item @code{data-directory} (default: @code{"/var/lib/mongodb"})
+This value is used to create the directory, so that it exists and is
+owned by the mongodb user.  It should match the data-directory which
+MongoDB is configured to use through the configuration file.
+@end table
+@end deftp
+
 @defvr {Scheme Variable} redis-service-type
 This is the service type for the @uref{https://redis.io/, Redis}
 key/value store, whose value is a @code{redis-configuration} object.
diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 972ffeeecb..bc745351af 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -883,12 +883,12 @@ the 'share/locale' sub-directory of this package.")
                    ,@(package-arguments glibc))))
        (substitute-keyword-arguments args
          ((#:phases phases)
-          `(alist-replace
-            'build
-            (lambda* (#:key outputs #:allow-other-keys)
-              (zero? (system* "make" "localedata/install-locales"
-                              "-j" (number->string (parallel-job-count)))))
-            (alist-delete 'install ,phases)))
+          `(modify-phases ,phases
+             (replace 'build
+               (lambda _
+                 (zero? (system* "make" "localedata/install-locales"
+                                 "-j" (number->string (parallel-job-count))))))
+             (delete 'install)))
          ((#:configure-flags flags)
           `(append ,flags
                    ;; Use $(libdir)/locale/X.Y as is the case by default.
diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm
index 95632e2f9c..f2f3b807c3 100644
--- a/gnu/packages/bioinformatics.scm
+++ b/gnu/packages/bioinformatics.scm
@@ -6161,7 +6161,7 @@ SELECT or UPDATE queries to an end-point.")
 (define-public vsearch
   (package
     (name "vsearch")
-    (version "2.4.4")
+    (version "2.5.0")
     (source
      (origin
        (method url-fetch)
@@ -6171,7 +6171,7 @@ SELECT or UPDATE queries to an end-point.")
        (file-name (string-append name "-" version ".tar.gz"))
        (sha256
         (base32
-         "1d8a4gjwaqdv57krlr80x18mg5py1bbdiqs5m0jdn38filc9z40k"))
+         "1k8wf3qns4mqrsizywbkqcasqjw000m4drxsag3qd7390pwvf9kz"))
        (patches (search-patches "vsearch-unbundle-cityhash.patch"))
        (snippet
         '(begin
diff --git a/gnu/packages/databases.scm b/gnu/packages/databases.scm
index 2afc94c965..ae138796ff 100644
--- a/gnu/packages/databases.scm
+++ b/gnu/packages/databases.scm
@@ -69,8 +69,10 @@
   #:use-module (gnu packages rdf)
   #:use-module (gnu packages readline)
   #:use-module (gnu packages ruby)
+  #:use-module (gnu packages serialization)
   #:use-module (gnu packages tcl)
   #:use-module (gnu packages tls)
+  #:use-module (gnu packages valgrind)
   #:use-module (gnu packages xml)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix packages)
@@ -355,6 +357,98 @@ and generic API, and was originally intended for use with dynamic web
 applications.")
     (license license:bsd-3)))
 
+(define-public mongodb
+  (package
+    (name "mongodb")
+    (version "3.4.9")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "https://github.com/mongodb/mongo/archive/r"
+                                  version ".tar.gz"))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32 "0gidwyvh3bdwmk2pccgkqkaln4ysgn8iwa7ihjzllsq0rdg95045"))
+              (patches
+               (list
+                (search-patch "mongodb-support-unknown-linux-distributions.patch")))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("openssl" ,openssl)
+       ("pcre" ,pcre)
+       ("yaml-cpp" ,yaml-cpp)
+       ("zlib" ,zlib)
+       ("snappy" ,snappy)
+       ("boost" ,boost)))
+    (native-inputs
+     `(("scons" ,scons)
+       ("python" ,python-2)
+       ("valgrind" ,valgrind)
+       ("perl" ,perl)))
+    (arguments
+     `(#:phases
+       (let ((common-options
+              `(;; "--use-system-tcmalloc" TODO: Missing gperftools
+                "--use-system-pcre"
+                ;; TODO
+                ;; build/opt/mongo/db/fts/unicode/string.o failed: Error 1
+                ;; --use-system-boost
+                "--use-system-snappy"
+                "--use-system-zlib"
+                "--use-system-valgrind"
+                ;; "--use-system-stemmer" TODO: Missing relevant package
+                "--use-system-yaml"
+                "--disable-warnings-as-errors"
+                ,(format #f "--jobs=~a" (parallel-job-count))
+                "--ssl")))
+         (modify-phases %standard-phases
+           (delete 'configure) ; There is no configure phase
+           (add-after 'unpack 'scons-propagate-environment
+             (lambda _
+               ;; Modify the SConstruct file to arrange for
+               ;; environment variables to be propagated.
+               (substitute* "SConstruct"
+                 (("^env = Environment\\(")
+                  "env = Environment(ENV=os.environ, "))
+               #t))
+           (add-after 'unpack 'create-version-file
+             (lambda _
+               (call-with-output-file "version.json"
+                 (lambda (port)
+                   (display ,(simple-format #f "{
+    \"version\": \"~A\"
+}" version) port)))
+               #t))
+           (replace 'build
+             (lambda _
+               (zero? (apply system*
+                             `("scons"
+                               ,@common-options
+                               "mongod" "mongo" "mongos")))))
+           (replace 'check
+             (lambda* (#:key tests? #:allow-other-keys)
+               (or (not tests?)
+                   (zero? (apply system*
+                                 `("scons"
+                                   ,@common-options
+                                   "dbtest" "unittests"))))))
+           (replace 'install
+             (lambda _
+               (let ((bin  (string-append (assoc-ref %outputs "out") "/bin")))
+                 (install-file "mongod" bin)
+                 (install-file "mongos" bin)
+                 (install-file "mongo" bin))
+               #t))))))
+    (home-page "https://www.mongodb.org/")
+    (synopsis "High performance and high availability document database")
+    (description
+     "Mongo is a high-performance, high availability, schema-free
+document-oriented database.  A key goal of MongoDB is to bridge the gap
+between key/value stores (which are fast and highly scalable) and traditional
+RDBMS systems (which are deep in functionality).")
+    (license (list license:agpl3
+                   ;; Some parts are licensed under the Apache License
+                   license:asl2.0))))
+
 (define-public mysql
   (package
     (name "mysql")
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index 585b41a376..1445089a58 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -367,8 +367,8 @@ It has been modified to remove all non-free binary blobs.")
 
 (define %intel-compatible-systems '("x86_64-linux" "i686-linux"))
 
-(define %linux-libre-version "4.13.4")
-(define %linux-libre-hash "028dww9c6x22mvd0jd87bmibqiz5lrsyynrbzka18gh39sk0v8j7")
+(define %linux-libre-version "4.13.5")
+(define %linux-libre-hash "1crw61x7qrijhpw0azxf9b3fra0cxq87ncni2419p0s23jfdpc4m")
 
 (define-public linux-libre
   (make-linux-libre %linux-libre-version
@@ -377,14 +377,14 @@ It has been modified to remove all non-free binary blobs.")
                     #:configuration-file kernel-config))
 
 (define-public linux-libre-4.9
-  (make-linux-libre "4.9.52"
-                    "0zl1z13r4gg6r2sbx8mrif2cnjkjlfrswiap7wzb22jyfnlyj5nb"
+  (make-linux-libre "4.9.53"
+                    "174i53cd090akbjq34dj4z00h1nyfmy3sl3fk6svcmbx6h34381h"
                     %intel-compatible-systems
                     #:configuration-file kernel-config))
 
 (define-public linux-libre-4.4
-  (make-linux-libre "4.4.89"
-                    "1bw1cma8hxcj6wi8znc4nvw1p6dlc1lgciqak6n6ijn53xdd242h"
+  (make-linux-libre "4.4.90"
+                    "1sqzvz8yrcf99vhphkxp1wm2agq6q9nshxb1mkypspm8rhm11vhw"
                     %intel-compatible-systems
                     #:configuration-file kernel-config))
 
@@ -3163,7 +3163,7 @@ and copy/paste text in the console and in xterm.")
 (define-public btrfs-progs
   (package
     (name "btrfs-progs")
-    (version "4.13.1")
+    (version "4.13.2")
     (source (origin
               (method url-fetch)
               (uri (string-append "mirror://kernel.org/linux/kernel/"
@@ -3171,7 +3171,7 @@ and copy/paste text in the console and in xterm.")
                                   "btrfs-progs-v" version ".tar.xz"))
               (sha256
                (base32
-                "1clavvrlkswgicqsm2yfsxqw04lsn8dra0db84jqm6j2apz80kz0"))))
+                "1ga8jk2hkaxpm17z3gdfrpq0i62kqpv2wm5yzbzmsj862cgk7ivm"))))
     (build-system gnu-build-system)
     (outputs '("out"
                "static"))      ; static versions of the binaries in "out"
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 197a7a0142..91e44ec6fe 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -78,8 +78,8 @@
   ;; Note: the 'update-guix-package.scm' script expects this definition to
   ;; start precisely like this.
   (let ((version "0.13.0")
-        (commit "a9468b422b6df2349a3f4d1451c9302c3d77011b")
-        (revision 6))
+        (commit "8b920d707ed07a3251227f77526cf875d86a4417")
+        (revision 7))
     (package
       (name "guix")
 
@@ -95,7 +95,7 @@
                       (commit commit)))
                 (sha256
                  (base32
-                  "0bv323yp657x0a2aa2z5pp5541hjqmn908kh9jqlbdw5gpx9vg3d"))
+                  "15phwcadkw44mr4hnv1dxzzw9an6x7sbdfzwy4iciqw6y2wckncd"))
                 (file-name (string-append "guix-" version "-checkout"))))
       (build-system gnu-build-system)
       (arguments
diff --git a/gnu/packages/patches/mongodb-support-unknown-linux-distributions.patch b/gnu/packages/patches/mongodb-support-unknown-linux-distributions.patch
new file mode 100644
index 0000000000..6057ebeb08
--- /dev/null
+++ b/gnu/packages/patches/mongodb-support-unknown-linux-distributions.patch
@@ -0,0 +1,55 @@
+From e724bb7018a482640c4f194f88b554af2c59d76e Mon Sep 17 00:00:00 2001
+From: Mark Benvenuto <mark.benvenuto@mongodb.com>
+Date: Wed, 20 Sep 2017 11:50:02 -0400
+Subject: [PATCH] SERVER-30857 Support unknown Linux distributions
+
+---
+ src/mongo/rpc/metadata/client_metadata.cpp | 6 ------
+ src/mongo/util/processinfo_linux.cpp       | 9 ++++++---
+ 2 files changed, 6 insertions(+), 9 deletions(-)
+
+diff --git a/src/mongo/rpc/metadata/client_metadata.cpp b/src/mongo/rpc/metadata/client_metadata.cpp
+index 845a315dd74..a959a4e31e9 100644
+--- a/src/mongo/rpc/metadata/client_metadata.cpp
++++ b/src/mongo/rpc/metadata/client_metadata.cpp
+@@ -302,9 +302,6 @@ void ClientMetadata::serializePrivate(StringData driverName,
+                                       StringData osArchitecture,
+                                       StringData osVersion,
+                                       BSONObjBuilder* builder) {
+-    invariant(!driverName.empty() && !driverVersion.empty() && !osType.empty() && !osName.empty() &&
+-              !osArchitecture.empty() && !osVersion.empty());
+-
+     BSONObjBuilder metaObjBuilder(builder->subobjStart(kMetadataDocumentName));
+ 
+     {
+@@ -347,9 +344,6 @@ Status ClientMetadata::serializePrivate(StringData driverName,
+                                         StringData osVersion,
+                                         StringData appName,
+                                         BSONObjBuilder* builder) {
+-    invariant(!driverName.empty() && !driverVersion.empty() && !osType.empty() && !osName.empty() &&
+-              !osArchitecture.empty() && !osVersion.empty());
+-
+     if (appName.size() > kMaxApplicationNameByteLength) {
+         return Status(ErrorCodes::ClientMetadataAppNameTooLarge,
+                       str::stream() << "The '" << kApplication << "." << kName
+diff --git a/src/mongo/util/processinfo_linux.cpp b/src/mongo/util/processinfo_linux.cpp
+index c3debf377bd..c2813b026b0 100644
+--- a/src/mongo/util/processinfo_linux.cpp
++++ b/src/mongo/util/processinfo_linux.cpp
+@@ -376,10 +376,13 @@ class LinuxSysHelper {
+             if ((nl = name.find('\n', nl)) != string::npos)
+                 // stop at first newline
+                 name.erase(nl);
+-            // no standard format for name and version.  use kernel version
+-            version = "Kernel ";
+-            version += LinuxSysHelper::readLineFromFile("/proc/sys/kernel/osrelease");
++        } else {
++            name = "unknown";
+         }
++
++        // There is no standard format for name and version so use the kernel version.
++        version = "Kernel ";
++        version += LinuxSysHelper::readLineFromFile("/proc/sys/kernel/osrelease");
+     }
+ 
+     /**
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index de1f6b8411..6a01cb1ce6 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -44,6 +44,14 @@
             memcached-configuration-udp-port
             memcached-configuration-additional-options
 
+            <mongodb-configuration>
+            mongodb-configuration
+            mongodb-configuration?
+            mongodb-configuration-mongodb
+            mongodb-configuration-config-file
+            mongodb-configuration-data-directory
+            mongodb-service-type
+
             mysql-service
             mysql-service-type
             mysql-configuration
@@ -264,6 +272,87 @@ and stores the database cluster in @var{data-directory}."
 
 
 ;;;
+;;; MongoDB
+;;;
+
+(define %default-mongodb-configuration-file
+  (plain-file
+   "mongodb.yaml"
+   "# GNU Guix: MongoDB default configuration file
+processManagement:
+  pidFilePath: /var/run/mongodb/pid
+storage:
+  dbPath: /var/lib/mongodb
+"))
+
+
+(define-record-type* <mongodb-configuration>
+  mongodb-configuration make-mongodb-configuration
+  mongodb-configuration?
+  (mongodb             mongodb-configuration-mongodb
+                       (default mongodb))
+  (config-file         mongodb-configuration-config-file
+                       (default %default-mongodb-configuration-file))
+  (data-directory      mongodb-configuration-data-directory
+                       (default "/var/lib/mongodb")))
+
+(define %mongodb-accounts
+  (list (user-group (name "mongodb") (system? #t))
+        (user-account
+         (name "mongodb")
+         (group "mongodb")
+         (system? #t)
+         (comment "Mongodb server user")
+         (home-directory "/var/lib/mongodb")
+         (shell (file-append shadow "/sbin/nologin")))))
+
+(define mongodb-activation
+  (match-lambda
+    (($ <mongodb-configuration> mongodb config-file data-directory)
+     #~(begin
+         (use-modules (guix build utils))
+         (let ((user (getpwnam "mongodb")))
+           (for-each
+            (lambda (directory)
+              (mkdir-p directory)
+              (chown directory
+                     (passwd:uid user) (passwd:gid user)))
+            '("/var/run/mongodb" #$data-directory)))))))
+
+(define mongodb-shepherd-service
+  (match-lambda
+    (($ <mongodb-configuration> mongodb config-file data-directory)
+     (shepherd-service
+      (provision '(mongodb))
+      (documentation "Run the Mongodb daemon.")
+      (requirement '(user-processes loopback))
+      (start #~(make-forkexec-constructor
+                `(,(string-append #$mongodb "/bin/mongod")
+                  "--config"
+                  ,#$config-file)
+                #:user "mongodb"
+                #:group "mongodb"
+                #:pid-file "/var/run/mongodb/pid"
+                #:log-file "/var/log/mongodb.log"))
+      (stop #~(make-kill-destructor))))))
+
+(define mongodb-service-type
+  (service-type
+   (name 'mongodb)
+   (description "Run the MongoDB document database server.")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             (compose list
+                                      mongodb-shepherd-service))
+          (service-extension activation-service-type
+                             mongodb-activation)
+          (service-extension account-service-type
+                             (const %mongodb-accounts))))
+   (default-value
+     (mongodb-configuration))))
+
+
+;;;
 ;;; MySQL.
 ;;;
 
diff --git a/gnu/system.scm b/gnu/system.scm
index 8ab4801b74..0e834ba5ed 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -231,6 +231,14 @@ directly by the user."
   (kernel-arguments boot-parameters-kernel-arguments)
   (initrd           boot-parameters-initrd))
 
+(define (ensure-not-/dev device)
+  "If DEVICE starts with a slash, return #f.  This is meant to filter out
+Linux device names such as /dev/sda, and to preserve GRUB device names and
+file system labels."
+  (if (and (string? device) (string-prefix? "/" device))
+      #f
+      device))
+
 (define (read-boot-parameters port)
   "Read boot parameters from PORT and return the corresponding
 <boot-parameters> object or #f if the format is unrecognized."
@@ -243,11 +251,6 @@ directly by the user."
       ((? string? device)
        device)))
 
-  (define (ensure-not-/dev device)
-    (if (and (string? device) (string-prefix? "/" device))
-        #f
-        device))
-
   (match (read port)
     (('boot-parameters ('version 0)
                        ('label label) ('root-device root)
@@ -939,7 +942,7 @@ kernel arguments for that derivation to <boot-parameters>."
                 (operating-system-user-kernel-arguments os)))
              (initrd initrd)
              (bootloader-name bootloader-name)
-             (store-device (fs->boot-device store))
+             (store-device (ensure-not-/dev (fs->boot-device store)))
              (store-mount-point (file-system-mount-point store))))))
 
 (define (device->sexp device)
diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm
index 9d9a753747..9e335b27c6 100644
--- a/gnu/tests/databases.scm
+++ b/gnu/tests/databases.scm
@@ -25,9 +25,11 @@
   #:use-module (gnu services)
   #:use-module (gnu services databases)
   #:use-module (gnu services networking)
+  #:use-module (gnu packages databases)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:export (%test-memcached))
+  #:export (%test-memcached
+            %test-mongodb))
 
 (define %memcached-os
   (simple-operating-system
@@ -121,3 +123,85 @@
    (name "memcached")
    (description "Connect to a running MEMCACHED server.")
    (value (run-memcached-test))))
+
+(define %mongodb-os
+  (operating-system
+    (inherit
+     (simple-operating-system
+      (dhcp-client-service)
+      (service mongodb-service-type)))
+    (packages (cons* mongodb
+                     %base-packages))))
+
+(define* (run-mongodb-test #:optional (port 27017))
+  "Run tests in %MONGODB-OS, forwarding PORT."
+  (define os
+    (marionette-operating-system
+     %mongodb-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (memory-size 1024)
+     (disk-image-size (* 1024 (expt 2 20)))
+     (port-forwardings `((27017 . ,port)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette)
+                       (ice-9 popen)
+                       (ice-9 rdelim))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "mongodb")
+
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (match (start-service 'mongodb)
+                  (#f #f)
+                  (('service response-parts ...)
+                   (match (assq-ref response-parts 'running)
+                     ((pid) (number? pid))))))
+             marionette))
+
+          (test-eq "test insert"
+            0
+            (system* (string-append #$mongodb "/bin/mongo")
+                     "test"
+                     "--eval"
+                     "db.testCollection.insert({data: 'test-data'})"))
+
+          (test-equal "test find"
+            "test-data"
+            (let* ((port (open-pipe*
+                          OPEN_READ
+                          (string-append #$mongodb "/bin/mongo")
+                          "test"
+                          "--quiet"
+                          "--eval"
+                          "db.testCollection.findOne().data"))
+                   (output (read-line port))
+                   (status (close-pipe port)))
+              output))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "mongodb-test" test))
+
+(define %test-mongodb
+  (system-test
+   (name "mongodb")
+   (description "Connect to a running MONGODB server.")
+   (value (run-mongodb-test))))
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 3d8d2c698d..f4bbd335b9 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -43,7 +43,10 @@
 (test-assert "alist->package with simple source"
   (let* ((meta '(("name" . "hello")
                  ("version" . "2.10")
-                 ("source" . "mirror://gnu/hello/hello-2.10.tar.gz")
+                 ("source" .
+                  ;; Use a 'file://' URI so that we don't cause a download.
+                  ,(string-append "file://"
+                                  (search-path %load-path "guix.scm")))
                  ("build-system" . "gnu")
                  ("home-page" . "https://gnu.org")
                  ("synopsis" . "Say hi")
diff --git a/tests/uuid.scm b/tests/uuid.scm
index 68676f775d..91a3482490 100644
--- a/tests/uuid.scm
+++ b/tests/uuid.scm
@@ -57,7 +57,7 @@
   "1234-ABCD"
   (uuid->string (uuid "1234-abcd" 'fat32)))
 
-(test-equal "uuid=?"
+(test-assert "uuid=?"
   (and (uuid=? (uuid-bytevector (uuid "1234-abcd" 'fat32))
                (uuid "1234-abcd" 'fat32))
        (uuid=? (uuid "1234-abcd" 'fat32)