~ruther/guix-local

119fdd0d0e33492ef2b563295fe9564258d51401 — Christopher Baines 8 years ago 686144e
services: Add memcached.

* gnu/services/databases.scm (memcached-service-type, %memcached-accounts):
  New variables.
  (<memcached-configuration>): New record type.
  (memcached-service-type): New procedures.
* gnu/tests/databases.scm: New file.
* doc/guix.texi (Database Services): Document the new memcached service.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add entry for tests/databases.scm.
4 files changed, 227 insertions(+), 0 deletions(-)

M doc/guix.texi
M gnu/local.mk
M gnu/services/databases.scm
A gnu/tests/databases.scm
M doc/guix.texi => doc/guix.texi +32 -0
@@ 11724,6 11724,38 @@ TCP port on which the database server listens for incoming connections.
@end table
@end deftp

@defvr {Scheme Variable} memcached-service-type
This is the service type for the @uref{https://memcached.org/,
Memcached} service, which provides a distributed in memory cache.  The
value for the service type is a @code{memcached-configuration} object.
@end defvr

@example
(service memcached-service-type)
@end example

@deftp {Data Type} memcached-configuration
Data type representing the configuration of memcached.

@table @asis
@item @code{memcached} (default: @code{memcached})
The Memcached package to use.

@item @code{interfaces} (default: @code{'("0.0.0.0")})
Network interfaces on which to listen.

@item @code{tcp-port} (default: @code{11211})
Port on which to accept connections on,

@item @code{udp-port} (default: @code{11211})
Port on which to accept UDP connections on, a value of 0 will disable
listening on a UDP socket.

@item @code{additional-options} (default: @code{'()})
Additional command line options to pass to @code{memcached}.
@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.

M gnu/local.mk => gnu/local.mk +1 -0
@@ 480,6 480,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/tests.scm					\
  %D%/tests/admin.scm				\
  %D%/tests/base.scm				\
  %D%/tests/databases.scm			\
  %D%/tests/dict.scm				\
  %D%/tests/nfs.scm				\
  %D%/tests/install.scm				\

M gnu/services/databases.scm => gnu/services/databases.scm +73 -0
@@ 25,6 25,7 @@
  #:use-module (gnu system shadow)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages databases)
  #:use-module (guix modules)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module (ice-9 match)


@@ 33,6 34,16 @@
            postgresql-service
            postgresql-service-type

            memcached-service-type
            <memcached-configuration>
            memcached-configuration
            memcached-configuration?
            memcached-configuration-memecached
            memcached-configuration-interfaces
            memcached-configuration-tcp-port
            memcached-configuration-udp-port
            memcached-configuration-additional-options

            mysql-service
            mysql-service-type
            mysql-configuration


@@ 178,6 189,68 @@ and stores the database cluster in @var{data-directory}."


;;;
;;; Memcached
;;;

(define-record-type* <memcached-configuration>
  memcached-configuration make-memcached-configuration
  memcached-configuration?
  (memcached          memcached-configuration-memcached ;<package>
                      (default memcached))
  (interfaces         memcached-configuration-interfaces
                      (default '("0.0.0.0")))
  (tcp-port           memcached-configuration-tcp-port
                      (default 11211))
  (udp-port           memcached-configuration-udp-port
                      (default 11211))
  (additional-options memcached-configuration-additional-options
                      (default '())))

(define %memcached-accounts
  (list (user-group (name "memcached") (system? #t))
        (user-account
         (name "memcached")
         (group "memcached")
         (system? #t)
         (comment "Memcached server user")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define memcached-shepherd-service
  (match-lambda
    (($ <memcached-configuration> memcached interfaces tcp-port udp-port
                                  additional-options)
     (with-imported-modules (source-module-closure
                             '((gnu build shepherd)))
       (list (shepherd-service
              (provision '(memcached))
              (documentation "Run the Memcached daemon.")
              (requirement '(user-processes loopback))
              (modules '((gnu build shepherd)))
              (start #~(make-forkexec-constructor
                        `(#$(file-append memcached "/bin/memcached")
                          "-l" #$(string-join interfaces ",")
                          "-p" #$(number->string tcp-port)
                          "-U" #$(number->string udp-port)
                          "--daemon"
                          "-P" "/var/run/memcached.pid"
                          "-u" "memcached"
                          ,#$@additional-options)
                        #:log-file "/var/log/memcached"
                        #:pid-file "/var/run/memcached.pid"))
              (stop #~(make-kill-destructor))))))))

(define memcached-service-type
  (service-type (name 'memcached)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          memcached-shepherd-service)
                       (service-extension account-service-type
                                          (const %memcached-accounts))))
                (default-value (memcached-configuration))))


;;;
;;; MySQL.
;;;


A gnu/tests/databases.scm => gnu/tests/databases.scm +121 -0
@@ 0,0 1,121 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu tests databases)
  #:use-module (gnu tests)
  #:use-module (gnu system)
  #:use-module (gnu system file-systems)
  #:use-module (gnu system shadow)
  #:use-module (gnu system vm)
  #:use-module (gnu services)
  #:use-module (gnu services databases)
  #:use-module (gnu services networking)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:export (%test-memcached))

(define %memcached-os
  (simple-operating-system
   (dhcp-client-service)
   (service memcached-service-type)))

(define* (run-memcached-test #:optional (port 11211))
  "Run tests in %MEMCACHED-OS, forwarding PORT."
  (define os
    (marionette-operating-system
     %memcached-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings `((11211 . ,port)))))

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

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

          (mkdir #$output)
          (chdir #$output)

          (test-begin "memcached")

          ;; Wait for memcached to be up and running.
          (test-eq "service running"
            'running!
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'memcached)
                'running!)
             marionette))

          (let* ((ai (car (getaddrinfo "localhost"
                                       #$(number->string port))))
                 (s  (socket (addrinfo:fam ai)
                             (addrinfo:socktype ai)
                             (addrinfo:protocol ai)))
                 (key "testkey")
                 (value "guix"))
            (connect s (addrinfo:addr ai))

            (test-equal "set"
              "STORED\r"
              (begin
                (simple-format s "set ~A 0 60 ~A\r\n~A\r\n"
                               key
                               (string-length value)
                               value)
                (read-line s)))

            (test-equal "get"
              (simple-format #f "VALUE ~A 0 ~A\r~A\r"
                             key
                             (string-length value)
                             value)
              (begin
                (simple-format s "get ~A\r\n" key)
                (string-append
                 (read-line s)
                 (read-line s))))

            (close-port s))

          ;; There should be a log file in here.
          (test-assert "log file"
            (marionette-eval
             '(file-exists? "/var/log/memcached")
             marionette))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "memcached-test" test))

(define %test-memcached
  (system-test
   (name "memcached")
   (description "Connect to a running MEMCACHED server.")
   (value (run-memcached-test))))