diff options
| -rw-r--r-- | doc/guix.texi | 69 | ||||
| -rw-r--r-- | gnu/services/web.scm | 131 | ||||
| -rw-r--r-- | gnu/tests/web.scm | 50 |
3 files changed, 250 insertions, 0 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 1c7ca45823c..266012a7e82 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -35893,6 +35893,75 @@ The port on which to connect to the database. @end table @end deftp +@subsubheading sogogi + +@cindex sogogi, WebDAV Server +@uref{https://codeberg.org/emersion/sogogi, sogogi} is a +server for the +@uref{https://www.rfc-editor.org/rfc/rfc4918, WebDAV} protocol. + +@defvar sogogi-service-type +This is the service type for sogogi. Its value must be a +@code{sogogi-configuration} object as in this example: + +@lisp +(service sogogi-service-type + (sogogi-configuration + (listen ":8080") + (location + (list + (sogogi-location + (path "/") + (dir "/srv/http/") + (grant '("all ro"))))))) +@end lisp +@end defvar + +@deftp {Data Type} sogogi-configuration +Available @code{sogogi-configuration} fields are: + +@table @asis +@item @code{listen} (default: @code{"localhost:8080"}) (type: string) +Listening address. + +@item @code{location} (default: @code{()}) (type: list-of-sogogi-location) +Local directories to expose via a HTTP path + +@item @code{user} (default: @code{()}) (type: list-of-sogogi-user) +Users with access to the location. + +@end table +@end deftp + +@deftp {Data Type} sogogi-location +Available @code{sogogi-location} fields are: + +@table @asis +@item @code{path} (type: string) +HTTP path at which the directory will be exposed. + +@item @code{dir} (type: string) +Path to local directory to serve. + +@item @code{grant} (type: maybe-list-of-strings) +Grant remote users access to the directory. + +@end table +@end deftp + +@deftp {Data Type} sogogi-user +Available @code{sogogi-user} fields are: + +@table @asis +@item @code{name} (type: maybe-string) +Name of the user. + +@item @code{password} (type: maybe-string) +Password of the user. + +@end table +@end deftp + @subsubheading Mumi @cindex Mumi, Debbugs Web interface diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 7df1c66b9fa..8addaa8d5ac 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -313,6 +313,15 @@ patchwork-virtualhost patchwork-service-type + sogogi-service-type + sogogi-configuration + sogogi-config-file + sogogi-configuration? + sogogi-user + sogogi-user? + sogogi-location + sogogi-location? + mumi-configuration mumi-configuration? mumi-configuration-mumi @@ -2184,6 +2193,128 @@ WSGIPassAuthorization On ;;; +;;; sogogi. +;;; + +(define (sogogi-serialize-section section-name value fields) + (let ((first-field (car fields))) + #~(format #f "~a ~a {~%~a}~%" + #$(object->string section-name) + #$((configuration-field-getter first-field) value) + #$(serialize-configuration value (cdr fields))))) + +(define (sogogi-serialize-field field-name value) + (let ((field (object->string field-name))) + #~(format #f "~a ~a~%" #$field #$value))) + +(define sogogi-serialize-string sogogi-serialize-field) +(define (sogogi-serialize-list-of-strings field-name value) + #~(string-append + #$@(map (cut sogogi-serialize-string field-name <>) + value))) + +(define-maybe string (prefix sogogi-)) +(define-maybe list-of-strings (prefix sogogi-)) + +(define-configuration sogogi-user + (name + maybe-string + "Name of the user.") + + (password + maybe-string + "Password of the user.") + + (prefix sogogi-)) + +(define (sogogi-serialize-sogogi-user field-name value) + (sogogi-serialize-section field-name value sogogi-user-fields)) + +(define-configuration sogogi-location + (path + string + "HTTP path at which the directory will be exposed.") + + (dir + string + "Path to local directory to serve.") + + (grant + maybe-list-of-strings + "Grant remote users access to the directory.") + + (prefix sogogi-)) + +(define (sogogi-serialize-sogogi-location field-name value) + (sogogi-serialize-section field-name value sogogi-location-fields)) + +(define (sogogi-serialize-list-of-sogogi-location field-name value) + #~(string-append #$@(map (cut sogogi-serialize-sogogi-location field-name <>) value))) + +(define (sogogi-serialize-list-of-sogogi-user field-name value) + #~(string-append #$@(map (cut sogogi-serialize-sogogi-user field-name <>) value))) + +(define list-of-sogogi-user? (list-of sogogi-user?)) +(define list-of-sogogi-location? (list-of sogogi-location?)) + +(define-configuration sogogi-configuration + (listen + (string "localhost:8080") + "Listening address.") + + (location + (list-of-sogogi-location '()) + "Local directories to expose via a HTTP path.") + + (user + (list-of-sogogi-user '()) + "Users with access to the location.") + + (prefix sogogi-)) + +(define (sogogi-config-file config) + (mixed-text-file "sogogi.conf" + (serialize-configuration + config + sogogi-configuration-fields))) + +(define (sogogi-shepherd-service config) + (let ((config-file (sogogi-config-file config))) + (list (shepherd-service + (documentation "Sogogi daemon.") + (provision '(sogogi)) + ;; sogogi may be bound to a particular IP address, hence + ;; only start it after the networking service has started. + (requirement '(user-processes networking)) + (actions (list (shepherd-configuration-action config-file))) + (start #~(make-forkexec-constructor + (list (string-append #$sogogi "/bin/sogogi") + "-config" #$config-file))) + (stop #~(make-kill-destructor)))))) + +(define sogogi-account-service + (list (user-group (name "sogogi") (system? #t)) + (user-account + (name "sogogi") + (group "sogogi") + (system? #t) + (comment "Sogogi daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define sogogi-service-type + (service-type (name 'sogogi) + (description "Run the sogogi WebDAV server.") + (extensions + (list (service-extension account-service-type + (const sogogi-account-service)) + (service-extension shepherd-root-service-type + sogogi-shepherd-service))) + (compose concatenate) + (default-value (sogogi-configuration)))) + + +;;; ;;; Mumi. ;;; diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 5c8905f62b8..b06cbcec115 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -60,6 +60,7 @@ %test-anonip %test-go-webdav %test-patchwork + %test-sogogi %test-agate %test-miniflux-admin-string %test-miniflux-admin-file @@ -782,6 +783,55 @@ HTTP-PORT." ;;; +;;; sogogi +;;; + +(define %sogogi-os + (simple-operating-system + (service dhcpcd-service-type) + (simple-service 'make-http-root activation-service-type + %make-http-root) + (service sogogi-service-type + (sogogi-configuration + (listen ":8080") + (user + (list + (sogogi-user + (name "testuser") + (password "testpass")))) + (location + (list + (sogogi-location + (path "/") + (dir "/srv/http/") + (grant '("all ro" "user:testuser rw"))))))))) + +(define %test-sogogi + (system-test + (name "sogogi") + (description "Test that the sogogi can handle HTTP requests.") + (value + (let ((http-port 8080)) + (run-webserver-test name %sogogi-os + #:http-port http-port + #:extra-tests + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette) + (web uri) + (web client) + (web response)) + + (test-equal "unauthenticated delete" + 401 + (let-values + (((response _) + (http-delete #$(simple-format + #f "http://localhost:~A/index.html" http-port)))) + (response-code response))))))))) + + +;;; ;;; Agate ;;; |