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-2023, 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 http_opt_type/3, % ?Flag, ?Option, ?Type 42 http_opt_help/2, % ?Option, ?Help 43 http_opt_meta/2 % ?Option, ?Meta 44 ]). 45:- use_module(library(error)). 46:- use_module(library(apply)). 47:- use_module(library(lists)). 48:- use_module(library(debug)). 49:- use_module(library(broadcast)). 50:- use_module(library(socket)). 51:- use_module(library(option)). 52:- use_module(library(uid)). 53:- use_module(library(unix)). 54:- use_module(library(syslog)). 55:- use_module(library(http/thread_httpd)). 56:- use_module(library(http/http_dispatch)). 57:- use_module(library(http/http_host)). 58:- use_module(library(main)). 59:- use_module(library(readutil)). 60 61:- if(( exists_source(library(http/http_ssl_plugin)), 62 \+ current_prolog_flag(pldoc_to_tex,true))). 63:- use_module(library(ssl)). 64:- use_module(library(http/http_ssl_plugin)). 65:- endif. 66 67:- multifile 68 http_server_hook/1, % +Options 69 http_certificate_hook/3, % +CertFile, +KeyFile, -Password 70 http:sni_options/2. % +HostName, +SSLOptions 71 72:- initialization(http_daemon, main).
161:- debug(daemon). 162 163% Do not run xpce in a thread. This disables forking. The problem here 164% is that loading library(pce) starts the event dispatching thread. This 165% should be handled lazily. 166 167:- set_prolog_flag(xpce_threaded, false). 168:- set_prolog_flag(message_ide, false). % cause xpce to trap messages 169:- set_prolog_flag(message_context, [thread,time('%F %T.%3f')]). 170:- 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 or additional options. This uses guided options processing from argv_options/3 from library(main). The option definitions are available as http_opt_type/3, http_opt_help/2 and http_opt_meta/2
http_daemon :- current_prolog_flag(argv, Argv), argv_options(Argv, _RestArgv, Options), http_daemon(Options).
307http_daemon :- 308 current_prolog_flag(argv, Argv), 309 argv_options(Argv, _RestArgv, Options), 310 http_daemon(Options). 311 312% Option declarations for argv_options/3 from library(main). 313 314opt_type(port, port, nonneg). 315opt_type(p, port, nonneg). 316opt_type(ip, ip, atom). 317opt_type(debug, debug, term). 318opt_type(syslog, syslog, atom). 319opt_type(user, user, atom). 320opt_type(group, group, atom). 321opt_type(pidfile, pidfile, file(write)). 322opt_type(output, output, file(write)). 323opt_type(fork, fork, boolean). 324opt_type(http, http, nonneg|boolean). 325opt_type(https, https, nonneg|boolean). 326opt_type(certfile, certfile, file(read)). 327opt_type(keyfile, keyfile, file(read)). 328opt_type(pwfile, pwfile, file(read)). 329opt_type(password, password, string). 330opt_type(cipherlist, cipherlist, string). 331opt_type(redirect, redirect, string). 332opt_type(interactive, interactive, boolean). 333opt_type(i, interactive, boolean). 334opt_type(gtrace, gtrace, boolean). 335opt_type(sighup, sighup, oneof([reload,quit])). 336opt_type(workers, workers, natural). 337opt_type(timeout, timeout, number). 338opt_type(keep_alive_timeout, keep_alive_timeout, number). 339 340opt_help(port, "HTTP port to listen to"). 341opt_help(ip, "Only listen to this ip (--ip=localhost)"). 342opt_help(debug, "Print debug message for topic"). 343opt_help(syslog, "Send output to syslog daemon as ident"). 344opt_help(user, "Run server under this user"). 345opt_help(group, "Run server under this group"). 346opt_help(pidfile, "Write PID to path"). 347opt_help(output, "Send output to file (instead of syslog)"). 348opt_help(fork, "Do (default) or do not fork"). 349opt_help(http, "Create HTTP server"). 350opt_help(https, "Create HTTPS server"). 351opt_help(certfile, "The server certificate"). 352opt_help(keyfile, "The server private key"). 353opt_help(pwfile, "File holding password for the private key"). 354opt_help(password, "Password for the private key"). 355opt_help(cipherlist, "Cipher strings separated by colons"). 356opt_help(redirect, "Redirect all requests to a URL or port"). 357opt_help(interactive, "Enter Prolog toplevel after starting server"). 358opt_help(gtrace, "Start (graphical) debugger"). 359opt_help(sighup, "Action on SIGHUP: reload (default) or quit"). 360opt_help(workers, "Number of HTTP worker threads"). 361opt_help(timeout, "Time to wait for client to complete request"). 362opt_help(keep_alive_timeout, "Time to wait for a new request"). 363 364opt_meta(port, 'PORT'). 365opt_meta(ip, 'IP'). 366opt_meta(debug, 'TERM'). 367opt_meta(http, 'PORT'). 368opt_meta(https, 'PORT'). 369opt_meta(syslog, 'IDENT'). 370opt_meta(user, 'NAME'). 371opt_meta(group, 'NAME'). 372opt_meta(redirect, 'URL'). 373opt_meta(sighup, 'ACTION'). 374opt_meta(workers, 'COUNT'). 375opt_meta(timeout, 'SECONDS'). 376opt_meta(keep_alive_timeout, 'SECONDS').
384http_opt_type(Flag, Option, Type) :- 385 opt_type(Flag, Option, Type). 386 387http_opt_help(Option, Help) :- 388 opt_help(Option, Help), 389 Option \= help(_). 390 391http_opt_meta(Option, Meta) :- 392 opt_meta(Option, Meta).
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)
.
405http_daemon(Options) :- 406 catch(http_daemon_guarded(Options), Error, start_failed(Error)). 407 408start_failed(Error) :- 409 interactive, 410 !, 411 print_message(warning, Error). 412start_failed(Error) :- 413 print_message(error, Error), 414 halt(1).
421http_daemon_guarded(Options) :-
422 setup_debug(Options),
423 kill_x11(Options),
424 option_servers(Options, Servers0),
425 maplist(make_socket, Servers0, Servers),
426 ( option(fork(true), Options, true),
427 option(interactive(false), Options, false),
428 can_switch_user(Options)
429 -> fork(Who),
430 ( Who \== child
431 -> halt
432 ; disable_development_system,
433 setup_syslog(Options),
434 write_pid(Options),
435 setup_output(Options),
436 switch_user(Options),
437 setup_signals(Options),
438 start_servers(Servers),
439 wait(Options)
440 )
441 ; write_pid(Options),
442 switch_user(Options),
443 setup_signals(Options),
444 start_servers(Servers),
445 wait(Options)
446 ).
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.458option_servers(Options, Sockets) :- 459 opt_sockets(Options, [], [], Sockets). 460 461opt_sockets([], Options, [], [Socket]) :- 462 !, 463 make_server(http(true), Options, Socket). 464opt_sockets([], _, Sockets, Sockets). 465opt_sockets([H|T], OptsH, Sockets0, Sockets) :- 466 server_option(H), 467 !, 468 append(OptsH, [H], OptsH1), 469 opt_sockets(T, OptsH1, Sockets0, Sockets). 470opt_sockets([H|T0], Opts, Sockets0, Sockets) :- 471 server_start_option(H), 472 !, 473 server_options(T0, T, Opts, SOpts), 474 make_server(H, SOpts, Socket), 475 append(Sockets0, [Socket], Sockets1), 476 opt_sockets(T, Opts, Sockets1, Sockets). 477opt_sockets([_|T], Opts, Sockets0, Sockets) :- 478 opt_sockets(T, Opts, Sockets0, Sockets). 479 480server_options([], [], Options, Options). 481server_options([H|T], Rest, Options0, Options) :- 482 server_option(H), 483 !, 484 generalise_option(H, G), 485 delete(Options0, G, Options1), 486 append(Options1, [H], Options2), 487 server_options(T, Rest, Options2, Options). 488server_options([H|T], [H|T], Options, Options) :- 489 server_start_option(H), 490 !. 491server_options([_|T0], Rest, Options0, Options) :- 492 server_options(T0, Rest, Options0, Options). 493 494generalise_option(H, G) :- 495 H =.. [Name,_], 496 G =.. [Name,_]. 497 498server_start_option(http(_)). 499server_start_option(https(_)). 500 501server_option(port(_)). 502server_option(ip(_)). 503server_option(certfile(_)). 504server_option(keyfile(_)). 505server_option(pwfile(_)). 506server_option(password(_)). 507server_option(cipherlist(_)). 508server_option(workers(_)). 509server_option(redirect(_)). 510server_option(timeout(_)). 511server_option(keep_alive_timeout(_)). 512 513make_server(http(Address0), Options0, server(http, Address, Options)) :- 514 make_address(Address0, 80, Address, Options0, Options). 515make_server(https(Address0), Options0, server(https, Address, SSLOptions)) :- 516 make_address(Address0, 443, Address, Options0, Options), 517 merge_https_options(Options, SSLOptions). 518 519make_address(true, DefPort, Address, Options0, Options) :- 520 !, 521 option(port(Port), Options0, DefPort), 522 ( option(ip(Bind), Options0) 523 -> Address = (Bind:Port) 524 ; Address = Port 525 ), 526 merge_options([port(Port)], Options0, Options). 527make_address(Bind:Port, _, Bind:Port, Options0, Options) :- 528 !, 529 must_be(atom, Bind), 530 must_be(integer, Port), 531 merge_options([port(Port), ip(Bind)], Options0, Options). 532make_address(Port, _, Address, Options0, Options) :- 533 integer(Port), 534 !, 535 ( option(ip(Bind), Options0) 536 -> Address = (Bind:Port) 537 ; Address = Port, 538 merge_options([port(Port)], Options0, Options) 539 ). 540make_address(Spec, _, Address, Options0, Options) :- 541 atomic(Spec), 542 split_string(Spec, ":", "", [BindString, PortString]), 543 number_string(Port, PortString), 544 !, 545 atom_string(Bind, BindString), 546 Address = (Bind:Port), 547 merge_options([port(Port), ip(Bind)], Options0, Options). 548make_address(Spec, _, _, _, _) :- 549 domain_error(address, Spec). 550 551:- dynamic sni/3. 552 553merge_https_options(Options, [SSL|Options]) :- 554 ( option(certfile(CertFile), Options), 555 option(keyfile(KeyFile), Options) 556 -> prepare_https_certificate(CertFile, KeyFile, Passwd0), 557 read_file_to_string(CertFile, Certificate, []), 558 read_file_to_string(KeyFile, Key, []), 559 Pairs = [Certificate-Key] 560 ; Pairs = [] 561 ), 562 ssl_secure_ciphers(SecureCiphers), 563 option(cipherlist(CipherList), Options, SecureCiphers), 564 ( string(Passwd0) 565 -> Passwd = Passwd0 566 ; options_password(Options, Passwd) 567 ), 568 findall(HostName-HostOptions, http:sni_options(HostName, HostOptions), SNIs), 569 maplist(sni_contexts, SNIs), 570 SSL = ssl([ certificate_key_pairs(Pairs), 571 cipher_list(CipherList), 572 password(Passwd), 573 sni_hook(http_unix_daemon:sni) 574 ]). 575 576sni_contexts(Host-Options) :- 577 ssl_context(server, SSL, Options), 578 assertz(sni(_, Host, SSL)).
588prepare_https_certificate(CertFile, KeyFile, Password) :- 589 http_certificate_hook(CertFile, KeyFile, Password), 590 !. 591prepare_https_certificate(_, _, _). 592 593 594options_password(Options, Passwd) :- 595 option(password(Passwd), Options), 596 !. 597options_password(Options, Passwd) :- 598 option(pwfile(File), Options), 599 !, 600 read_file_to_string(File, String, []), 601 split_string(String, "", "\r\n\t ", [Passwd]). 602options_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
623start_servers(Servers) :- 624 broadcast(http(pre_server_start)), 625 maplist(start_server, Servers), 626 broadcast(http(post_server_start)). 627 628start_server(server(_Scheme, Socket, Options)) :- 629 option(redirect(To), Options), 630 !, 631 http_server(server_redirect(To), [tcp_socket(Socket)|Options]). 632start_server(server(_Scheme, Socket, Options)) :- 633 http_server_hook([tcp_socket(Socket)|Options]), 634 !. 635start_server(server(_Scheme, Socket, Options)) :- 636 option(port(Port), Options), 637 broadcast(http(pre_server_start(Port))), 638 http_server(http_dispatch, [tcp_socket(Socket)|Options]), 639 broadcast(http(post_server_start(Port))). 640 641make_socket(server(Scheme, Address, Options), 642 server(Scheme, Socket, Options)) :- 643 tcp_socket(Socket), 644 catch(bind_socket(Socket, Address), Error, 645 make_socket_error(Error, Address)), 646 debug(daemon(socket), 647 'Created socket ~p, listening on ~p', [Socket, Address]). 648 649bind_socket(Socket, Address) :- 650 tcp_setopt(Socket, reuseaddr), 651 tcp_bind(Socket, Address), 652 tcp_listen(Socket, 5). 653 654make_socket_error(error(socket_error(_,_), _), Address) :- 655 address_port(Address, Port), 656 integer(Port), 657 Port =< 1000, 658 !, 659 verify_root(open_port(Port)). 660make_socket_error(Error, _) :- 661 throw(Error). 662 663address_port(_:Port, Port) :- !. 664address_port(Port, Port).
670disable_development_system :-
671 set_prolog_flag(editor, '/bin/false').
679enable_development_system :-
680 assertz(interactive),
681 set_prolog_flag(xpce_threaded, true),
682 set_prolog_flag(message_ide, true),
683 ( current_prolog_flag(xpce_version, _)
684 -> call(pce_dispatch([]))
685 ; true
686 ),
687 set_prolog_flag(toplevel_goal, prolog).
693setup_syslog(Options) :- 694 option(syslog(Ident), Options), 695 !, 696 openlog(Ident, [pid], user). 697setup_syslog(_).
output(File)
, all output is written to File.706setup_output(Options) :- 707 option(output(File), Options), 708 !, 709 open(File, write, Out, [encoding(utf8)]), 710 set_stream(Out, buffer(line)), 711 detach_IO(Out). 712setup_output(_) :- 713 open_null_stream(Out), 714 detach_IO(Out).
pidfile(File)
is present, write the PID of the
daemon to this file.722write_pid(Options) :- 723 option(pidfile(File), Options), 724 current_prolog_flag(pid, PID), 725 !, 726 setup_call_cleanup( 727 open(File, write, Out), 728 format(Out, '~d~n', [PID]), 729 close(Out)), 730 at_halt(catch(delete_file(File), _, true)). 731write_pid(_).
739switch_user(Options) :- 740 option(user(User), Options), 741 !, 742 verify_root(switch_user(User)), 743 ( option(group(Group), Options) 744 -> set_user_and_group(User, Group) 745 ; set_user_and_group(User) 746 ), 747 prctl(set_dumpable(true)). % re-enable core dumps on Linux 748switch_user(_Options) :- 749 verify_no_root.
756can_switch_user(Options) :- 757 option(user(User), Options), 758 !, 759 verify_root(switch_user(User)). 760can_switch_user(_Options) :- 761 verify_no_root. 762 763verify_root(_Task) :- 764 geteuid(0), 765 !. 766verify_root(Task) :- 767 print_message(error, http_daemon(no_root(Task))), 768 halt(1). 769 770verify_no_root :- 771 geteuid(0), 772 !, 773 throw(error(permission_error(open, server, http), 774 context('Refusing to run HTTP server as root', _))). 775verify_no_root. 776 777:- if(\+current_predicate(prctl/1)). 778prctl(_). 779:- endif.
true
--redirect
. Redirects to
an HTTPS server in the same Prolog process.--http --redirect=https://myhost.org --https
801server_redirect(Port, Request) :- 802 integer(Port), 803 http_server_property(Port, scheme(Scheme)), 804 http_public_host(Request, Host, _Port, []), 805 memberchk(request_uri(Location), Request), 806 ( default_port(Scheme, Port) 807 -> format(string(To), '~w://~w~w', [Scheme, Host, Location]) 808 ; format(string(To), '~w://~w:~w~w', [Scheme, Host, Port, Location]) 809 ), 810 throw(http_reply(moved_temporary(To))). 811server_redirect(true, Request) :- 812 !, 813 http_server_property(P, scheme(https)), 814 server_redirect(P, Request). 815server_redirect(URI, Request) :- 816 memberchk(request_uri(Location), Request), 817 atom_concat(URI, Location, To), 818 throw(http_reply(moved_temporary(To))). 819 820default_port(http, 80). 821default_port(https, 443).
--debug
option may be used
multiple times.829setup_debug(Options) :- 830 setup_trace(Options), 831 nodebug(_), 832 debug(daemon), 833 enable_debug(Options). 834 835enable_debug([]). 836enable_debug([debug(Topic)|T]) :- 837 !, 838 atom_to_term(Topic, Term, _), 839 debug(Term), 840 enable_debug(T). 841enable_debug([_|T]) :- 842 enable_debug(T). 843 844setup_trace(Options) :- 845 option(gtrace(true), Options), 846 !, 847 gtrace. 848setup_trace(_).
855kill_x11(Options) :- 856 getenv('DISPLAY', Display), 857 Display \== '', 858 option(interactive(false), Options, false), 859 !, 860 setenv('DISPLAY', ''), 861 set_prolog_flag(gui, false). 862kill_x11(_).
871setup_signals(Options) :- 872 option(interactive(true), Options, false), 873 !. 874setup_signals(Options) :- 875 on_signal(int, _, quit), 876 on_signal(term, _, quit), 877 option(sighup(Action), Options, reload), 878 must_be(oneof([reload,quit]), Action), 879 on_signal(usr1, _, logrotate), 880 on_signal(hup, _, Action). 881 882:- public 883 quit/1, 884 reload/1, 885 logrotate/1. 886 887quit(Signal) :- 888 debug(daemon, 'Dying on signal ~w', [Signal]), 889 thread_send_message(main, quit(Signal)). 890 891reload(Signal) :- 892 debug(daemon, 'Reload on signal ~w', [Signal]), 893 thread_send_message(main, reload). 894 895logrotate(Signal) :- 896 debug(daemon, 'Closing log files on signal ~w', [Signal]), 897 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.908wait(Options) :- 909 option(interactive(true), Options, false), 910 !, 911 enable_development_system. 912wait(Options) :- 913 thread_self(Me), 914 option(maintenance_interval(Interval), Options, 300), 915 Interval > 0, 916 !, 917 first_deadline(Interval, FirstDeadline), 918 State = deadline(0), 919 repeat, 920 State = deadline(Count), 921 Deadline is FirstDeadline+Count*Interval, 922 ( thread_idle(thread_get_message(Me, Msg, [deadline(Deadline)]), 923 long) 924 -> catch(ignore(handle_message(Msg)), E, 925 print_message(error, E)), 926 Msg = quit(Signal), 927 catch(broadcast(http(shutdown)), E, 928 print_message(error, E)), 929 halt(Signal) 930 ; Count1 is Count + 1, 931 nb_setarg(1, State, Count1), 932 catch(broadcast(maintenance(Interval, Deadline)), E, 933 print_message(error, E)), 934 fail 935 ). 936wait(_) :- 937 thread_self(Me), 938 repeat, 939 thread_idle(thread_get_message(Me, Msg), long), 940 catch(ignore(handle_message(Msg)), E, 941 print_message(error, E)), 942 Msg == quit, 943 !, 944 halt(0). 945 946handle_message(reload) :- 947 make, 948 broadcast(logrotate). 949handle_message(logrotate) :- 950 broadcast(logrotate). 951 952first_deadline(Interval, Deadline) :- 953 get_time(Now), 954 Deadline is ((integer(Now) + Interval - 1)//Interval)*Interval. 955 956 957 /******************************* 958 * HOOKS * 959 *******************************/
http_server(Handler, Options)
. The default is
provided by start_server/1.978 /******************************* 979 * MESSAGES * 980 *******************************/ 981 982:- multifile 983 prolog:message//1. 984 985prologmessage(http_daemon(no_root(switch_user(User)))) --> 986 [ 'Program must be started as root to use --user=~w.'-[User] ]. 987prologmessage(http_daemon(no_root(open_port(Port)))) --> 988 [ '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: