guix-channel

  1(define-module (nmeum services web)
  2  #:use-module (nmeum packages misc)
  3  #:use-module (guix gexp)
  4  #:use-module (gnu packages admin)
  5  #:use-module (gnu services)
  6  #:use-module (gnu services base)
  7  #:use-module (gnu services configuration)
  8  #:use-module (gnu services shepherd)
  9  #:use-module (gnu system accounts)
 10  #:use-module (gnu system shadow)
 11  #:use-module (srfi srfi-1)
 12  #:use-module (srfi srfi-26)
 13  #:export (sogogi-service-type
 14            sogogi-configuration
 15            sogogi-config-file
 16            sogogi-configuration-fields
 17            sogogi-configuration?
 18            sogogi-user
 19            sogogi-user?
 20            sogogi-location
 21            sogogi-location?))
 22
 23(define (sosogi-serialize-section section-name value fields)
 24  (let ((first-field (car fields)))
 25    #~(format #f "~a ~a {~%~a}~%"
 26              #$(object->string section-name)
 27              #$((configuration-field-getter first-field) value)
 28              #$(serialize-configuration value (cdr fields)))))
 29
 30(define (sogogi-serialize-field field-name value)
 31  (let ((field (object->string field-name)))
 32    #~(format #f "~a ~a~%" #$field #$value)))
 33
 34(define sogogi-serialize-string sogogi-serialize-field)
 35(define (sogogi-serialize-list-of-strings field-name value)
 36  #~(string-append
 37      #$@(map (cut sogogi-serialize-string field-name <>)
 38              value)))
 39
 40(define-maybe string (prefix sogogi-))
 41(define-maybe list-of-strings (prefix sogogi-))
 42
 43(define-configuration sogogi-user
 44  (name
 45    maybe-string
 46    "Name of the user.")
 47
 48  (password
 49    maybe-string
 50    "Password of the user.")
 51
 52  (prefix sogogi-))
 53
 54(define (sogogi-serialize-sogogi-user field-name value)
 55  (sosogi-serialize-section field-name value sogogi-user-fields))
 56
 57(define-configuration sogogi-location
 58  (path
 59    string
 60    "HTTP path at which the directory will be exposed.")
 61
 62  (dir
 63    string
 64    "Path to local directory to serve.")
 65
 66  (grant
 67   maybe-list-of-strings
 68   "Grant remote users access to the directory.")
 69
 70  (prefix sogogi-))
 71
 72(define (sogogi-serialize-sogogi-location field-name value)
 73  (sosogi-serialize-section field-name value sogogi-location-fields))
 74
 75(define (sogogi-serialize-list-of-sogogi-location field-name value)
 76  #~(string-append #$@(map (cut sogogi-serialize-sogogi-location field-name <>) value)))
 77
 78(define (sogogi-serialize-list-of-sogogi-user field-name value)
 79  #~(string-append #$@(map (cut sogogi-serialize-sogogi-user field-name <>) value)))
 80
 81(define list-of-sogogi-user? (list-of sogogi-user?))
 82(define list-of-sogogi-location? (list-of sogogi-location?))
 83
 84(define-configuration sogogi-configuration
 85  (listen
 86    (string "localhost:8080")
 87    "Listening address.")
 88
 89  (location
 90    (list-of-sogogi-location '())
 91    "Local directories to expose via a HTTP path")
 92
 93  (user
 94    (list-of-sogogi-user '())
 95    "Users with access to the location.")
 96
 97  (prefix sogogi-))
 98
 99(define (sogogi-config-file config)
100  (mixed-text-file "sogogi.conf"
101    (serialize-configuration
102      config
103      sogogi-configuration-fields)))
104
105(define (sogogi-shepherd-service config)
106  (let ((config-file (sogogi-config-file config)))
107    (list (shepherd-service
108            (documentation "Sogogi daemon.")
109            (provision '(sogogi))
110            ;; sogogi may be bound to a particular IP address, hence
111            ;; only start it after the networking service has started.
112            (requirement '(user-processes networking))
113            (actions (list (shepherd-configuration-action config-file)))
114            (start #~(make-forkexec-constructor
115                       (list (string-append #$sogogi "/bin/sogogi")
116                             "-config" #$config-file)))
117            (stop #~(make-kill-destructor))))))
118
119(define sogogi-account-service
120  (list (user-group (name "sogogi") (system? #t))
121        (user-account
122         (name "sogogi")
123         (group "sogogi")
124         (system? #t)
125         (comment "Sogogi daemon user")
126         (home-directory "/var/empty")
127         (shell (file-append shadow "/sbin/nologin")))))
128
129(define sogogi-service-type
130  (service-type (name 'sogogi)
131                (description "Run the sogogi WebDAV server.")
132                (extensions
133                  (list (service-extension account-service-type
134                                           (const sogogi-account-service))
135                        (service-extension shepherd-root-service-type
136                                           sogogi-shepherd-service)))
137                (compose concatenate)
138                (default-value (sogogi-configuration))))