gnu: services: web: Add service for httpd.

* gnu/services/web.scm (<httpd-module>,
  <httpd-config-file>, <httpd-virtualhost>
  <httpd-configuration>): New record types.
  (%default-httpd-modules, %httpd-accounts,
  httpd-service-type): New variables.
  (httpd-shepherd-services, httpd-activation,
  httpd-process-extensions): New procedures.
* gnu/tests/web.scm (run-httpd-test): New procedure.
  (%httpd-os, %tests-httpd): New variables.
* doc/guix.texi (Web Services): Document the Apache HTTP Server.

3 files changed, 409 insertions, 4 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 17a9a74b2a..161d3cfb45 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14954,8 +14954,162 @@ Local accounts with lower values will silently fail to authenticate.
 @cindex web
 @cindex www
 @cindex HTTP
-The @code{(gnu services web)} module provides the nginx web server and
-also a fastcgi wrapper daemon.
+The @code{(gnu services web)} module provides the Apache HTTP Server,
+the nginx web server, and also a fastcgi wrapper daemon.
+
+@subsubheading Apache HTTP Server
+
+@deffn {Scheme Variable} httpd-service-type
+Service type for the @uref{https://httpd.apache.org/,Apache HTTP} server
+(@dfn{httpd}).  The value for this service type is a
+@code{https-configuration} record.
+
+A simple example configuration is given below.
+
+@example
+(service httpd-service-type
+         (httpd-configuration
+           (config
+             (httpd-config-file
+               (server-name "www.example.com")
+               (document-root "/srv/http/www.example.com")))))
+@end example
+
+Other services can also extend the @code{httpd-service-type} to add to
+the configuration.
+
+@example
+(simple-service 'my-extra-server httpd-service-type
+                (list
+                  (httpd-virtualhost
+                    "*:80"
+                    (list (string-append
+                           "ServerName "www.example.com
+                            DocumentRoot \"/srv/http/www.example.com\"")))))
+@end example
+@end deffn
+
+The details for the @code{httpd-configuration}, @code{httpd-module},
+@code{httpd-config-file} and @code{httpd-virtualhost} record types are
+given below.
+
+@deffn {Data Type} httpd-configuration
+This data type represents the configuration for the httpd service.
+
+@table @asis
+@item @code{package} (default: @code{httpd})
+The httpd package to use.
+
+@item @code{pid-file} (default: @code{"/var/run/httpd"})
+The pid file used by the shepherd-service.
+
+@item @code{config} (default: @code{(httpd-config-file)})
+The configuration file to use with the httpd service. The default value
+is a @code{httpd-config-file} record, but this can also be a different
+G-expression that generates a file, for example a @code{plain-file}. A
+file outside of the store can also be specified through a string.
+
+@end table
+@end deffn
+
+@deffn {Data Type} httpd-module
+This data type represents a module for the httpd service.
+
+@table @asis
+@item @code{name}
+The name of the module.
+
+@item @code{file}
+The file for the module. This can be relative to the httpd package being
+used, the absolute location of a file, or a G-expression for a file
+within the store, for example @code{(file-append mod-wsgi
+"/modules/mod_wsgi.so")}.
+
+@end table
+@end deffn
+
+@deffn {Data Type} httpd-config-file
+This data type represents a configuration file for the httpd service.
+
+@table @asis
+@item @code{modules} (default: @code{%default-httpd-modules})
+The modules to load. Additional modules can be added here, or loaded by
+additional configuration.
+
+@item @code{server-root} (default: @code{httpd})
+The @code{ServerRoot} in the configuration file, defaults to the httpd
+package. Directives including @code{Include} and @code{LoadModule} are
+taken as relative to the server root.
+
+@item @code{server-name} (default: @code{#f})
+The @code{ServerName} in the configuration file, used to specify the
+request scheme, hostname and port that the server uses to identify
+itself.
+
+This doesn't need to be set in the server config, and can be specifyed
+in virtual hosts. The default is @code{#f} to not specify a
+@code{ServerName}.
+
+@item @code{document-root} (default: @code{"/srv/http"})
+The @code{DocumentRoot} from which files will be served.
+
+@item @code{listen} (default: @code{'("80")})
+The list of values for the @code{Listen} directives in the config
+file. The value should be a list of strings, when each string can
+specify the port number to listen on, and optionally the IP address and
+protocol to use.
+
+@item @code{pid-file} (default: @code{"/var/run/httpd"})
+The @code{PidFile} to use. This should match the @code{pid-file} set in
+the @code{httpd-configuration} so that the Shepherd service is
+configured correctly.
+
+@item @code{error-log} (default: @code{"/var/log/httpd/error_log"})
+The @code{ErrorLog} to which the server will log errors.
+
+@item @code{user} (default: @code{"httpd"})
+The @code{User} which the server will answer requests as.
+
+@item @code{group} (default: @code{"httpd"})
+The @code{Group} which the server will answer requests as.
+
+@item @code{extra-config} (default: @code{(list "TypesConfig etc/httpd/mime.types")})
+A flat list of strings and G-expressions which will be added to the end
+of the configuration file.
+
+Any values which the service is extended with will be appended to this
+list.
+
+@end table
+@end deffn
+
+@deffn {Data Type} httpd-virtualhost
+This data type represents a virtualhost configuration block for the httpd service.
+
+These should be added to the extra-config for the httpd-service.
+
+@example
+(simple-service 'my-extra-server httpd-service-type
+                (list
+                  (httpd-virtualhost
+                    "*:80"
+                    (list (string-append
+                           "ServerName "www.example.com
+                            DocumentRoot \"/srv/http/www.example.com\"")))))
+@end example
+
+@table @asis
+@item @code{addresses-and-ports}
+The addresses and ports for the @code{VirtualHost} directive.
+
+@item @code{contents}
+The contents of the @code{VirtualHost} directive, this should be a list
+of strings and G-expressions.
+
+@end table
+@end deffn
+
+@subsubheading NGINX
 
 @deffn {Scheme Variable} nginx-service-type
 Service type for the @uref{https://nginx.org/,NGinx} web server.  The
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 2371ddb6d0..c1ffe3e055 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -34,8 +34,36 @@
   #:use-module ((guix utils) #:select (version-major))
   #:use-module ((guix packages) #:select (package-version))
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (ice-9 match)
-  #:export (<nginx-configuration>
+  #:export (<httpd-configuration>
+            httpd-configuration
+            httpd-configuration?
+            httpd-configuration-package
+            httpd-configuration-pid-file
+            httpd-configuration-config
+
+            <httpd-virtualhost>
+            httpd-virtualhost
+            httpd-virtualhost?
+            httpd-virtualhost-addresses-and-ports
+            httpd-virtualhost-contents
+
+            <httpd-config-file>
+            httpd-config-file
+            httpd-config-file?
+            httpd-config-file-modules
+            httpd-config-file-server-root
+            httpd-config-file-server-name
+            httpd-config-file-listen
+            httpd-config-file-pid-file
+            httpd-config-file-error-log
+            httpd-config-file-user
+            httpd-config-file-group
+
+            httpd-service-type
+
+            <nginx-configuration>
             nginx-configuration
             nginx-configuration?
             nginx-configuartion-nginx
@@ -133,6 +161,205 @@
 ;;;
 ;;; Code:
 
+(define-record-type* <httpd-module>
+  httpd-module make-httpd-module
+  httpd-module?
+  (name httpd-load-module-name)
+  (file httpd-load-module-file))
+
+;; Default modules for the httpd-service-type, taken from etc/httpd/httpd.conf
+;; file in the httpd package.
+(define %default-httpd-modules
+  (map (match-lambda
+         ((name file)
+          (httpd-module
+           (name name)
+           (file file))))
+       '(("authn_file_module" "modules/mod_authn_file.so")
+         ("authn_core_module" "modules/mod_authn_core.so")
+         ("authz_host_module" "modules/mod_authz_host.so")
+         ("authz_groupfile_module" "modules/mod_authz_groupfile.so")
+         ("authz_user_module" "modules/mod_authz_user.so")
+         ("authz_core_module" "modules/mod_authz_core.so")
+         ("access_compat_module" "modules/mod_access_compat.so")
+         ("auth_basic_module" "modules/mod_auth_basic.so")
+         ("reqtimeout_module" "modules/mod_reqtimeout.so")
+         ("filter_module" "modules/mod_filter.so")
+         ("mime_module" "modules/mod_mime.so")
+         ("log_config_module" "modules/mod_log_config.so")
+         ("env_module" "modules/mod_env.so")
+         ("headers_module" "modules/mod_headers.so")
+         ("setenvif_module" "modules/mod_setenvif.so")
+         ("version_module" "modules/mod_version.so")
+         ("unixd_module" "modules/mod_unixd.so")
+         ("status_module" "modules/mod_status.so")
+         ("autoindex_module" "modules/mod_autoindex.so")
+         ("dir_module" "modules/mod_dir.so")
+         ("alias_module" "modules/mod_alias.so"))))
+
+(define-record-type* <httpd-config-file>
+  httpd-config-file make-httpd-config-file
+  httpd-config-file?
+  (modules        httpd-config-file-modules
+                  (default %default-httpd-modules))
+  (server-root    httpd-config-file-server-root
+                  (default httpd))
+  (server-name    httpd-config-file-server-name
+                  (default #f))
+  (document-root  httpd-config-file-document-root
+                  (default "/srv/http"))
+  (listen         httpd-config-file-listen
+                  (default '("80")))
+  (pid-file       httpd-config-file-pid-file
+                  (default "/var/run/httpd"))
+  (error-log      httpd-config-file-error-log
+                  (default "/var/log/httpd/error_log"))
+  (user           httpd-config-file-user
+                  (default "httpd"))
+  (group          httpd-config-file-group
+                  (default "httpd"))
+  (extra-config   httpd-config-file-extra-config
+                  (default
+                    (list "TypesConfig etc/httpd/mime.types"))))
+
+(define-gexp-compiler (httpd-config-file-compiler
+                       (file <httpd-config-file>) system target)
+  (match file
+    (($ <httpd-config-file> load-modules server-root server-name
+                                   document-root listen pid-file error-log
+                                   user group extra-config)
+     (gexp->derivation
+      "httpd.conf"
+      #~(call-with-output-file (ungexp output "out")
+          (lambda (port)
+            (display
+             (string-append
+              (ungexp-splicing
+               `(,@(append-map
+                    (match-lambda
+                      (($ <httpd-module> name module)
+                       `("LoadModule " ,name " " ,module "\n")))
+                    load-modules)
+                 ,@`("ServerRoot " ,server-root "\n")
+                 ,@(if server-name
+                       `("ServerName " ,server-name "\n")
+                       '())
+                 ,@`("DocumentRoot " ,document-root "\n")
+                 ,@(append-map
+                    (lambda (listen-value)
+                      `("Listen " ,listen-value "\n"))
+                    listen)
+                 ,@(if pid-file
+                       `("Pidfile " ,pid-file "\n")
+                       '())
+                 ,@(if error-log
+                       `("ErrorLog " ,error-log "\n")
+                       '())
+                 ,@(if user
+                       `("User " ,user "\n")
+                       '())
+                 ,@(if group
+                       `("Group " ,group "\n")
+                       '())
+                 "\n\n"
+                 ,@extra-config)))
+             port)))
+      #:local-build? #t))))
+
+(define-record-type <httpd-virtualhost>
+  (httpd-virtualhost addresses-and-ports contents)
+  httpd-virtualhost?
+  (addresses-and-ports httpd-virtualhost-addresses-and-ports)
+  (contents            httpd-virtualhost-contents))
+
+(define-record-type* <httpd-configuration>
+  httpd-configuration make-httpd-configuration
+  httpd-configuration?
+  (package  httpd-configuration-package
+            (default httpd))
+  (pid-file httpd-configuration-pid-file
+            (default "/var/run/httpd"))
+  (config   httpd-configuration-config
+            (default (httpd-config-file))))
+
+(define %httpd-accounts
+  (list (user-group (name "httpd") (system? #t))
+        (user-account
+         (name "httpd")
+         (group "httpd")
+         (system? #t)
+         (comment "Apache HTTPD server user")
+         (home-directory "/var/empty")
+         (shell (file-append shadow "/sbin/nologin")))))
+
+(define httpd-shepherd-services
+  (match-lambda
+    (($ <httpd-configuration> package pid-file config)
+     (list (shepherd-service
+            (provision '(httpd))
+            (documentation "The Apache HTTP Server")
+            (requirement '(networking))
+            (start #~(make-forkexec-constructor
+                      `(#$(file-append package "/bin/httpd")
+                        #$@(if config
+                               (list "-f" config)
+                               '()))
+                      #:pid-file #$pid-file))
+            (stop #~(make-kill-destructor)))))))
+
+(define httpd-activation
+  (match-lambda
+    (($ <httpd-configuration> package pid-file config)
+     (match-record
+      config
+      <httpd-config-file>
+      (error-log document-root)
+      #~(begin
+          (use-modules (guix build utils))
+
+          (mkdir-p #$(dirname error-log))
+          (mkdir-p #$document-root))))))
+
+(define (httpd-process-extensions original-config extension-configs)
+  (let ((config (httpd-configuration-config
+                 original-config)))
+    (if (httpd-config-file? config)
+        (httpd-configuration
+         (inherit original-config)
+         (config
+          (httpd-config-file
+           (inherit config)
+           (extra-config
+            (append (httpd-config-file-extra-config config)
+                    (append-map
+                     (match-lambda
+                       (($ <httpd-virtualhost>
+                           addresses-and-ports
+                           contents)
+                        `(,(string-append
+                            "<VirtualHost " addresses-and-ports ">\n")
+                          ,@contents
+                          "\n</VirtualHost>\n"))
+                       ((? string? x)
+                        `("\n" ,x "\n"))
+                       ((? list? x)
+                        `("\n" ,@x "\n")))
+                     extension-configs)))))))))
+
+(define httpd-service-type
+  (service-type (name 'httpd)
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          httpd-shepherd-services)
+                       (service-extension activation-service-type
+                                          httpd-activation)
+                       (service-extension account-service-type
+                                          (const %httpd-accounts))))
+                (compose concatenate)
+                (extend httpd-process-extensions)
+                (default-value
+                  (httpd-configuration))))
+
 (define-record-type* <nginx-server-configuration>
   nginx-server-configuration make-nginx-server-configuration
   nginx-server-configuration?
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 5595e9ddf9..1912f8f79d 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -29,7 +29,8 @@
   #:use-module (gnu services networking)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:export (%test-nginx
+  #:export (%test-httpd
+            %test-nginx
             %test-php-fpm))
 
 (define %index.html-contents
@@ -114,6 +115,29 @@ HTTP-PORT."
 
 
 ;;;
+;;; HTTPD
+;;;
+
+(define %httpd-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (service httpd-service-type
+            (httpd-configuration
+             (config
+              (httpd-config-file
+               (listen '("8080"))))))
+   (simple-service 'make-http-root activation-service-type
+                   %make-http-root)))
+
+(define %test-httpd
+  (system-test
+   (name "httpd")
+   (description "Connect to a running HTTPD server.")
+   (value (run-webserver-test name %httpd-os
+                              #:log-file "/var/log/httpd/error_log"))))
+
+
+;;;
 ;;; NGINX
 ;;;