gnu/tests/networking.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu tests networking)
  20   #:use-module (gnu tests)
  21   #:use-module (gnu system)
  22   #:use-module (gnu system vm)
  23   #:use-module (gnu services)
  24   #:use-module (gnu services networking)
  25   #:use-module (guix gexp)
  26   #:use-module (guix store)
  27   #:use-module (guix monads)
  28   #:use-module (gnu packages bash)
  29   #:export (%test-inetd))
  30
  31 (define %inetd-os
  32   ;; Operating system with 2 inetd services.
  33   (simple-operating-system
  34    (dhcp-client-service)
  35    (service inetd-service-type
  36             (inetd-configuration
  37              (entries (list
  38                        (inetd-entry
  39                         (name "echo")
  40                         (socket-type 'stream)
  41                         (protocol "tcp")
  42                         (wait? #f)
  43                         (user "root"))
  44                        (inetd-entry
  45                         (name "dict")
  46                         (socket-type 'stream)
  47                         (protocol "tcp")
  48                         (wait? #f)
  49                         (user "root")
  50                         (program (file-append bash
  51                                               "/bin/bash"))
  52                         (arguments
  53                          (list "bash" (plain-file "my-dict.sh" "\
  54 while read line
  55 do
  56     if [[ $line =~ ^DEFINE\\ (.*)$ ]]
  57     then
  58         case ${BASH_REMATCH[1]} in
  59             Guix)
  60                 echo GNU Guix is a package management tool for the GNU system.
  61                 ;;
  62             G-expression)
  63                 echo Like an S-expression but with a G.
  64                 ;;
  65             *)
  66                 echo NO DEFINITION FOUND
  67                 ;;
  68         esac
  69     else
  70         echo ERROR
  71     fi
  72 done" ))))))))))
  73
  74 (define* (run-inetd-test)
  75   "Run tests in %INETD-OS, where the inetd service provides an echo service on
  76 port 7, and a dict service on port 2628."
  77   (mlet* %store-monad ((os -> (marionette-operating-system %inetd-os))
  78                        (command (system-qemu-image/shared-store-script
  79                                  os #:graphic? #f)))
  80     (define test
  81       (with-imported-modules '((gnu build marionette))
  82         #~(begin
  83             (use-modules (ice-9 rdelim)
  84                          (srfi srfi-64)
  85                          (gnu build marionette))
  86             (define marionette
  87               ;; Forward guest ports 7 and 2628 to host ports 8007 and 8628.
  88               (make-marionette (list #$command "-net"
  89                                      (string-append
  90                                       "user"
  91                                       ",hostfwd=tcp::8007-:7"
  92                                       ",hostfwd=tcp::8628-:2628"))))
  93
  94             (mkdir #$output)
  95             (chdir #$output)
  96
  97             (test-begin "inetd")
  98
  99             ;; Make sure the PID file is created.
 100             (test-assert "PID file"
 101               (marionette-eval
 102                '(file-exists? "/var/run/inetd.pid")
 103               marionette))
 104
 105             ;; Test the echo service.
 106             (test-equal "echo response"
 107               "Hello, Guix!"
 108               (let ((echo (socket PF_INET SOCK_STREAM 0))
 109                     (addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
 110                 (connect echo addr)
 111                 (display "Hello, Guix!\n" echo)
 112                 (let ((response (read-line echo)))
 113                   (close echo)
 114                   response)))
 115
 116             ;; Test the dict service
 117             (test-equal "dict response"
 118               "GNU Guix is a package management tool for the GNU system."
 119               (let ((dict (socket PF_INET SOCK_STREAM 0))
 120                     (addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
 121                 (connect dict addr)
 122                 (display "DEFINE Guix\n" dict)
 123                 (let ((response (read-line dict)))
 124                   (close dict)
 125                   response)))
 126
 127             (test-end)
 128             (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 129
 130     (gexp->derivation "inetd-test" test)))
 131
 132 (define %test-inetd
 133   (system-test
 134    (name "inetd")
 135    (description "Connect to a host with an INETD server.")
 136    (value (run-inetd-test))))