1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2013-2017, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(http_unix_daemon,
   37          [ http_daemon/0,
   38            http_daemon/1                       % +Options
   39          ]).   40:- use_module(library(error)).   41:- use_module(library(apply)).   42:- use_module(library(lists)).   43:- use_module(library(debug)).   44:- use_module(library(broadcast)).   45:- use_module(library(socket)).   46:- use_module(library(option)).   47:- use_module(library(uid)).   48:- use_module(library(unix)).   49:- use_module(library(syslog)).   50:- use_module(library(http/thread_httpd)).   51:- use_module(library(http/http_dispatch)).   52:- use_module(library(http/http_host)).   53:- use_module(library(main)).   54:- use_module(library(readutil)).   55
   56:- if(exists_source(library(http/http_ssl_plugin))).   57:- use_module(library(ssl)).   58:- use_module(library(http/http_ssl_plugin)).   59:- endif.   60
   61:- multifile
   62    http_server_hook/1,                     % +Options
   63    http_certificate_hook/3,                % +CertFile, +KeyFile, -Password
   64    http:sni_options/2.                     % +HostName, +SSLOptions
   65
   66:- initialization(http_daemon, main).   67
   68/** <module> Run SWI-Prolog HTTP server as a Unix system daemon
   69
   70This module provides the logic that  is   needed  to integrate a process
   71into the Unix service (daemon) architecture. It deals with the following
   72aspects,  all  of  which  may  be   used/ignored  and  configured  using
   73commandline options:
   74
   75  - Select the port(s) to be used by the server
   76  - Run the startup of the process as root to perform privileged
   77    tasks and the server itself as unpriviledged user, for example
   78    to open ports below 1000.
   79  - Fork and detach from the controlling terminal
   80  - Handle console and debug output using a file and/or the syslog
   81    daemon.
   82  - Manage a _|pid file|_
   83
   84The typical use scenario is to  write   a  file that loads the following
   85components:
   86
   87  1. The application code, including http handlers (see http_handler/3).
   88  2. This library
   89
   90In the code below, =|?- [load].|= loads   the remainder of the webserver
   91code.  This is often a sequence of use_module/1 directives.
   92
   93  ==
   94  :- use_module(library(http/http_unix_daemon)).
   95
   96  :- [load].
   97  ==
   98
   99The   program   entry   point   is     http_daemon/0,   declared   using
  100initialization/2. This main be overruled using   a new declaration after
  101loading  this  library.  The  new  entry    point  will  typically  call
  102http_daemon/1 to start the server in a preconfigured way.
  103
  104  ==
  105  :- use_module(library(http/http_unix_daemon)).
  106  :- initialization(run, main).
  107
  108  run :-
  109      ...
  110      http_daemon(Options).
  111  ==
  112
  113Now,  the  server  may  be  started    using   the  command  below.  See
  114http_daemon/0 for supported options.
  115
  116  ==
  117  % [sudo] swipl mainfile.pl [option ...]
  118  ==
  119
  120Below are some examples. Our first example is completely silent, running
  121on port 80 as user =www=.
  122
  123  ==
  124  % swipl mainfile.pl --user=www --pidfile=/var/run/http.pid
  125  ==
  126
  127Our second example logs HTTP  interaction   with  the  syslog daemon for
  128debugging purposes. Note that the argument   to =|--debug|== is a Prolog
  129term and must often be escaped to   avoid  misinterpretation by the Unix
  130shell.   The debug option can be repeated to log multiple debug topics.
  131
  132  ==
  133  % swipl mainfile.pl --user=www --pidfile=/var/run/http.pid \
  134          --debug='http(request)' --syslog=http
  135  ==
  136
  137*Broadcasting* The library uses  broadcast/1   to  allow hooking certain
  138events:
  139
  140  - http(pre_server_start)
  141  Run _after_ _fork_, just before starting the HTTP server.  Can be used
  142  to load additional files or perform additional initialisation, such as
  143  starting additional threads.  Recall that it is not possible to start
  144  threads _before_ forking.
  145
  146  - http(post_server_start)
  147  Run _after_ starting the HTTP server.
  148
  149@tbd    Cleanup issues wrt. loading and initialization of xpce.
  150@see    The file <swi-home>/doc/packages/examples/http/linux-init-script
  151        provides a /etc/init.d script for controlling a server as a normal
  152        Unix service.
  153*/
  154
  155:- debug(daemon).  156
  157% Do not run xpce in a thread. This disables forking. The problem here
  158% is that loading library(pce) starts the event dispatching thread. This
  159% should be handled lazily.
  160
  161:- set_prolog_flag(xpce_threaded, false).  162:- set_prolog_flag(message_ide,   false). % cause xpce to trap messages
  163:- dynamic interactive/0.  164
  165%!  http_daemon
  166%
  167%   Start the HTTP server  as  a   daemon  process.  This  predicate
  168%   processes the commandline arguments below. Commandline arguments
  169%   that specify servers are processed  in   the  order  they appear
  170%   using the following schema:
  171%
  172%     1. Arguments that act as default for all servers.
  173%     2. =|--http=Spec|= or =|--https=Spec|= is followed by
  174%        arguments for that server until the next =|--http=Spec|=
  175%        or =|--https=Spec|= or the end of the options.
  176%     3. If no =|--http=Spec|= or =|--https=Spec|= appears, one
  177%        HTTP server is created from the specified parameters.
  178%
  179%     Examples:
  180%
  181%       ==
  182%       --workers=10 --http --https
  183%       --http=8080 --https=8443
  184%       --http=localhost:8080 --workers=1 --https=8443 --workers=25
  185%       ==
  186%
  187%     $ --port=Port :
  188%     Start HTTP server at Port. It requires root permission and the
  189%     option =|--user=User|= to open ports below 1000.  The default
  190%     port is 80. If =|--https|= is used, the default port is 443.
  191%
  192%     $ --ip=IP :
  193%     Only listen to the given IP address.  Typically used as
  194%     =|--ip=localhost|= to restrict access to connections from
  195%     _localhost_ if the server itself is behind an (Apache)
  196%     proxy server running on the same host.
  197%
  198%     $ --debug=Topic :
  199%     Enable debugging Topic.  See debug/3.
  200%
  201%     $ --syslog=Ident :
  202%     Write debug messages to the syslog daemon using Ident
  203%
  204%     $ --user=User :
  205%     When started as root to open a port below 1000, this option
  206%     must be provided to switch to the target user for operating
  207%     the server. The following actions are performed as root, i.e.,
  208%     _before_ switching to User:
  209%
  210%       - open the socket(s)
  211%       - write the pidfile
  212%       - setup syslog interaction
  213%       - Read the certificate, key and password file (=|--pwfile=File|=)
  214%
  215%     $ --group=Group :
  216%     May be used in addition to =|--user|=.  If omitted, the login
  217%     group of the target user is used.
  218%
  219%     $ --pidfile=File :
  220%     Write the PID of the daemon process to File.
  221%
  222%     $ --output=File :
  223%     Send output of the process to File.  By default, all
  224%     Prolog console output is discarded.
  225%
  226%     $ --fork[=Bool] :
  227%     If given as =|--no-fork|= or =|--fork=false|=, the process
  228%     runs in the foreground.
  229%
  230%     $ --http[=(Bool|Port|BindTo:Port)] :
  231%     Create a plain HTTP server.  If the argument is missing or
  232%     =true=, create at the specified or default address.  Else
  233%     use the given port and interface.  Thus, =|--http|= creates
  234%     a server at port 80, =|--http=8080|= creates one at port
  235%     8080 and =|--http=localhost:8080|= creates one at port
  236%     8080 that is only accessible from `localhost`.
  237%
  238%     $ --https[=(Bool|Port|BindTo:Port)] :
  239%     As =|--http|=, but creates an HTTPS server.
  240%     Use =|--certfile|=, =|--keyfile|=, =|-pwfile|=,
  241%     =|--password|= and =|--cipherlist|= to configure SSL for
  242%     this server.
  243%
  244%     $ --certfile=File :
  245%     The server certificate for HTTPS.
  246%
  247%     $ --keyfile=File :
  248%     The server private key for HTTPS.
  249%
  250%     $ --pwfile=File :
  251%     File holding the password for accessing  the private key. This
  252%     is preferred over using =|--password=PW|=   as it allows using
  253%     file protection to avoid leaking the password.  The file is
  254%     read _before_ the server drops privileges when started with
  255%     the =|--user|= option.
  256%
  257%     $ --password=PW :
  258%     The password for accessing the private key. See also `--pwfile`.
  259%
  260%     $ --cipherlist=Ciphers :
  261%     One or more cipher strings separated by colons. See the OpenSSL
  262%     documentation for more information. Starting with SWI-Prolog
  263%     7.5.11, the default value is always a set of ciphers that was
  264%     considered secure enough to prevent all critical attacks at the
  265%     time of the SWI-Prolog release.
  266%
  267%     $ --interactive[=Bool] :
  268%     If =true= (default =false=) implies =|--no-fork|= and presents
  269%     the Prolog toplevel after starting the server.
  270%
  271%     $ --gtrace=[Bool] :
  272%     Use the debugger to trace http_daemon/1.
  273%
  274%     $ --sighup=Action :
  275%     Action to perform on =|kill -HUP <pid>|=.  Default is `reload`
  276%     (running make/0).  Alternative is `quit`, stopping the server.
  277%
  278%   Other options are converted  by   argv_options/3  and  passed to
  279%   http_server/1.  For example, this allows for:
  280%
  281%     $ --workers=Count :
  282%     Set the number of workers for the multi-threaded server.
  283%
  284%   http_daemon/0 is defined as below.  The   start  code for a specific
  285%   server can use this as a starting  point, for example for specifying
  286%   defaults.
  287%
  288%   ```
  289%   http_daemon :-
  290%       current_prolog_flag(argv, Argv),
  291%       argv_options(Argv, _RestArgv, Options),
  292%       http_daemon(Options).
  293%   ```
  294%
  295%   @see http_daemon/1
  296
  297http_daemon :-
  298    current_prolog_flag(argv, Argv),
  299    argv_options(Argv, _RestArgv, Options),
  300    http_daemon(Options).
  301
  302%!  http_daemon(+Options)
  303%
  304%   Start the HTTP server as a  daemon process. This predicate processes
  305%   a Prolog option list. It  is   normally  called  from http_daemon/0,
  306%   which derives the option list from the command line arguments.
  307%
  308%   Error handling depends on whether  or   not  interactive(true) is in
  309%   effect. If so, the error is printed before entering the toplevel. In
  310%   non-interactive mode this predicate calls halt(1).
  311
  312http_daemon(Options) :-
  313    catch(http_daemon_guarded(Options), Error, start_failed(Error)).
  314
  315start_failed(Error) :-
  316    interactive,
  317    !,
  318    print_message(warning, Error).
  319start_failed(Error) :-
  320    print_message(error, Error),
  321    halt(1).
  322
  323%!  http_daemon_guarded(+Options)
  324%
  325%   Helper that is started from http_daemon/1. See http_daemon/1 for
  326%   options that are processed.
  327
  328http_daemon_guarded(Options) :-
  329    option(help(true), Options),
  330    !,
  331    print_message(information, http_daemon(help)),
  332    halt.
  333http_daemon_guarded(Options) :-
  334    setup_debug(Options),
  335    kill_x11(Options),
  336    option_servers(Options, Servers0),
  337    maplist(make_socket, Servers0, Servers),
  338    (   option(fork(true), Options, true),
  339        option(interactive(false), Options, false),
  340        can_switch_user(Options)
  341    ->  fork(Who),
  342        (   Who \== child
  343        ->  halt
  344        ;   disable_development_system,
  345            setup_syslog(Options),
  346            write_pid(Options),
  347            setup_output(Options),
  348            switch_user(Options),
  349            setup_signals(Options),
  350            start_servers(Servers),
  351            wait(Options)
  352        )
  353    ;   write_pid(Options),
  354        switch_user(Options),
  355        setup_signals(Options),
  356        start_servers(Servers),
  357        wait(Options)
  358    ).
  359
  360%!  option_servers(+Options, -Sockets:list)
  361%
  362%   Find all sockets that must be created according to Options. Each
  363%   socket is a term server(Scheme, Address, Opts), where Address is
  364%   either a plain port (integer) or Host:Port. The latter binds the
  365%   port  to  the  interface  belonging    to   Host.  For  example:
  366%   socket(http, localhost:8080, Opts) creates an   HTTP socket that
  367%   binds to the localhost  interface  on   port  80.  Opts  are the
  368%   options specific for the given server.
  369
  370option_servers(Options, Sockets) :-
  371    opt_sockets(Options, [], [], Sockets).
  372
  373opt_sockets([], Options, [], [Socket]) :-
  374    !,
  375    make_server(http(true), Options, Socket).
  376opt_sockets([], _, Sockets, Sockets).
  377opt_sockets([H|T], OptsH, Sockets0, Sockets) :-
  378    server_option(H),
  379    !,
  380    append(OptsH, [H], OptsH1),
  381    opt_sockets(T, OptsH1, Sockets0, Sockets).
  382opt_sockets([H|T0], Opts, Sockets0, Sockets) :-
  383    server_start_option(H),
  384    !,
  385    server_options(T0, T, Opts, SOpts),
  386    make_server(H, SOpts, Socket),
  387    append(Sockets0, [Socket], Sockets1),
  388    opt_sockets(T, Opts, Sockets1, Sockets).
  389opt_sockets([_|T], Opts, Sockets0, Sockets) :-
  390    opt_sockets(T, Opts, Sockets0, Sockets).
  391
  392server_options([], [], Options, Options).
  393server_options([H|T], Rest, Options0, Options) :-
  394    server_option(H),
  395    !,
  396    generalise_option(H, G),
  397    delete(Options0, G, Options1),
  398    append(Options1, [H], Options2),
  399    server_options(T, Rest, Options2, Options).
  400server_options([H|T], [H|T], Options, Options) :-
  401    server_start_option(H),
  402    !.
  403server_options([_|T0], Rest, Options0, Options) :-
  404    server_options(T0, Rest, Options0, Options).
  405
  406generalise_option(H, G) :-
  407    H =.. [Name,_],
  408    G =.. [Name,_].
  409
  410server_start_option(http(_)).
  411server_start_option(https(_)).
  412
  413server_option(port(_)).
  414server_option(ip(_)).
  415server_option(certfile(_)).
  416server_option(keyfile(_)).
  417server_option(pwfile(_)).
  418server_option(password(_)).
  419server_option(cipherlist(_)).
  420server_option(workers(_)).
  421server_option(redirect(_)).
  422
  423make_server(http(Address0), Options0, server(http, Address, Options)) :-
  424    make_address(Address0, 80, Address, Options0, Options).
  425make_server(https(Address0), Options0, server(https, Address, SSLOptions)) :-
  426    make_address(Address0, 443, Address, Options0, Options),
  427    merge_https_options(Options, SSLOptions).
  428
  429make_address(true, DefPort, Address, Options0, Options) :-
  430    !,
  431    option(port(Port), Options0, DefPort),
  432    (   option(ip(Bind), Options0)
  433    ->  Address = (Bind:Port)
  434    ;   Address = Port
  435    ),
  436    merge_options([port(Port)], Options0, Options).
  437make_address(Bind:Port, _, Bind:Port, Options0, Options) :-
  438    !,
  439    must_be(atom, Bind),
  440    must_be(integer, Port),
  441    merge_options([port(Port), ip(Bind)], Options0, Options).
  442make_address(Port, _, Address, Options0, Options) :-
  443    integer(Port),
  444    !,
  445    (   option(ip(Bind), Options0)
  446    ->  Address = (Bind:Port)
  447    ;   Address = Port,
  448        merge_options([port(Port)], Options0, Options)
  449    ).
  450make_address(Spec, _, Address, Options0, Options) :-
  451    atomic(Spec),
  452    split_string(Spec, ":", "", [BindString, PortString]),
  453    number_string(Port, PortString),
  454    !,
  455    atom_string(Bind, BindString),
  456    Address = (Bind:Port),
  457    merge_options([port(Port), ip(Bind)], Options0, Options).
  458make_address(Spec, _, _, _, _) :-
  459    domain_error(address, Spec).
  460
  461:- dynamic sni/3.  462
  463merge_https_options(Options, [SSL|Options]) :-
  464    (   option(certfile(CertFile), Options),
  465        option(keyfile(KeyFile), Options)
  466    ->  prepare_https_certificate(CertFile, KeyFile, Passwd0),
  467        read_file_to_string(CertFile, Certificate, []),
  468        read_file_to_string(KeyFile, Key, []),
  469        Pairs = [Certificate-Key]
  470    ;   Pairs = []
  471    ),
  472    ssl_secure_ciphers(SecureCiphers),
  473    option(cipherlist(CipherList), Options, SecureCiphers),
  474    (   string(Passwd0)
  475    ->  Passwd = Passwd0
  476    ;   options_password(Options, Passwd)
  477    ),
  478    findall(HostName-HostOptions, http:sni_options(HostName, HostOptions), SNIs),
  479    maplist(sni_contexts, SNIs),
  480    SSL = ssl([ certificate_key_pairs(Pairs),
  481                cipher_list(CipherList),
  482                password(Passwd),
  483                sni_hook(http_unix_daemon:sni)
  484              ]).
  485
  486sni_contexts(Host-Options) :-
  487    ssl_context(server, SSL, Options),
  488    assertz(sni(_, Host, SSL)).
  489
  490%!  http_certificate_hook(+CertFile, +KeyFile, -Password) is semidet.
  491%
  492%   Hook called before starting the server  if the --https option is
  493%   used.  This  hook  may  be  used    to  create  or  refresh  the
  494%   certificate. If the hook binds Password to a string, this string
  495%   will be used to  decrypt  the  server   private  key  as  if the
  496%   --password=Password option was given.
  497
  498prepare_https_certificate(CertFile, KeyFile, Password) :-
  499    http_certificate_hook(CertFile, KeyFile, Password),
  500    !.
  501prepare_https_certificate(_, _, _).
  502
  503
  504options_password(Options, Passwd) :-
  505    option(password(Passwd), Options),
  506    !.
  507options_password(Options, Passwd) :-
  508    option(pwfile(File), Options),
  509    !,
  510    read_file_to_string(File, String, []),
  511    split_string(String, "", "\r\n\t ", [Passwd]).
  512options_password(_, '').
  513
  514%!  start_server(+Server) is det.
  515%
  516%   Start the HTTP server.  It performs the following steps:
  517%
  518%     1. Call broadcast(http(pre_server_start))
  519%     2. Call http_server(http_dispatch, Options)
  520%     2. Call broadcast(http(post_server_start))
  521%
  522%   This predicate can be  hooked   using  http_server_hook/1.  This
  523%   predicate is executed after
  524%
  525%     - Forking
  526%     - Setting I/O (e.g., to talk to the syslog daemon)
  527%     - Dropping root privileges (--user)
  528%     - Setting up signal handling
  529
  530start_servers(Servers) :-
  531    broadcast(http(pre_server_start)),
  532    maplist(start_server, Servers),
  533    broadcast(http(post_server_start)).
  534
  535start_server(server(_Scheme, Socket, Options)) :-
  536    option(redirect(To), Options),
  537    !,
  538    http_server(server_redirect(To), [tcp_socket(Socket)|Options]).
  539start_server(server(_Scheme, Socket, Options)) :-
  540    http_server_hook([tcp_socket(Socket)|Options]),
  541    !.
  542start_server(server(_Scheme, Socket, Options)) :-
  543    http_server(http_dispatch, [tcp_socket(Socket)|Options]).
  544
  545make_socket(server(Scheme, Address, Options),
  546            server(Scheme, Socket, Options)) :-
  547    tcp_socket(Socket),
  548    catch(bind_socket(Socket, Address), Error,
  549          make_socket_error(Error, Address)),
  550    debug(daemon(socket),
  551          'Created socket ~p, listening on ~p', [Socket, Address]).
  552
  553bind_socket(Socket, Address) :-
  554    tcp_setopt(Socket, reuseaddr),
  555    tcp_bind(Socket, Address),
  556    tcp_listen(Socket, 5).
  557
  558make_socket_error(error(socket_error(_), _), Address) :-
  559    address_port(Address, Port),
  560    integer(Port),
  561    Port =< 1000,
  562    !,
  563    verify_root(open_port(Port)).
  564make_socket_error(Error, _) :-
  565    throw(Error).
  566
  567address_port(_:Port, Port) :- !.
  568address_port(Port, Port).
  569
  570%!  disable_development_system
  571%
  572%   Disable some development stuff.
  573
  574disable_development_system :-
  575    set_prolog_flag(editor, '/bin/false').
  576
  577%!  enable_development_system
  578%
  579%   Re-enable the development environment. Currently  re-enables xpce if
  580%   this was loaded, but not  initialised   and  causes  the interactive
  581%   toplevel to be re-enabled.
  582
  583enable_development_system :-
  584    assertz(interactive),
  585    set_prolog_flag(xpce_threaded, true),
  586    set_prolog_flag(message_ide, true),
  587    (   current_prolog_flag(xpce_version, _)
  588    ->  call(pce_dispatch([]))
  589    ;   true
  590    ),
  591    set_prolog_flag(toplevel_goal, prolog).
  592
  593%!  setup_syslog(+Options) is det.
  594%
  595%   Setup syslog interaction.
  596
  597setup_syslog(Options) :-
  598    option(syslog(Ident), Options),
  599    !,
  600    openlog(Ident, [pid], user).
  601setup_syslog(_).
  602
  603
  604%!  setup_output(+Options) is det.
  605%
  606%   Setup output from the daemon process. The default is to send all
  607%   output to a  null-stream  (see   open_null_stream/1).  With  the
  608%   option output(File), all output is written to File.
  609
  610setup_output(Options) :-
  611    option(output(File), Options),
  612    !,
  613    open(File, write, Out, [encoding(utf8)]),
  614    set_stream(Out, buffer(line)),
  615    detach_IO(Out).
  616setup_output(_) :-
  617    open_null_stream(Out),
  618    detach_IO(Out).
  619
  620
  621%!  write_pid(+Options) is det.
  622%
  623%   If the option pidfile(File) is  present,   write  the PID of the
  624%   daemon to this file.
  625
  626write_pid(Options) :-
  627    option(pidfile(File), Options),
  628    current_prolog_flag(pid, PID),
  629    !,
  630    setup_call_cleanup(
  631        open(File, write, Out),
  632        format(Out, '~d~n', [PID]),
  633        close(Out)),
  634    at_halt(catch(delete_file(File), _, true)).
  635write_pid(_).
  636
  637
  638%!  switch_user(+Options) is det.
  639%
  640%   Switch to the target user and group. If the server is started as
  641%   root, this option *must* be present.
  642
  643switch_user(Options) :-
  644    option(user(User), Options),
  645    !,
  646    verify_root(switch_user(User)),
  647    (   option(group(Group), Options)
  648    ->  set_user_and_group(User, Group)
  649    ;   set_user_and_group(User)
  650    ),
  651    prctl(set_dumpable(true)).      % re-enable core dumps on Linux
  652switch_user(_Options) :-
  653    verify_no_root.
  654
  655%!  can_switch_user(Options) is det.
  656%
  657%   Verify the user options before  forking,   so  we  can print the
  658%   message in time.
  659
  660can_switch_user(Options) :-
  661    option(user(User), Options),
  662    !,
  663    verify_root(switch_user(User)).
  664can_switch_user(_Options) :-
  665    verify_no_root.
  666
  667verify_root(_Task) :-
  668    geteuid(0),
  669    !.
  670verify_root(Task) :-
  671    print_message(error, http_daemon(no_root(Task))),
  672    halt(1).
  673
  674verify_no_root :-
  675    geteuid(0),
  676    !,
  677    throw(error(permission_error(open, server, http),
  678                context('Refusing to run HTTP server as root', _))).
  679verify_no_root.
  680
  681:- if(\+current_predicate(prctl/1)).  682prctl(_).
  683:- endif.  684
  685%!  server_redirect(+To, +Request)
  686%
  687%   Redirect al requests for this server to the specified server. To
  688%   is one of:
  689%
  690%     $ A port (integer) :
  691%     Redirect to the server running on that port in the same
  692%     Prolog process.
  693%     $ =true= :
  694%     Results from just passing =|--redirect|=.  Redirects to
  695%     an HTTPS server in the same Prolog process.
  696%     $ A URL :
  697%     Redirect to the the given URL + the request uri.  This can
  698%     be used if the server cannot find its public address.  For
  699%     example:
  700%
  701%       ```
  702%       --http --redirect=https://myhost.org --https
  703%       ```
  704
  705server_redirect(Port, Request) :-
  706    integer(Port),
  707    http_server_property(Port, scheme(Scheme)),
  708    http_public_host(Request, Host, _Port, []),
  709    memberchk(request_uri(Location), Request),
  710    (   default_port(Scheme, Port)
  711    ->  format(string(To), '~w://~w~w', [Scheme, Host, Location])
  712    ;   format(string(To), '~w://~w:~w~w', [Scheme, Host, Port, Location])
  713    ),
  714    throw(http_reply(moved_temporary(To))).
  715server_redirect(true, Request) :-
  716    !,
  717    http_server_property(P, scheme(https)),
  718    server_redirect(P, Request).
  719server_redirect(URI, Request) :-
  720    memberchk(request_uri(Location), Request),
  721    atom_concat(URI, Location, To),
  722    throw(http_reply(moved_temporary(To))).
  723
  724default_port(http, 80).
  725default_port(https, 443).
  726
  727
  728%!  setup_debug(+Options) is det.
  729%
  730%   Initialse debug/3 topics. The  =|--debug|=   option  may be used
  731%   multiple times.
  732
  733setup_debug(Options) :-
  734    setup_trace(Options),
  735    nodebug(_),
  736    debug(daemon),
  737    enable_debug(Options).
  738
  739enable_debug([]).
  740enable_debug([debug(Topic)|T]) :-
  741    !,
  742    atom_to_term(Topic, Term, _),
  743    debug(Term),
  744    enable_debug(T).
  745enable_debug([_|T]) :-
  746    enable_debug(T).
  747
  748setup_trace(Options) :-
  749    option(gtrace(true), Options),
  750    !,
  751    gtrace.
  752setup_trace(_).
  753
  754
  755%!  kill_x11(+Options) is det.
  756%
  757%   Get rid of X11 access if interactive is false.
  758
  759kill_x11(Options) :-
  760    getenv('DISPLAY', Display),
  761    Display \== '',
  762    option(interactive(false), Options, false),
  763    !,
  764    setenv('DISPLAY', ''),
  765    set_prolog_flag(gui, false).
  766kill_x11(_).
  767
  768
  769%!  setup_signals(+Options)
  770%
  771%   Prepare the server for signal handling.   By  default SIGINT and
  772%   SIGTERM terminate the server. SIGHUP causes   the  server to run
  773%   make/0.
  774
  775setup_signals(Options) :-
  776    option(interactive(true), Options, false),
  777    !.
  778setup_signals(Options) :-
  779    on_signal(int,  _, quit),
  780    on_signal(term, _, quit),
  781    option(sighup(Action), Options, reload),
  782    must_be(oneof([reload,quit]), Action),
  783    on_signal(usr1, _, logrotate),
  784    on_signal(hup,  _, Action).
  785
  786:- public
  787    quit/1,
  788    reload/1,
  789    logrotate/1.  790
  791quit(Signal) :-
  792    debug(daemon, 'Dying on signal ~w', [Signal]),
  793    thread_send_message(main, quit).
  794
  795reload(Signal) :-
  796    debug(daemon, 'Reload on signal ~w', [Signal]),
  797    thread_send_message(main, reload).
  798
  799logrotate(Signal) :-
  800    debug(daemon, 'Closing log files on signal ~w', [Signal]),
  801    thread_send_message(main, logrotate).
  802
  803%!  wait(+Options)
  804%
  805%   This predicate runs in the  main   thread,  waiting for messages
  806%   send by signal handlers to control   the server. In addition, it
  807%   broadcasts  maintenance(Interval,  Deadline)    messages   every
  808%   Interval seconds. These messages may   be trapped using listen/2
  809%   for performing scheduled maintenance such as rotating log files,
  810%   cleaning stale data, etc.
  811
  812wait(Options) :-
  813    option(interactive(true), Options, false),
  814    !,
  815    enable_development_system.
  816wait(Options) :-
  817    thread_self(Me),
  818    option(maintenance_interval(Interval), Options, 300),
  819    Interval > 0,
  820    !,
  821    first_deadline(Interval, FirstDeadline),
  822    State = deadline(0),
  823    repeat,
  824        State = deadline(Count),
  825        Deadline is FirstDeadline+Count*Interval,
  826        (   thread_get_message(Me, Msg, [deadline(Deadline)])
  827        ->  catch(ignore(handle_message(Msg)), E,
  828                  print_message(error, E)),
  829            Msg == quit,
  830            halt(0)
  831        ;   Count1 is Count + 1,
  832            nb_setarg(1, State, Count1),
  833            catch(broadcast(maintenance(Interval, Deadline)), E,
  834                  print_message(error, E)),
  835            fail
  836        ).
  837wait(_) :-
  838    thread_self(Me),
  839    repeat,
  840        thread_get_message(Me, Msg),
  841        catch(ignore(handle_message(Msg)), E,
  842              print_message(error, E)),
  843        Msg == quit,
  844        !,
  845        halt(0).
  846
  847handle_message(reload) :-
  848    make,
  849    broadcast(logrotate).
  850handle_message(logrotate) :-
  851    broadcast(logrotate).
  852
  853first_deadline(Interval, Deadline) :-
  854    get_time(Now),
  855    Deadline is ((integer(Now) + Interval - 1)//Interval)*Interval.
  856
  857
  858                 /*******************************
  859                 *            HOOKS             *
  860                 *******************************/
  861
  862%!  http_server_hook(+Options) is semidet.
  863%
  864%   Hook that is called to start the  HTTP server. This hook must be
  865%   compatible to http_server(Handler,  Options).   The  default  is
  866%   provided by start_server/1.
  867
  868
  869%!  http:sni_options(-HostName, -SSLOptions) is multi.
  870%
  871%   Hook  to   provide  Server  Name  Indication   (SNI)  for  TLS
  872%   servers. When starting an HTTPS  server, all solutions of this
  873%   predicate are  collected and a suitable  sni_hook/1 is defined
  874%   for ssl_context/3  to use different contexts  depending on the
  875%   host  name  of the  client  request.   This hook  is  executed
  876%   _before_ privileges are dropped.
  877
  878
  879                 /*******************************
  880                 *           MESSAGES           *
  881                 *******************************/
  882
  883:- multifile
  884    prolog:message//1.  885
  886prolog:message(http_daemon(help)) -->
  887    [ 'Usage: <program> option ...'-[], nl,
  888      'Options:'-[], nl, nl,
  889      '  --port=port        HTTP port to listen to'-[], nl,
  890      '  --ip=IP            Only listen to this ip (--ip=localhost)'-[], nl,
  891      '  --debug=topic      Print debug message for topic'-[], nl,
  892      '  --syslog=ident     Send output to syslog daemon as ident'-[], nl,
  893      '  --user=user        Run server under this user'-[], nl,
  894      '  --group=group      Run server under this group'-[], nl,
  895      '  --pidfile=path     Write PID to path'-[], nl,
  896      '  --output=file      Send output to file (instead of syslog)'-[], nl,
  897      '  --fork=bool        Do/do not fork'-[], nl,
  898      '  --http[=Address]   Create HTTP server'-[], nl,
  899      '  --https[=Address]  Create HTTPS server'-[], nl,
  900      '  --certfile=file    The server certificate'-[], nl,
  901      '  --keyfile=file     The server private key'-[], nl,
  902      '  --pwfile=file      File holding password for the private key'-[], nl,
  903      '  --password=pw      Password for the private key'-[], nl,
  904      '  --cipherlist=cs    Cipher strings separated by colons'-[], nl,
  905      '  --redirect=to      Redirect all requests to a URL or port'-[], nl,
  906      '  --interactive=bool Enter Prolog toplevel after starting server'-[], nl,
  907      '  --gtrace=bool      Start (graphical) debugger'-[], nl,
  908      '  --sighup=action    Action on SIGHUP: reload (default) or quit'-[], nl,
  909      '  --workers=count    Number of HTTP worker threads'-[], nl, nl,
  910      'Boolean options may be written without value (true) or as --no-name (false)'-[], nl,
  911      'Address is a port number or host:port, e.g., 8080 or localhost:8080'-[], nl,
  912      'Multiple servers can be started by repeating --http and --https'-[], nl,
  913      'Each server merges the options before the first --http(s) and up the next'-[]
  914    ].
  915prolog:message(http_daemon(no_root(switch_user(User)))) -->
  916    [ 'Program must be started as root to use --user=~w.'-[User] ].
  917prolog:message(http_daemon(no_root(open_port(Port)))) -->
  918    [ 'Cannot open port ~w.  Only root can open ports below 1000.'-[Port] ]