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-2022, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module(http_unix_daemon, 39 [ http_daemon/0, 40 http_daemon/1 % +Options 41 ]). 42:- use_module(library(error)). 43:- use_module(library(apply)). 44:- use_module(library(lists)). 45:- use_module(library(debug)). 46:- use_module(library(broadcast)). 47:- use_module(library(socket)). 48:- use_module(library(option)). 49:- use_module(library(uid)). 50:- use_module(library(unix)). 51:- use_module(library(syslog)). 52:- use_module(library(http/thread_httpd)). 53:- use_module(library(http/http_dispatch)). 54:- use_module(library(http/http_host)). 55:- use_module(library(main)). 56:- use_module(library(readutil)). 57 58:- if(( exists_source(library(http/http_ssl_plugin)), 59 \+ current_prolog_flag(pldoc_to_tex,true))). 60:- use_module(library(ssl)). 61:- use_module(library(http/http_ssl_plugin)). 62:- endif. 63 64:- multifile 65 http_server_hook/1, % +Options 66 http_certificate_hook/3, % +CertFile, +KeyFile, -Password 67 http:sni_options/2. % +HostName, +SSLOptions 68 69:- initialization(http_daemon, main).
158:- debug(daemon). 159 160% Do not run xpce in a thread. This disables forking. The problem here 161% is that loading library(pce) starts the event dispatching thread. This 162% should be handled lazily. 163 164:- set_prolog_flag(xpce_threaded, false). 165:- set_prolog_flag(message_ide, false). % cause xpce to trap messages 166:- set_prolog_flag(message_context, [thread,time('%F %T.%3f')]). 167:- dynamic interactive/0.
--http=Spec
or --https=Spec
is followed by
arguments for that server until the next --http=Spec
or --https=Spec
or the end of the options.--http=Spec
or --https=Spec
appears, one
HTTP server is created from the specified parameters.
Examples:
--workers=10 --http --https --http=8080 --https=8443 --http=localhost:8080 --workers=1 --https=8443 --workers=25
--user=User
to open ports below 1000. The default
port is 80. If --https
is used, the default port is 443.--ip=localhost
to restrict access to connections from
localhost if the server itself is behind an (Apache)
proxy server running on the same host.socket(s)
--pwfile=File
)--user
. If omitted, the login
group of the target user is used.--no-fork
or --fork=false
, the process
runs in the foreground.true
, create at the specified or default address. Else
use the given port and interface. Thus, --http
creates
a server at port 80, --http=8080
creates one at port
8080 and --http=localhost:8080
creates one at port
8080 that is only accessible from localhost
.--http
, but creates an HTTPS server.
Use --certfile
, --keyfile
, -pwfile
,
--password
and --cipherlist
to configure SSL for
this server.--password=PW
as it allows using
file protection to avoid leaking the password. The file is
read before the server drops privileges when started with
the --user
option.true
(default false
) implies --no-fork
and presents
the Prolog toplevel after starting the server.kill -HUP <pid>
. Default is reload
(running make/0). Alternative is quit
, stopping the server.Other options are converted by argv_options/3 and passed to http_server/1. For example, this allows for:
http_daemon/0 is defined as below. The start code for a specific server can use this as a starting point, for example for specifying defaults.
http_daemon :- current_prolog_flag(argv, Argv), argv_options(Argv, _RestArgv, Options), http_daemon(Options).
301http_daemon :-
302 current_prolog_flag(argv, Argv),
303 argv_options(Argv, _RestArgv, Options),
304 http_daemon(Options).
Error handling depends on whether or not interactive(true)
is in
effect. If so, the error is printed before entering the toplevel. In
non-interactive mode this predicate calls halt(1)
.
316http_daemon(Options) :- 317 catch(http_daemon_guarded(Options), Error, start_failed(Error)). 318 319start_failed(Error) :- 320 interactive, 321 !, 322 print_message(warning, Error). 323start_failed(Error) :- 324 print_message(error, Error), 325 halt(1).
332http_daemon_guarded(Options) :- 333 option(help(true), Options), 334 !, 335 print_message(information, http_daemon(help)), 336 halt. 337http_daemon_guarded(Options) :- 338 setup_debug(Options), 339 kill_x11(Options), 340 option_servers(Options, Servers0), 341 maplist(make_socket, Servers0, Servers), 342 ( option(fork(true), Options, true), 343 option(interactive(false), Options, false), 344 can_switch_user(Options) 345 -> fork(Who), 346 ( Who \== child 347 -> halt 348 ; disable_development_system, 349 setup_syslog(Options), 350 write_pid(Options), 351 setup_output(Options), 352 switch_user(Options), 353 setup_signals(Options), 354 start_servers(Servers), 355 wait(Options) 356 ) 357 ; write_pid(Options), 358 switch_user(Options), 359 setup_signals(Options), 360 start_servers(Servers), 361 wait(Options) 362 ).
server(Scheme, Address, Opts)
, where Address is
either a plain port (integer) or Host:Port. The latter binds the
port to the interface belonging to Host. For example:
socket(http, localhost:8080, Opts)
creates an HTTP socket that
binds to the localhost interface on port 80. Opts are the
options specific for the given server.374option_servers(Options, Sockets) :- 375 opt_sockets(Options, [], [], Sockets). 376 377opt_sockets([], Options, [], [Socket]) :- 378 !, 379 make_server(http(true), Options, Socket). 380opt_sockets([], _, Sockets, Sockets). 381opt_sockets([H|T], OptsH, Sockets0, Sockets) :- 382 server_option(H), 383 !, 384 append(OptsH, [H], OptsH1), 385 opt_sockets(T, OptsH1, Sockets0, Sockets). 386opt_sockets([H|T0], Opts, Sockets0, Sockets) :- 387 server_start_option(H), 388 !, 389 server_options(T0, T, Opts, SOpts), 390 make_server(H, SOpts, Socket), 391 append(Sockets0, [Socket], Sockets1), 392 opt_sockets(T, Opts, Sockets1, Sockets). 393opt_sockets([_|T], Opts, Sockets0, Sockets) :- 394 opt_sockets(T, Opts, Sockets0, Sockets). 395 396server_options([], [], Options, Options). 397server_options([H|T], Rest, Options0, Options) :- 398 server_option(H), 399 !, 400 generalise_option(H, G), 401 delete(Options0, G, Options1), 402 append(Options1, [H], Options2), 403 server_options(T, Rest, Options2, Options). 404server_options([H|T], [H|T], Options, Options) :- 405 server_start_option(H), 406 !. 407server_options([_|T0], Rest, Options0, Options) :- 408 server_options(T0, Rest, Options0, Options). 409 410generalise_option(H, G) :- 411 H =.. [Name,_], 412 G =.. [Name,_]. 413 414server_start_option(http(_)). 415server_start_option(https(_)). 416 417server_option(port(_)). 418server_option(ip(_)). 419server_option(certfile(_)). 420server_option(keyfile(_)). 421server_option(pwfile(_)). 422server_option(password(_)). 423server_option(cipherlist(_)). 424server_option(workers(_)). 425server_option(redirect(_)). 426server_option(timeout(_)). 427server_option(keep_alive_timeout(_)). 428 429make_server(http(Address0), Options0, server(http, Address, Options)) :- 430 make_address(Address0, 80, Address, Options0, Options). 431make_server(https(Address0), Options0, server(https, Address, SSLOptions)) :- 432 make_address(Address0, 443, Address, Options0, Options), 433 merge_https_options(Options, SSLOptions). 434 435make_address(true, DefPort, Address, Options0, Options) :- 436 !, 437 option(port(Port), Options0, DefPort), 438 ( option(ip(Bind), Options0) 439 -> Address = (Bind:Port) 440 ; Address = Port 441 ), 442 merge_options([port(Port)], Options0, Options). 443make_address(Bind:Port, _, Bind:Port, Options0, Options) :- 444 !, 445 must_be(atom, Bind), 446 must_be(integer, Port), 447 merge_options([port(Port), ip(Bind)], Options0, Options). 448make_address(Port, _, Address, Options0, Options) :- 449 integer(Port), 450 !, 451 ( option(ip(Bind), Options0) 452 -> Address = (Bind:Port) 453 ; Address = Port, 454 merge_options([port(Port)], Options0, Options) 455 ). 456make_address(Spec, _, Address, Options0, Options) :- 457 atomic(Spec), 458 split_string(Spec, ":", "", [BindString, PortString]), 459 number_string(Port, PortString), 460 !, 461 atom_string(Bind, BindString), 462 Address = (Bind:Port), 463 merge_options([port(Port), ip(Bind)], Options0, Options). 464make_address(Spec, _, _, _, _) :- 465 domain_error(address, Spec). 466 467:- dynamic sni/3. 468 469merge_https_options(Options, [SSL|Options]) :- 470 ( option(certfile(CertFile), Options), 471 option(keyfile(KeyFile), Options) 472 -> prepare_https_certificate(CertFile, KeyFile, Passwd0), 473 read_file_to_string(CertFile, Certificate, []), 474 read_file_to_string(KeyFile, Key, []), 475 Pairs = [Certificate-Key] 476 ; Pairs = [] 477 ), 478 ssl_secure_ciphers(SecureCiphers), 479 option(cipherlist(CipherList), Options, SecureCiphers), 480 ( string(Passwd0) 481 -> Passwd = Passwd0 482 ; options_password(Options, Passwd) 483 ), 484 findall(HostName-HostOptions, http:sni_options(HostName, HostOptions), SNIs), 485 maplist(sni_contexts, SNIs), 486 SSL = ssl([ certificate_key_pairs(Pairs), 487 cipher_list(CipherList), 488 password(Passwd), 489 sni_hook(http_unix_daemon:sni) 490 ]). 491 492sni_contexts(Host-Options) :- 493 ssl_context(server, SSL, Options), 494 assertz(sni(_, Host, SSL)).
504prepare_https_certificate(CertFile, KeyFile, Password) :- 505 http_certificate_hook(CertFile, KeyFile, Password), 506 !. 507prepare_https_certificate(_, _, _). 508 509 510options_password(Options, Passwd) :- 511 option(password(Passwd), Options), 512 !. 513options_password(Options, Passwd) :- 514 option(pwfile(File), Options), 515 !, 516 read_file_to_string(File, String, []), 517 split_string(String, "", "\r\n\t ", [Passwd]). 518options_password(_, '').
broadcast(http(pre_server_start))
broadcast(http(pre_server_start(Port)))
b. Call http_server(http_dispatch, Options)
c. Call broadcast(http(post_server_start(Port)))
broadcast(http(post_server_start))
This predicate can be hooked using http_server_hook/1. This predicate is executed after
539start_servers(Servers) :- 540 broadcast(http(pre_server_start)), 541 maplist(start_server, Servers), 542 broadcast(http(post_server_start)). 543 544start_server(server(_Scheme, Socket, Options)) :- 545 option(redirect(To), Options), 546 !, 547 http_server(server_redirect(To), [tcp_socket(Socket)|Options]). 548start_server(server(_Scheme, Socket, Options)) :- 549 http_server_hook([tcp_socket(Socket)|Options]), 550 !. 551start_server(server(_Scheme, Socket, Options)) :- 552 option(port(Port), Options), 553 broadcast(http(pre_server_start(Port))), 554 http_server(http_dispatch, [tcp_socket(Socket)|Options]), 555 broadcast(http(post_server_start(Port))). 556 557make_socket(server(Scheme, Address, Options), 558 server(Scheme, Socket, Options)) :- 559 tcp_socket(Socket), 560 catch(bind_socket(Socket, Address), Error, 561 make_socket_error(Error, Address)), 562 debug(daemon(socket), 563 'Created socket ~p, listening on ~p', [Socket, Address]). 564 565bind_socket(Socket, Address) :- 566 tcp_setopt(Socket, reuseaddr), 567 tcp_bind(Socket, Address), 568 tcp_listen(Socket, 5). 569 570make_socket_error(error(socket_error(_,_), _), Address) :- 571 address_port(Address, Port), 572 integer(Port), 573 Port =< 1000, 574 !, 575 verify_root(open_port(Port)). 576make_socket_error(Error, _) :- 577 throw(Error). 578 579address_port(_:Port, Port) :- !. 580address_port(Port, Port).
586disable_development_system :-
587 set_prolog_flag(editor, '/bin/false').
595enable_development_system :-
596 assertz(interactive),
597 set_prolog_flag(xpce_threaded, true),
598 set_prolog_flag(message_ide, true),
599 ( current_prolog_flag(xpce_version, _)
600 -> call(pce_dispatch([]))
601 ; true
602 ),
603 set_prolog_flag(toplevel_goal, prolog).
609setup_syslog(Options) :- 610 option(syslog(Ident), Options), 611 !, 612 openlog(Ident, [pid], user). 613setup_syslog(_).
output(File)
, all output is written to File.622setup_output(Options) :- 623 option(output(File), Options), 624 !, 625 open(File, write, Out, [encoding(utf8)]), 626 set_stream(Out, buffer(line)), 627 detach_IO(Out). 628setup_output(_) :- 629 open_null_stream(Out), 630 detach_IO(Out).
pidfile(File)
is present, write the PID of the
daemon to this file.638write_pid(Options) :- 639 option(pidfile(File), Options), 640 current_prolog_flag(pid, PID), 641 !, 642 setup_call_cleanup( 643 open(File, write, Out), 644 format(Out, '~d~n', [PID]), 645 close(Out)), 646 at_halt(catch(delete_file(File), _, true)). 647write_pid(_).
655switch_user(Options) :- 656 option(user(User), Options), 657 !, 658 verify_root(switch_user(User)), 659 ( option(group(Group), Options) 660 -> set_user_and_group(User, Group) 661 ; set_user_and_group(User) 662 ), 663 prctl(set_dumpable(true)). % re-enable core dumps on Linux 664switch_user(_Options) :- 665 verify_no_root.
672can_switch_user(Options) :- 673 option(user(User), Options), 674 !, 675 verify_root(switch_user(User)). 676can_switch_user(_Options) :- 677 verify_no_root. 678 679verify_root(_Task) :- 680 geteuid(0), 681 !. 682verify_root(Task) :- 683 print_message(error, http_daemon(no_root(Task))), 684 halt(1). 685 686verify_no_root :- 687 geteuid(0), 688 !, 689 throw(error(permission_error(open, server, http), 690 context('Refusing to run HTTP server as root', _))). 691verify_no_root. 692 693:- if(\+current_predicate(prctl/1)). 694prctl(_). 695:- endif.
true
--redirect
. Redirects to
an HTTPS server in the same Prolog process.--http --redirect=https://myhost.org --https
717server_redirect(Port, Request) :- 718 integer(Port), 719 http_server_property(Port, scheme(Scheme)), 720 http_public_host(Request, Host, _Port, []), 721 memberchk(request_uri(Location), Request), 722 ( default_port(Scheme, Port) 723 -> format(string(To), '~w://~w~w', [Scheme, Host, Location]) 724 ; format(string(To), '~w://~w:~w~w', [Scheme, Host, Port, Location]) 725 ), 726 throw(http_reply(moved_temporary(To))). 727server_redirect(true, Request) :- 728 !, 729 http_server_property(P, scheme(https)), 730 server_redirect(P, Request). 731server_redirect(URI, Request) :- 732 memberchk(request_uri(Location), Request), 733 atom_concat(URI, Location, To), 734 throw(http_reply(moved_temporary(To))). 735 736default_port(http, 80). 737default_port(https, 443).
--debug
option may be used
multiple times.745setup_debug(Options) :- 746 setup_trace(Options), 747 nodebug(_), 748 debug(daemon), 749 enable_debug(Options). 750 751enable_debug([]). 752enable_debug([debug(Topic)|T]) :- 753 !, 754 atom_to_term(Topic, Term, _), 755 debug(Term), 756 enable_debug(T). 757enable_debug([_|T]) :- 758 enable_debug(T). 759 760setup_trace(Options) :- 761 option(gtrace(true), Options), 762 !, 763 gtrace. 764setup_trace(_).
771kill_x11(Options) :- 772 getenv('DISPLAY', Display), 773 Display \== '', 774 option(interactive(false), Options, false), 775 !, 776 setenv('DISPLAY', ''), 777 set_prolog_flag(gui, false). 778kill_x11(_).
787setup_signals(Options) :- 788 option(interactive(true), Options, false), 789 !. 790setup_signals(Options) :- 791 on_signal(int, _, quit), 792 on_signal(term, _, quit), 793 option(sighup(Action), Options, reload), 794 must_be(oneof([reload,quit]), Action), 795 on_signal(usr1, _, logrotate), 796 on_signal(hup, _, Action). 797 798:- public 799 quit/1, 800 reload/1, 801 logrotate/1. 802 803quit(Signal) :- 804 debug(daemon, 'Dying on signal ~w', [Signal]), 805 thread_send_message(main, quit). 806 807reload(Signal) :- 808 debug(daemon, 'Reload on signal ~w', [Signal]), 809 thread_send_message(main, reload). 810 811logrotate(Signal) :- 812 debug(daemon, 'Closing log files on signal ~w', [Signal]), 813 thread_send_message(main, logrotate).
maintenance(Interval, Deadline)
messages every
Interval seconds. These messages may be trapped using listen/2
for performing scheduled maintenance such as rotating log files,
cleaning stale data, etc.824wait(Options) :- 825 option(interactive(true), Options, false), 826 !, 827 enable_development_system. 828wait(Options) :- 829 thread_self(Me), 830 option(maintenance_interval(Interval), Options, 300), 831 Interval > 0, 832 !, 833 first_deadline(Interval, FirstDeadline), 834 State = deadline(0), 835 repeat, 836 State = deadline(Count), 837 Deadline is FirstDeadline+Count*Interval, 838 ( thread_idle(thread_get_message(Me, Msg, [deadline(Deadline)]), 839 long) 840 -> catch(ignore(handle_message(Msg)), E, 841 print_message(error, E)), 842 Msg == quit, 843 catch(broadcast(http(shutdown)), E, 844 print_message(error, E)), 845 halt(0) 846 ; Count1 is Count + 1, 847 nb_setarg(1, State, Count1), 848 catch(broadcast(maintenance(Interval, Deadline)), E, 849 print_message(error, E)), 850 fail 851 ). 852wait(_) :- 853 thread_self(Me), 854 repeat, 855 thread_idle(thread_get_message(Me, Msg), long), 856 catch(ignore(handle_message(Msg)), E, 857 print_message(error, E)), 858 Msg == quit, 859 !, 860 halt(0). 861 862handle_message(reload) :- 863 make, 864 broadcast(logrotate). 865handle_message(logrotate) :- 866 broadcast(logrotate). 867 868first_deadline(Interval, Deadline) :- 869 get_time(Now), 870 Deadline is ((integer(Now) + Interval - 1)//Interval)*Interval. 871 872 873 /******************************* 874 * HOOKS * 875 *******************************/
http_server(Handler, Options)
. The default is
provided by start_server/1.894 /******************************* 895 * MESSAGES * 896 *******************************/ 897 898:- multifile 899 prolog:message//1. 900 901prologmessage(http_daemon(help)) --> 902 [ 'Usage: <program> option ...'-[], nl, 903 'Options:'-[], nl, nl, 904 ' --port=port HTTP port to listen to'-[], nl, 905 ' --ip=IP Only listen to this ip (--ip=localhost)'-[], nl, 906 ' --debug=topic Print debug message for topic'-[], nl, 907 ' --syslog=ident Send output to syslog daemon as ident'-[], nl, 908 ' --user=user Run server under this user'-[], nl, 909 ' --group=group Run server under this group'-[], nl, 910 ' --pidfile=path Write PID to path'-[], nl, 911 ' --output=file Send output to file (instead of syslog)'-[], nl, 912 ' --fork=bool Do/do not fork'-[], nl, 913 ' --http[=Address] Create HTTP server'-[], nl, 914 ' --https[=Address] Create HTTPS server'-[], nl, 915 ' --certfile=file The server certificate'-[], nl, 916 ' --keyfile=file The server private key'-[], nl, 917 ' --pwfile=file File holding password for the private key'-[], nl, 918 ' --password=pw Password for the private key'-[], nl, 919 ' --cipherlist=cs Cipher strings separated by colons'-[], nl, 920 ' --redirect=to Redirect all requests to a URL or port'-[], nl, 921 ' --interactive=bool Enter Prolog toplevel after starting server'-[], nl, 922 ' --gtrace=bool Start (graphical) debugger'-[], nl, 923 ' --sighup=action Action on SIGHUP: reload (default) or quit'-[], nl, 924 ' --workers=count Number of HTTP worker threads'-[], nl, 925 ' --timeout=sec Time to wait for client to complete request'-[], nl, 926 ' --keep_alive_timeout=sec'-[], nl, 927 ' Time to wait for a new request'-[], nl, 928 nl, 929 'Boolean options may be written without value (true) or as --no-name (false)'-[], nl, 930 'Address is a port number or host:port, e.g., 8080 or localhost:8080'-[], nl, 931 'Multiple servers can be started by repeating --http and --https'-[], nl, 932 'Each server merges the options before the first --http(s) and up the next'-[] 933 ]. 934prologmessage(http_daemon(no_root(switch_user(User)))) --> 935 [ 'Program must be started as root to use --user=~w.'-[User] ]. 936prologmessage(http_daemon(no_root(open_port(Port)))) --> 937 [ 'Cannot open port ~w. Only root can open ports below 1000.'-[Port] ]
Run SWI-Prolog HTTP server as a Unix system daemon
This module provides the logic that is needed to integrate a process into the Unix service (daemon) architecture. It deals with the following aspects, all of which may be used/ignored and configured using commandline options:
port(s)
to be used by the serverThe typical use scenario is to write a file that loads the following components:
In the code below,
?- [load].
loads the remainder of the webserver code. This is often a sequence of use_module/1 directives.The program entry point is http_daemon/0, declared using initialization/2. This may be overruled using a new declaration after loading this library. The new entry point will typically call http_daemon/1 to start the server in a preconfigured way.
Now, the server may be started using the command below. See http_daemon/0 for supported options.
Below are some examples. Our first example is completely silent, running on port 80 as user
www
.Our second example logs HTTP interaction with the syslog daemon for debugging purposes. Note that the argument to
--debug
= is a Prolog term and must often be escaped to avoid misinterpretation by the Unix shell. The debug option can be repeated to log multiple debug topics.Broadcasting The library uses broadcast/1 to allow hooking certain events: