From 730ed6ec8b69a0f908a8aadbbe0555dd45de227c Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 24 Jun 2017 14:19:46 +0100 Subject: gnu: services: admin: Add tailon. * gnu/services/admin.scm (, ): New record types. (tailon-configuration-files-string, tailon-shepherd-service): New procedures. (%tailon-accounts, tailon-service-type: New variables. * doc/guix.texi (Monitoring Services: Document the Tailon service. * gnu/local.mk (GNU_SYSTEM_MODULES): Add gnu/tests/admin.scm. * gnu/tests/admin.scm: New file. --- gnu/tests/admin.scm | 128 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 128 insertions(+) create mode 100644 gnu/tests/admin.scm (limited to 'gnu/tests') diff --git a/gnu/tests/admin.scm b/gnu/tests/admin.scm new file mode 100644 index 0000000000..3c7deb5426 --- /dev/null +++ b/gnu/tests/admin.scm @@ -0,0 +1,128 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Christopher Baines +;;; +;;; 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 . + +(define-module (gnu tests admin) + #: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 admin) + #:use-module (gnu services networking) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) + #:export (%test-tailon)) + +(define %tailon-os + ;; Operating system under test. + (simple-operating-system + (dhcp-client-service) + (service tailon-service-type + (tailon-configuration + (config-file + (tailon-configuration-file + (bind "0.0.0.0:8080"))))))) + +(define* (run-tailon-test #:optional (http-port 8081)) + "Run tests in %TAILON-OS, which has tailon running and listening on +HTTP-PORT." + (define os + (marionette-operating-system + %tailon-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((,http-port . 8080))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (ice-9 match) + (gnu build marionette) + (web uri) + (web client) + (web response)) + + (define marionette + ;; Forward the guest's HTTP-PORT, where tailon is listening, to + ;; port 8080 in the host. + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "tailon") + + (test-eq "service running" + 'running! + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'tailon) + 'running!) + marionette)) + + (define* (retry-on-error f #:key times delay) + (let loop ((attempt 1)) + (match (catch + #t + (lambda () + (cons #t + (f))) + (lambda args + (cons #f + args))) + ((#t . return-value) + return-value) + ((#f . error-args) + (if (>= attempt times) + error-args + (begin + (sleep delay) + (loop (+ 1 attempt)))))))) + + (test-equal "http-get" + 200 + (retry-on-error + (lambda () + (let-values (((response text) + (http-get #$(format + #f + "http://localhost:~A/" + http-port) + #:decode-body? #t))) + (response-code response))) + #:times 10 + #:delay 5)) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "tailon-test" test)) + +(define %test-tailon + (system-test + (name "tailon") + (description "Connect to a running Tailon server.") + (value (run-tailon-test)))) -- cgit v1.2.3 From 119fdd0d0e33492ef2b563295fe9564258d51401 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 27 Jul 2017 17:13:49 +0100 Subject: services: Add memcached. * gnu/services/databases.scm (memcached-service-type, %memcached-accounts): New variables. (): 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. --- doc/guix.texi | 32 ++++++++++++ gnu/local.mk | 1 + gnu/services/databases.scm | 73 +++++++++++++++++++++++++++ gnu/tests/databases.scm | 121 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 227 insertions(+) create mode 100644 gnu/tests/databases.scm (limited to 'gnu/tests') diff --git a/doc/guix.texi b/doc/guix.texi index 3452850316..2beeaf9779 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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. diff --git a/gnu/local.mk b/gnu/local.mk index 9f0915ff6b..ff47777650 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -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 \ diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index 3ecc8aff78..3b64d0e075 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -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-memecached + memcached-configuration-interfaces + memcached-configuration-tcp-port + memcached-configuration-udp-port + memcached-configuration-additional-options + mysql-service mysql-service-type mysql-configuration @@ -176,6 +187,68 @@ and stores the database cluster in @var{data-directory}." (config-file config-file) (data-directory data-directory)))) + +;;; +;;; Memcached +;;; + +(define-record-type* + memcached-configuration make-memcached-configuration + memcached-configuration? + (memcached memcached-configuration-memcached ; + (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 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. diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm new file mode 100644 index 0000000000..310210c368 --- /dev/null +++ b/gnu/tests/databases.scm @@ -0,0 +1,121 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Christopher Baines +;;; +;;; 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 . + +(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)))) -- cgit v1.2.3