Re: WSDD Service Module

[Simon Streit <simon@netpanic.org>]

[-- Attachment #1: Type: text/plain, Size: 2319 bytes --]


Hello, thanks for your reply.

Ludovic Courtès <ludo@gnu.org> writes:
> My understanding is that you intend the ‘interface’ field to be either
> #f or a string, is that right?

I think it rather be a list of strings, since wsdd takes the list of
interfaces to listen to.  So it should expand to --interface eth0
--interface eth1, etc.

> When you write:
>
>   (interface)
>
> that means: “call the procedure bound to ‘interface’, passing it zero
> arguments”.  However, if ‘interface’ is a string, you cannot call it, so
> you get a wrong-type-to-apply error.
>
> Likewise, ‘for-each’ expects its second argument to be a list.  But
> here, ‘interface’ is supposedly a string, not a list, so if you do:
>
>   (for-each (lambda …) interface)
>
> you’ll get a wrong-type-argument error.

So I changed it, that interface is usually an empty list now, and with
for-each I'd like to have it expanded.  Good thing is, I've gotten at
least a step further, but only after hard coding the list as an argument
in the for-each expression.  So it should work?  It still doesn't.  And
I still don't understand how it is somehow not passed as a list
properly.

One thing I noticed, after hard coding the argument, the procedure is
not properly expanded in the constructor.  How come?  This is the output
in the service file:
--8<---------------cut here---------------start------------->8---
(make-forkexec-constructor
 (list "/gnu/store/6jpn21wnnyz59ii634hfbk34yy48nxrq-wsdd-0.6.4/bin/wsdd" "--hoplimit" "1" for-each
       (lambda
           (arg)
         (format #t "--interface ~s "
                 (arg)))
       (interface)
       "--workgroup" "WORKGROUP")
 #:user "wsdd" #:group "wsdd" #:log-file "/var/log/wsdd.log")
--8<---------------cut here---------------end--------------->8---

My for-each procedure and list works in my REPL, but it fails in Guix.
It might have to do with me trying to get on with
make-forkexec-constructor.  So this constructor needs a list of strings?
I put interfaces into a let*, and would call it in the constructor.
Unfortunately this results into an invalid G-expression.


Thanks for you help.  It is taking its time to get comfortable with
Guile.

I've attached the current state of the service too.


[-- Attachment #2: wsdd.scm --]
[-- Type: application/octet-stream, Size: 8140 bytes --]

(define-module (services samba)

  #:use-module (gnu packages)
  #:use-module (gnu packages base)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages samba)

  #:use-module (gnu services)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services base)
  #:use-module (gnu system shadow)

  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix modules)
  #:use-module (guix records)

  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (ice-9 textual-ports)
  #:use-module (srfi srfi-1)

  #:export (wsdd-service
            wsdd-service-type
            wsdd-configuration
            wsdd-configuration?
            wsdd-configuration-package
            wsdd-configuration-ipv4only?
            wsdd-configuration-ipv6only?
            wsdd-configuration-chroot
            wsdd-configuration-hoplimit
            wsdd-configuration-interface
            wsdd-configuration-uuid-device
            wsdd-configuration-domain
            wsdd-configuration-hostname
            wsdd-configuration-preserve-case?
            wsdd-configuration-workgroup))

\f
;;;
;;; WSDD
;;;

(define-record-type* <wsdd-configuration>
  wsdd-configuration
  make-wsdd-configuration
  wsdd-configuration?
  (package               wsdd-configuration-package
                         (default wsdd))
  (ipv4only?             wsdd-configuration-ipv4only?
                         (default #f))
  (ipv6only?             wsdd-configuration-ipv6only?
                         (default #f))
  (chroot                wsdd-configuration-chroot
                         (default #f))
  (hoplimit              wsdd-configuration-hoplimit
                         (default 1))
  (interface             wsdd-configuration-interface
                         (default '()))
  (uuid-device           wsdd-configuration-uuid-device
                         (default #f))
  (domain                wsdd-configuration-domain
                         (default #f))
  (hostname              wsdd-configuration-hostname
                         (default #f))
  (preserve-case?        wsdd-configuration-preserve-case?
                         (default #f))
  (workgroup             wsdd-configuration-workgroup
                         (default "WORKGROUP")))

(define wsdd-accounts
  (list
   (user-group (name "wsdd"))
   (user-account (name "wsdd")
                 (group "wsdd")
                 (comment "Web Service Discovery user")
                 (home-directory "/var/empty")
                 (shell (file-append shadow "/sbin/nologin")))))

(define wsdd-shepherd-service
  (match-lambda
    (($ <wsdd-configuration> package
                             ipv4only?
                             ipv6only?
                             chroot
                             hoplimit
                             interface
                             uuid-device
                             domain
                             hostname
                             preserve-case?
                             workgroup
                             )
     (let* ((interfaces (for-each (lambda (interface)
                                    ;; (display (string-append "--interface" interface))
                                    (format #t "--interface ~s " interface))
                                  '("eth0" "eth1"))))
       (list (shepherd-service
              (documentation "Run a Web Service Discovery service")
              (provision '(wsdd))
              (requirement '(networking))
              (start #~(make-forkexec-constructor
                        (list #$(file-append package "/bin/wsdd")
                              #$@(if ipv4only?
                                     #~("--ipv4only")
                                     '())
                              #$@(if ipv6only?
                                     #~("--ipv6only")
                                     '())
                              #$@(if chroot
                                     #~("--chroot" #$chroot)
                                     '())
                              #$@(if hoplimit
                                     #~("--hoplimit" #$(number->string hoplimit))
                                     '())

                              ;; FIXME, this results into wrong type applied.
                              ;; #$(if interface
                              ;;       (for-each (lambda (interface)
                              ;;                   (display (string-append "--interface" interface))
                              ;;                   ;; (format #t "--interface ~a " interface)
                              ;;                   )
                              ;;                 '("eth1" "eth2")))

                              ;; this one is fine, but the for-each
                              ;; expression is not expanded and is
                              ;; kept in place in the service unit.
                              ;; See end of this file.
                              #$@(if interface
                                     #~(for-each (lambda (interface)
                                                 ;; (display (string-append "--interface" interface))
                                                 (format #t "--interface ~s " interface
                                                         ;; (list->string arg)
                                                         ))
                                               '("eth0" "eth1"))
                                     '())

                              ;; #$interfaces

                              ;; #$@(if interface
                              ;;        #~(for-each (lambda (interface)
                              ;;                      ;; (display (string-append "--interface" interface))
                              ;;                      (format #t "--interface ~s " interface))
                              ;;                    '("eth0" "eth1"))
                              ;;        '())

                              ;; #$(for-each (lambda (interface)
                              ;;               (display (string-append "--interface" interface))
                              ;;               ;; (format #f "--interface ~s " interface
                              ;;               ;;         ;; (list->string arg)
                              ;;               ;;         )
                              ;;               )
                              ;;             '("eth0" "eth1"))

                              ;; #$@(if interface ;to be replaced by procedure above
                              ;;        #~("--interface" #$interface)
                              ;;        '())

                              #$@(if uuid-device
                                     #~("--uuid" #$uuid-device)
                                     '())
                              #$@(if domain
                                     #~("--domain" #$domain)
                                     '())
                              #$@(if hostname
                                     #~("--hostname" #$hostname)
                                     '())
                              #$@(if preserve-case?
                                     #~("--preserve-case")
                                     '())
                              #$@(if workgroup
                                     #~("--workgroup" #$workgroup)
                                     '()))
                        #:user "wsdd"
                        #:group "wsdd"
                        #:log-file "/var/log/wsdd.log"))
              (stop #~(make-kill-destructor))))))))

(define wsdd-service-type
  (service-type
   (name 'wsdd)
   (description "Web Service Discovery Daemon")
   (extensions
    (list (service-extension shepherd-root-service-type
                             wsdd-shepherd-service)
          (service-extension account-service-type
                             (const wsdd-accounts))))
   (default-value (wsdd-configuration))))

[-- Attachment #3: Type: text/plain, Size: 21 bytes --]



Kind regards
Simon