kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/ext/http/http/http_unix_daemon.pl

@@ -0,0 +1,989 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2013-2023, University of Amsterdam
+                              VU University Amsterdam
+                              CWI, Amsterdam
+                              SWI-Prolog Solutions b.v.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(http_unix_daemon,
+          [ http_daemon/0,
+            http_daemon/1,                  % +Options
+            http_opt_type/3,                % ?Flag, ?Option, ?Type
+            http_opt_help/2,                % ?Option, ?Help
+            http_opt_meta/2                 % ?Option, ?Meta
+          ]).
+:- use_module(library(error)).
+:- use_module(library(apply)).
+:- use_module(library(lists)).
+:- use_module(library(debug)).
+:- use_module(library(broadcast)).
+:- use_module(library(socket)).
+:- use_module(library(option)).
+:- use_module(library(uid)).
+:- use_module(library(unix)).
+:- use_module(library(syslog)).
+:- use_module(library(http/thread_httpd)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_host)).
+:- use_module(library(main)).
+:- use_module(library(readutil)).
+
+:- if(( exists_source(library(http/http_ssl_plugin)),
+        \+ current_prolog_flag(pldoc_to_tex,true))).
+:- use_module(library(ssl)).
+:- use_module(library(http/http_ssl_plugin)).
+:- endif.
+
+:- multifile
+    http_server_hook/1,                     % +Options
+    http_certificate_hook/3,                % +CertFile, +KeyFile, -Password
+    http:sni_options/2.                     % +HostName, +SSLOptions
+
+:- initialization(http_daemon, main).
+
+/** <module> Run SWI-Prolog HTTP server as a Unix system daemon
+
+This module provides the logic that  is   needed  to integrate a process
+into the Unix service (daemon) architecture. It deals with the following
+aspects,  all  of  which  may  be   used/ignored  and  configured  using
+commandline options:
+
+  - Select the port(s) to be used by the server
+  - Run the startup of the process as root to perform privileged
+    tasks and the server itself as unprivileged user, for example
+    to open ports below 1000.
+  - Fork and detach from the controlling terminal
+  - Handle console and debug output using a file and/or the syslog
+    daemon.
+  - Manage a _|pid file|_
+
+The typical use scenario is to  write   a  file that loads the following
+components:
+
+  1. The application code, including http handlers (see http_handler/3).
+  2. This library
+
+In the code below, =|?- [load].|= loads   the remainder of the webserver
+code.  This is often a sequence of use_module/1 directives.
+
+  ==
+  :- use_module(library(http/http_unix_daemon)).
+
+  :- [load].
+  ==
+
+The   program   entry   point   is     http_daemon/0,   declared   using
+initialization/2. This may be overruled using   a  new declaration after
+loading  this  library.  The  new  entry    point  will  typically  call
+http_daemon/1 to start the server in a preconfigured way.
+
+  ==
+  :- use_module(library(http/http_unix_daemon)).
+  :- initialization(run, main).
+
+  run :-
+      ...
+      http_daemon(Options).
+  ==
+
+Now,  the  server  may  be  started    using   the  command  below.  See
+http_daemon/0 for supported options.
+
+  ==
+  % [sudo] swipl mainfile.pl [option ...]
+  ==
+
+Below are some examples. Our first example is completely silent, running
+on port 80 as user =www=.
+
+  ==
+  % swipl mainfile.pl --user=www --pidfile=/var/run/http.pid
+  ==
+
+Our second example logs HTTP  interaction   with  the  syslog daemon for
+debugging purposes. Note that the argument   to =|--debug|== is a Prolog
+term and must often be escaped to   avoid  misinterpretation by the Unix
+shell.   The debug option can be repeated to log multiple debug topics.
+
+  ==
+  % swipl mainfile.pl --user=www --pidfile=/var/run/http.pid \
+          --debug='http(request)' --syslog=http
+  ==
+
+*Broadcasting* The library uses  broadcast/1   to  allow hooking certain
+events:
+
+  - http(pre_server_start)
+  Run _after_ _fork_, just before starting the HTTP server.  Can be used
+  to load additional files or perform additional initialisation, such as
+  starting additional threads.  Recall that it is not possible to start
+  threads _before_ forking.
+
+  - http(post_server_start)
+  Run _after_ starting the HTTP server.
+
+@tbd    Cleanup issues wrt. loading and initialization of xpce.
+@see    The file <swi-home>/doc/packages/examples/http/linux-init-script
+        provides a /etc/init.d script for controlling a server as a normal
+        Unix service.
+*/
+
+:- debug(daemon).
+
+% Do not run xpce in a thread. This disables forking. The problem here
+% is that loading library(pce) starts the event dispatching thread. This
+% should be handled lazily.
+
+:- set_prolog_flag(xpce_threaded,   false).
+:- set_prolog_flag(message_ide,     false). % cause xpce to trap messages
+:- set_prolog_flag(message_context, [thread,time('%F %T.%3f')]).
+:- dynamic interactive/0.
+
+%!  http_daemon
+%
+%   Start the HTTP server  as  a   daemon  process.  This  predicate
+%   processes the commandline arguments below. Commandline arguments
+%   that specify servers are processed  in   the  order  they appear
+%   using the following schema:
+%
+%     1. Arguments that act as default for all servers.
+%     2. =|--http=Spec|= or =|--https=Spec|= is followed by
+%        arguments for that server until the next =|--http=Spec|=
+%        or =|--https=Spec|= or the end of the options.
+%     3. If no =|--http=Spec|= or =|--https=Spec|= appears, one
+%        HTTP server is created from the specified parameters.
+%
+%     Examples:
+%
+%       ==
+%       --workers=10 --http --https
+%       --http=8080 --https=8443
+%       --http=localhost:8080 --workers=1 --https=8443 --workers=25
+%       ==
+%
+%     $ --port=Port :
+%     Start HTTP server at Port. It requires root permission and the
+%     option =|--user=User|= to open ports below 1000.  The default
+%     port is 80. If =|--https|= is used, the default port is 443.
+%
+%     $ --ip=IP :
+%     Only listen to the given IP address.  Typically used as
+%     =|--ip=localhost|= to restrict access to connections from
+%     _localhost_ if the server itself is behind an (Apache)
+%     proxy server running on the same host.
+%
+%     $ --debug=Topic :
+%     Enable debugging Topic.  See debug/3.
+%
+%     $ --syslog=Ident :
+%     Write debug messages to the syslog daemon using Ident
+%
+%     $ --user=User :
+%     When started as root to open a port below 1000, this option
+%     must be provided to switch to the target user for operating
+%     the server. The following actions are performed as root, i.e.,
+%     _before_ switching to User:
+%
+%       - open the socket(s)
+%       - write the pidfile
+%       - setup syslog interaction
+%       - Read the certificate, key and password file (=|--pwfile=File|=)
+%
+%     $ --group=Group :
+%     May be used in addition to =|--user|=.  If omitted, the login
+%     group of the target user is used.
+%
+%     $ --pidfile=File :
+%     Write the PID of the daemon process to File.
+%
+%     $ --output=File :
+%     Send output of the process to File.  By default, all
+%     Prolog console output is discarded.
+%
+%     $ --fork[=Bool] :
+%     If given as =|--no-fork|= or =|--fork=false|=, the process
+%     runs in the foreground.
+%
+%     $ --http[=(Bool|Port|BindTo:Port)] :
+%     Create a plain HTTP server.  If the argument is missing or
+%     =true=, create at the specified or default address.  Else
+%     use the given port and interface.  Thus, =|--http|= creates
+%     a server at port 80, =|--http=8080|= creates one at port
+%     8080 and =|--http=localhost:8080|= creates one at port
+%     8080 that is only accessible from `localhost`.
+%
+%     $ --https[=(Bool|Port|BindTo:Port)] :
+%     As =|--http|=, but creates an HTTPS server.
+%     Use =|--certfile|=, =|--keyfile|=, =|-pwfile|=,
+%     =|--password|= and =|--cipherlist|= to configure SSL for
+%     this server.
+%
+%     $ --certfile=File :
+%     The server certificate for HTTPS.
+%
+%     $ --keyfile=File :
+%     The server private key for HTTPS.
+%
+%     $ --pwfile=File :
+%     File holding the password for accessing  the private key. This
+%     is preferred over using =|--password=PW|=   as it allows using
+%     file protection to avoid leaking the password.  The file is
+%     read _before_ the server drops privileges when started with
+%     the =|--user|= option.
+%
+%     $ --password=PW :
+%     The password for accessing the private key. See also `--pwfile`.
+%
+%     $ --cipherlist=Ciphers :
+%     One or more cipher strings separated by colons. See the OpenSSL
+%     documentation for more information. Starting with SWI-Prolog
+%     7.5.11, the default value is always a set of ciphers that was
+%     considered secure enough to prevent all critical attacks at the
+%     time of the SWI-Prolog release.
+%
+%     $ --interactive[=Bool] :
+%     If =true= (default =false=) implies =|--no-fork|= and presents
+%     the Prolog toplevel after starting the server.
+%
+%     $ --gtrace=[Bool] :
+%     Use the debugger to trace http_daemon/1.
+%
+%     $ --sighup=Action :
+%     Action to perform on =|kill -HUP <pid>|=.  Default is `reload`
+%     (running make/0).  Alternative is `quit`, stopping the server.
+%
+%   Other options are converted  by   argv_options/3  and  passed to
+%   http_server/1.  For example, this allows for:
+%
+%     $ --workers=Count :
+%     Set the number of workers for the multi-threaded server.
+%
+%   http_daemon/0 is defined as below.  The   start  code for a specific
+%   server can use this as a starting  point, for example for specifying
+%   defaults  or  additional  options.  This    uses   _guided_  options
+%   processing  from  argv_options/3  from   library(main).  The  option
+%   definitions are available as   http_opt_type/3,  http_opt_help/2 and
+%   http_opt_meta/2
+%
+%   ```
+%   http_daemon :-
+%       current_prolog_flag(argv, Argv),
+%       argv_options(Argv, _RestArgv, Options),
+%       http_daemon(Options).
+%   ```
+%
+%   @see http_daemon/1
+
+http_daemon :-
+    current_prolog_flag(argv, Argv),
+    argv_options(Argv, _RestArgv, Options),
+    http_daemon(Options).
+
+% Option declarations for argv_options/3 from library(main).
+
+opt_type(port,               port,               nonneg).
+opt_type(p,                  port,               nonneg).
+opt_type(ip,                 ip,                 atom).
+opt_type(debug,              debug,              term).
+opt_type(syslog,             syslog,             atom).
+opt_type(user,               user,               atom).
+opt_type(group,              group,              atom).
+opt_type(pidfile,            pidfile,            file(write)).
+opt_type(output,             output,             file(write)).
+opt_type(fork,               fork,               boolean).
+opt_type(http,               http,               nonneg|boolean).
+opt_type(https,              https,              nonneg|boolean).
+opt_type(certfile,           certfile,           file(read)).
+opt_type(keyfile,            keyfile,            file(read)).
+opt_type(pwfile,             pwfile,             file(read)).
+opt_type(password,           password,           string).
+opt_type(cipherlist,         cipherlist,         string).
+opt_type(redirect,           redirect,           string).
+opt_type(interactive,        interactive,        boolean).
+opt_type(i,                  interactive,        boolean).
+opt_type(gtrace,             gtrace,             boolean).
+opt_type(sighup,             sighup,             oneof([reload,quit])).
+opt_type(workers,            workers,            natural).
+opt_type(timeout,            timeout,            number).
+opt_type(keep_alive_timeout, keep_alive_timeout, number).
+
+opt_help(port,               "HTTP port to listen to").
+opt_help(ip,                 "Only listen to this ip (--ip=localhost)").
+opt_help(debug,              "Print debug message for topic").
+opt_help(syslog,             "Send output to syslog daemon as ident").
+opt_help(user,               "Run server under this user").
+opt_help(group,              "Run server under this group").
+opt_help(pidfile,            "Write PID to path").
+opt_help(output,             "Send output to file (instead of syslog)").
+opt_help(fork,               "Do (default) or do not fork").
+opt_help(http,               "Create HTTP server").
+opt_help(https,              "Create HTTPS server").
+opt_help(certfile,           "The server certificate").
+opt_help(keyfile,            "The server private key").
+opt_help(pwfile,             "File holding password for the private key").
+opt_help(password,           "Password for the private key").
+opt_help(cipherlist,         "Cipher strings separated by colons").
+opt_help(redirect,           "Redirect all requests to a URL or port").
+opt_help(interactive,        "Enter Prolog toplevel after starting server").
+opt_help(gtrace,             "Start (graphical) debugger").
+opt_help(sighup,             "Action on SIGHUP: reload (default) or quit").
+opt_help(workers,            "Number of HTTP worker threads").
+opt_help(timeout,            "Time to wait for client to complete request").
+opt_help(keep_alive_timeout, "Time to wait for a new request").
+
+opt_meta(port,               'PORT').
+opt_meta(ip,                 'IP').
+opt_meta(debug,              'TERM').
+opt_meta(http,               'PORT').
+opt_meta(https,              'PORT').
+opt_meta(syslog,             'IDENT').
+opt_meta(user,               'NAME').
+opt_meta(group,              'NAME').
+opt_meta(redirect,           'URL').
+opt_meta(sighup,             'ACTION').
+opt_meta(workers,            'COUNT').
+opt_meta(timeout,            'SECONDS').
+opt_meta(keep_alive_timeout, 'SECONDS').
+
+%!  http_opt_type(?Flag, ?Option, ?Type).
+%!  http_opt_help(?Option, ?Help).
+%!  http_opt_meta(?Option, ?Meta).
+%
+%   Allow reusing http option processing
+
+http_opt_type(Flag, Option, Type) :-
+    opt_type(Flag, Option, Type).
+
+http_opt_help(Option, Help) :-
+    opt_help(Option, Help),
+    Option \= help(_).
+
+http_opt_meta(Option, Meta) :-
+    opt_meta(Option, Meta).
+
+
+%!  http_daemon(+Options)
+%
+%   Start the HTTP server as a  daemon process. This predicate processes
+%   a Prolog option list. It  is   normally  called  from http_daemon/0,
+%   which derives the option list from the command line arguments.
+%
+%   Error handling depends on whether  or   not  interactive(true) is in
+%   effect. If so, the error is printed before entering the toplevel. In
+%   non-interactive mode this predicate calls halt(1).
+
+http_daemon(Options) :-
+    Error = error(_,_),
+    catch(http_daemon_guarded(Options), Error, start_failed(Error)).
+
+start_failed(Error) :-
+    interactive,
+    !,
+    print_message(warning, Error).
+start_failed(Error) :-
+    print_message(error, Error),
+    halt(1).
+
+%!  http_daemon_guarded(+Options)
+%
+%   Helper that is started from http_daemon/1. See http_daemon/1 for
+%   options that are processed.
+
+http_daemon_guarded(Options) :-
+    setup_debug(Options),
+    kill_x11(Options),
+    option_servers(Options, Servers0),
+    maplist(make_socket, Servers0, Servers),
+    (   option(fork(true), Options, true),
+        option(interactive(false), Options, false),
+        can_switch_user(Options)
+    ->  fork(Who),
+        (   Who \== child
+        ->  halt
+        ;   disable_development_system,
+            setup_syslog(Options),
+            write_pid(Options),
+            setup_output(Options),
+            switch_user(Options),
+            setup_signals(Options),
+            start_servers(Servers),
+            wait(Options)
+        )
+    ;   write_pid(Options),
+        switch_user(Options),
+        setup_signals(Options),
+        start_servers(Servers),
+        wait(Options)
+    ).
+
+%!  option_servers(+Options, -Sockets:list)
+%
+%   Find all sockets that must be created according to Options. Each
+%   socket is a term server(Scheme, Address, Opts), where Address is
+%   either a plain port (integer) or Host:Port. The latter binds the
+%   port  to  the  interface  belonging    to   Host.  For  example:
+%   socket(http, localhost:8080, Opts) creates an   HTTP socket that
+%   binds to the localhost  interface  on   port  80.  Opts  are the
+%   options specific for the given server.
+
+option_servers(Options, Sockets) :-
+    opt_sockets(Options, [], [], Sockets).
+
+opt_sockets([], Options, [], [Socket]) :-
+    !,
+    make_server(http(true), Options, Socket).
+opt_sockets([], _, Sockets, Sockets).
+opt_sockets([H|T], OptsH, Sockets0, Sockets) :-
+    server_option(H),
+    !,
+    append(OptsH, [H], OptsH1),
+    opt_sockets(T, OptsH1, Sockets0, Sockets).
+opt_sockets([H|T0], Opts, Sockets0, Sockets) :-
+    server_start_option(H),
+    !,
+    server_options(T0, T, Opts, SOpts),
+    make_server(H, SOpts, Socket),
+    append(Sockets0, [Socket], Sockets1),
+    opt_sockets(T, Opts, Sockets1, Sockets).
+opt_sockets([_|T], Opts, Sockets0, Sockets) :-
+    opt_sockets(T, Opts, Sockets0, Sockets).
+
+server_options([], [], Options, Options).
+server_options([H|T], Rest, Options0, Options) :-
+    server_option(H),
+    !,
+    generalise_option(H, G),
+    delete(Options0, G, Options1),
+    append(Options1, [H], Options2),
+    server_options(T, Rest, Options2, Options).
+server_options([H|T], [H|T], Options, Options) :-
+    server_start_option(H),
+    !.
+server_options([_|T0], Rest, Options0, Options) :-
+    server_options(T0, Rest, Options0, Options).
+
+generalise_option(H, G) :-
+    H =.. [Name,_],
+    G =.. [Name,_].
+
+server_start_option(http(_)).
+server_start_option(https(_)).
+
+server_option(port(_)).
+server_option(ip(_)).
+server_option(certfile(_)).
+server_option(keyfile(_)).
+server_option(pwfile(_)).
+server_option(password(_)).
+server_option(cipherlist(_)).
+server_option(workers(_)).
+server_option(redirect(_)).
+server_option(timeout(_)).
+server_option(keep_alive_timeout(_)).
+
+make_server(http(Address0), Options0, server(http, Address, Options)) :-
+    make_address(Address0, 80, Address, Options0, Options).
+make_server(https(Address0), Options0, server(https, Address, SSLOptions)) :-
+    make_address(Address0, 443, Address, Options0, Options),
+    merge_https_options(Options, SSLOptions).
+
+make_address(true, DefPort, Address, Options0, Options) :-
+    !,
+    option(port(Port), Options0, DefPort),
+    (   option(ip(Bind), Options0)
+    ->  Address = (Bind:Port)
+    ;   Address = Port
+    ),
+    merge_options([port(Port)], Options0, Options).
+make_address(Bind:Port, _, Bind:Port, Options0, Options) :-
+    !,
+    must_be(atom, Bind),
+    must_be(integer, Port),
+    merge_options([port(Port), ip(Bind)], Options0, Options).
+make_address(Port, _, Address, Options0, Options) :-
+    integer(Port),
+    !,
+    (   option(ip(Bind), Options0)
+    ->  Address = (Bind:Port)
+    ;   Address = Port,
+        merge_options([port(Port)], Options0, Options)
+    ).
+make_address(Spec, _, Address, Options0, Options) :-
+    atomic(Spec),
+    split_string(Spec, ":", "", [BindString, PortString]),
+    number_string(Port, PortString),
+    !,
+    atom_string(Bind, BindString),
+    Address = (Bind:Port),
+    merge_options([port(Port), ip(Bind)], Options0, Options).
+make_address(Spec, _, _, _, _) :-
+    domain_error(address, Spec).
+
+:- dynamic sni/3.
+
+merge_https_options(Options, [SSL|Options]) :-
+    (   option(certfile(CertFile), Options),
+        option(keyfile(KeyFile), Options)
+    ->  prepare_https_certificate(CertFile, KeyFile, Passwd0),
+        read_file_to_string(CertFile, Certificate, []),
+        read_file_to_string(KeyFile, Key, []),
+        Pairs = [Certificate-Key]
+    ;   Pairs = []
+    ),
+    ssl_secure_ciphers(SecureCiphers),
+    option(cipherlist(CipherList), Options, SecureCiphers),
+    (   string(Passwd0)
+    ->  Passwd = Passwd0
+    ;   options_password(Options, Passwd)
+    ),
+    findall(HostName-HostOptions, http:sni_options(HostName, HostOptions), SNIs),
+    maplist(sni_contexts, SNIs),
+    SSL = ssl([ certificate_key_pairs(Pairs),
+                cipher_list(CipherList),
+                password(Passwd),
+                sni_hook(http_unix_daemon:sni)
+              ]).
+
+sni_contexts(Host-Options) :-
+    ssl_context(server, SSL, Options),
+    assertz(sni(_, Host, SSL)).
+
+%!  http_certificate_hook(+CertFile, +KeyFile, -Password) is semidet.
+%
+%   Hook called before starting the server  if the --https option is
+%   used.  This  hook  may  be  used    to  create  or  refresh  the
+%   certificate. If the hook binds Password to a string, this string
+%   will be used to  decrypt  the  server   private  key  as  if the
+%   --password=Password option was given.
+
+prepare_https_certificate(CertFile, KeyFile, Password) :-
+    http_certificate_hook(CertFile, KeyFile, Password),
+    !.
+prepare_https_certificate(_, _, _).
+
+
+options_password(Options, Passwd) :-
+    option(password(Passwd), Options),
+    !.
+options_password(Options, Passwd) :-
+    option(pwfile(File), Options),
+    !,
+    read_file_to_string(File, String, []),
+    split_string(String, "", "\r\n\t ", [Passwd]).
+options_password(_, '').
+
+%!  start_servers(+Servers) is det.
+%
+%   Start the HTTP server.  It performs the following steps:
+%
+%     1. Call broadcast(http(pre_server_start))
+%     2. For each server
+%        a. Call broadcast(http(pre_server_start(Port)))
+%        b. Call http_server(http_dispatch, Options)
+%        c. Call broadcast(http(post_server_start(Port)))
+%     3. Call broadcast(http(post_server_start))
+%
+%   This predicate can be  hooked   using  http_server_hook/1.  This
+%   predicate is executed after
+%
+%     - Forking
+%     - Setting I/O (e.g., to talk to the syslog daemon)
+%     - Dropping root privileges (--user)
+%     - Setting up signal handling
+
+start_servers(Servers) :-
+    broadcast(http(pre_server_start)),
+    maplist(start_server, Servers),
+    broadcast(http(post_server_start)).
+
+start_server(server(_Scheme, Socket, Options)) :-
+    option(redirect(To), Options),
+    !,
+    http_server(server_redirect(To), [tcp_socket(Socket)|Options]).
+start_server(server(_Scheme, Socket, Options)) :-
+    http_server_hook([tcp_socket(Socket)|Options]),
+    !.
+start_server(server(_Scheme, Socket, Options)) :-
+    option(port(Port), Options),
+    broadcast(http(pre_server_start(Port))),
+    http_server(http_dispatch, [tcp_socket(Socket)|Options]),
+    broadcast(http(post_server_start(Port))).
+
+make_socket(server(Scheme, Address, Options),
+            server(Scheme, Socket, Options)) :-
+    tcp_socket(Socket),
+    catch(bind_socket(Socket, Address), Error,
+          make_socket_error(Error, Address)),
+    debug(daemon(socket),
+          'Created socket ~p, listening on ~p', [Socket, Address]).
+
+bind_socket(Socket, Address) :-
+    tcp_setopt(Socket, reuseaddr),
+    tcp_bind(Socket, Address),
+    tcp_listen(Socket, 5).
+
+make_socket_error(error(socket_error(_,_), _), Address) :-
+    address_port(Address, Port),
+    integer(Port),
+    Port =< 1000,
+    !,
+    verify_root(open_port(Port)).
+make_socket_error(Error, _) :-
+    throw(Error).
+
+address_port(_:Port, Port) :- !.
+address_port(Port, Port).
+
+%!  disable_development_system
+%
+%   Disable some development stuff.
+
+disable_development_system :-
+    set_prolog_flag(editor, '/bin/false').
+
+%!  enable_development_system
+%
+%   Re-enable the development environment. Currently  re-enables xpce if
+%   this was loaded, but not  initialised   and  causes  the interactive
+%   toplevel to be re-enabled.
+
+enable_development_system :-
+    assertz(interactive),
+    set_prolog_flag(xpce_threaded, true),
+    set_prolog_flag(message_ide, true),
+    (   current_prolog_flag(xpce_version, _)
+    ->  call(pce_dispatch([]))
+    ;   true
+    ),
+    set_prolog_flag(toplevel_goal, prolog).
+
+%!  setup_syslog(+Options) is det.
+%
+%   Setup syslog interaction.
+
+setup_syslog(Options) :-
+    option(syslog(Ident), Options),
+    !,
+    openlog(Ident, [pid], user).
+setup_syslog(_).
+
+
+%!  setup_output(+Options) is det.
+%
+%   Setup output from the daemon process. The default is to send all
+%   output to a  null-stream  (see   open_null_stream/1).  With  the
+%   option output(File), all output is written to File.
+
+setup_output(Options) :-
+    option(output(File), Options),
+    !,
+    open(File, write, Out, [encoding(utf8)]),
+    set_stream(Out, buffer(line)),
+    detach_IO(Out).
+setup_output(_) :-
+    open_null_stream(Out),
+    detach_IO(Out).
+
+
+%!  write_pid(+Options) is det.
+%
+%   If the option pidfile(File) is  present,   write  the PID of the
+%   daemon to this file.
+
+write_pid(Options) :-
+    option(pidfile(File), Options),
+    current_prolog_flag(pid, PID),
+    !,
+    setup_call_cleanup(
+        open(File, write, Out),
+        format(Out, '~d~n', [PID]),
+        close(Out)),
+    at_halt(catch(delete_file(File), _, true)).
+write_pid(_).
+
+
+%!  switch_user(+Options) is det.
+%
+%   Switch to the target user and group. If the server is started as
+%   root, this option *must* be present.
+
+switch_user(Options) :-
+    option(user(User), Options),
+    !,
+    verify_root(switch_user(User)),
+    (   option(group(Group), Options)
+    ->  set_user_and_group(User, Group)
+    ;   set_user_and_group(User)
+    ),
+    prctl(set_dumpable(true)).      % re-enable core dumps on Linux
+switch_user(_Options) :-
+    verify_no_root.
+
+%!  can_switch_user(Options) is det.
+%
+%   Verify the user options before  forking,   so  we  can print the
+%   message in time.
+
+can_switch_user(Options) :-
+    option(user(User), Options),
+    !,
+    verify_root(switch_user(User)).
+can_switch_user(_Options) :-
+    verify_no_root.
+
+verify_root(_Task) :-
+    geteuid(0),
+    !.
+verify_root(Task) :-
+    print_message(error, http_daemon(no_root(Task))),
+    halt(1).
+
+verify_no_root :-
+    geteuid(0),
+    !,
+    throw(error(permission_error(open, server, http),
+                context('Refusing to run HTTP server as root', _))).
+verify_no_root.
+
+:- if(\+current_predicate(prctl/1)).
+prctl(_).
+:- endif.
+
+%!  server_redirect(+To, +Request)
+%
+%   Redirect all requests for this server to the specified server. To
+%   is one of:
+%
+%     $ A port (integer) :
+%     Redirect to the server running on that port in the same
+%     Prolog process.
+%     $ =true= :
+%     Results from just passing =|--redirect|=.  Redirects to
+%     an HTTPS server in the same Prolog process.
+%     $ A URL :
+%     Redirect to the the given URL + the request uri.  This can
+%     be used if the server cannot find its public address.  For
+%     example:
+%
+%       ```
+%       --http --redirect=https://myhost.org --https
+%       ```
+
+server_redirect(Port, Request) :-
+    integer(Port),
+    http_server_property(Port, scheme(Scheme)),
+    http_public_host(Request, Host, _Port, []),
+    memberchk(request_uri(Location), Request),
+    (   default_port(Scheme, Port)
+    ->  format(string(To), '~w://~w~w', [Scheme, Host, Location])
+    ;   format(string(To), '~w://~w:~w~w', [Scheme, Host, Port, Location])
+    ),
+    throw(http_reply(moved_temporary(To))).
+server_redirect(true, Request) :-
+    !,
+    http_server_property(P, scheme(https)),
+    server_redirect(P, Request).
+server_redirect(URI, Request) :-
+    memberchk(request_uri(Location), Request),
+    atom_concat(URI, Location, To),
+    throw(http_reply(moved_temporary(To))).
+
+default_port(http, 80).
+default_port(https, 443).
+
+
+%!  setup_debug(+Options) is det.
+%
+%   Initialise debug/3 topics. The  =|--debug|=   option  may be used
+%   multiple times.
+
+setup_debug(Options) :-
+    setup_trace(Options),
+    nodebug(_),
+    debug(daemon),
+    enable_debug(Options).
+
+enable_debug([]).
+enable_debug([debug(Topic)|T]) :-
+    !,
+    atom_to_term(Topic, Term, _),
+    debug(Term),
+    enable_debug(T).
+enable_debug([_|T]) :-
+    enable_debug(T).
+
+setup_trace(Options) :-
+    option(gtrace(true), Options),
+    !,
+    gtrace.
+setup_trace(_).
+
+
+%!  kill_x11(+Options) is det.
+%
+%   Get rid of X11 access if interactive is false.
+
+kill_x11(Options) :-
+    getenv('DISPLAY', Display),
+    Display \== '',
+    option(interactive(false), Options, false),
+    !,
+    setenv('DISPLAY', ''),
+    set_prolog_flag(gui, false).
+kill_x11(_).
+
+
+%!  setup_signals(+Options)
+%
+%   Prepare the server for signal handling.   By  default SIGINT and
+%   SIGTERM terminate the server. SIGHUP causes   the  server to run
+%   make/0.
+
+setup_signals(Options) :-
+    option(interactive(true), Options, false),
+    !.
+setup_signals(Options) :-
+    on_signal(int,  _, quit),
+    on_signal(term, _, quit),
+    option(sighup(Action), Options, reload),
+    must_be(oneof([reload,quit]), Action),
+    on_signal(usr1, _, logrotate),
+    on_signal(hup,  _, Action).
+
+:- public
+    quit/1,
+    reload/1,
+    logrotate/1.
+
+quit(Signal) :-
+    debug(daemon, 'Dying on signal ~w', [Signal]),
+    thread_send_message(main, quit(Signal)).
+
+reload(Signal) :-
+    debug(daemon, 'Reload on signal ~w', [Signal]),
+    thread_send_message(main, reload).
+
+logrotate(Signal) :-
+    debug(daemon, 'Closing log files on signal ~w', [Signal]),
+    thread_send_message(main, logrotate).
+
+%!  wait(+Options)
+%
+%   This predicate runs in the  main   thread,  waiting for messages
+%   send by signal handlers to control   the server. In addition, it
+%   broadcasts  maintenance(Interval,  Deadline)    messages   every
+%   Interval seconds. These messages may   be trapped using listen/2
+%   for performing scheduled maintenance such as rotating log files,
+%   cleaning stale data, etc.
+
+wait(Options) :-
+    option(interactive(true), Options, false),
+    !,
+    enable_development_system.
+wait(Options) :-
+    thread_self(Me),
+    option(maintenance_interval(Interval), Options, 300),
+    Interval > 0,
+    !,
+    first_deadline(Interval, FirstDeadline),
+    State = deadline(0),
+    repeat,
+        State = deadline(Count),
+        Deadline is FirstDeadline+Count*Interval,
+        (   thread_idle(thread_get_message(Me, Msg, [deadline(Deadline)]),
+                        long)
+        ->  catch(ignore(handle_message(Msg)), E,
+                  print_message(error, E)),
+            Msg = quit(Signal),
+            catch(broadcast(http(shutdown)), E,
+                  print_message(error, E)),
+            halt(Signal)
+        ;   Count1 is Count + 1,
+            nb_setarg(1, State, Count1),
+            catch(broadcast(maintenance(Interval, Deadline)), E,
+                  print_message(error, E)),
+            fail
+        ).
+wait(_) :-
+    thread_self(Me),
+    repeat,
+        thread_idle(thread_get_message(Me, Msg), long),
+        catch(ignore(handle_message(Msg)), E,
+              print_message(error, E)),
+        Msg == quit,
+        !,
+        halt(0).
+
+handle_message(reload) :-
+    make,
+    broadcast(logrotate).
+handle_message(logrotate) :-
+    broadcast(logrotate).
+
+first_deadline(Interval, Deadline) :-
+    get_time(Now),
+    Deadline is ((integer(Now) + Interval - 1)//Interval)*Interval.
+
+
+                 /*******************************
+                 *            HOOKS             *
+                 *******************************/
+
+%!  http_server_hook(+Options) is semidet.
+%
+%   Hook that is called to start the  HTTP server. This hook must be
+%   compatible to http_server(Handler,  Options).   The  default  is
+%   provided by start_server/1.
+
+
+%!  http:sni_options(-HostName, -SSLOptions) is multi.
+%
+%   Hook  to   provide  Server  Name  Indication   (SNI)  for  TLS
+%   servers. When starting an HTTPS  server, all solutions of this
+%   predicate are  collected and a suitable  sni_hook/1 is defined
+%   for ssl_context/3  to use different contexts  depending on the
+%   host  name  of the  client  request.   This hook  is  executed
+%   _before_ privileges are dropped.
+
+
+                 /*******************************
+                 *           MESSAGES           *
+                 *******************************/
+
+:- multifile
+    prolog:message//1.
+
+prolog:message(http_daemon(no_root(switch_user(User)))) -->
+    [ 'Program must be started as root to use --user=~w.'-[User] ].
+prolog:message(http_daemon(no_root(open_port(Port)))) -->
+    [ 'Cannot open port ~w.  Only root can open ports below 1000.'-[Port] ].