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