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