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 Error = error(_,_), 407 catch(http_daemon_guarded(Options), Error, start_failed(Error)). 408 409start_failed(Error) :- 410 interactive, 411 !, 412 print_message(warning, Error). 413start_failed(Error) :- 414 print_message(error, Error), 415 halt(1).
422http_daemon_guarded(Options) :-
423 setup_debug(Options),
424 kill_x11(Options),
425 option_servers(Options, Servers0),
426 maplist(make_socket, Servers0, Servers),
427 ( option(fork(true), Options, true),
428 option(interactive(false), Options, false),
429 can_switch_user(Options)
430 -> fork(Who),
431 ( Who \== child
432 -> halt
433 ; disable_development_system,
434 setup_syslog(Options),
435 write_pid(Options),
436 setup_output(Options),
437 switch_user(Options),
438 setup_signals(Options),
439 start_servers(Servers),
440 wait(Options)
441 )
442 ; write_pid(Options),
443 switch_user(Options),
444 setup_signals(Options),
445 start_servers(Servers),
446 wait(Options)
447 ).
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.459option_servers(Options, Sockets) :- 460 opt_sockets(Options, [], [], Sockets). 461 462opt_sockets([], Options, [], [Socket]) :- 463 !, 464 make_server(http(true), Options, Socket). 465opt_sockets([], _, Sockets, Sockets). 466opt_sockets([H|T], OptsH, Sockets0, Sockets) :- 467 server_option(H), 468 !, 469 append(OptsH, [H], OptsH1), 470 opt_sockets(T, OptsH1, Sockets0, Sockets). 471opt_sockets([H|T0], Opts, Sockets0, Sockets) :- 472 server_start_option(H), 473 !, 474 server_options(T0, T, Opts, SOpts), 475 make_server(H, SOpts, Socket), 476 append(Sockets0, [Socket], Sockets1), 477 opt_sockets(T, Opts, Sockets1, Sockets). 478opt_sockets([_|T], Opts, Sockets0, Sockets) :- 479 opt_sockets(T, Opts, Sockets0, Sockets). 480 481server_options([], [], Options, Options). 482server_options([H|T], Rest, Options0, Options) :- 483 server_option(H), 484 !, 485 generalise_option(H, G), 486 delete(Options0, G, Options1), 487 append(Options1, [H], Options2), 488 server_options(T, Rest, Options2, Options). 489server_options([H|T], [H|T], Options, Options) :- 490 server_start_option(H), 491 !. 492server_options([_|T0], Rest, Options0, Options) :- 493 server_options(T0, Rest, Options0, Options). 494 495generalise_option(H, G) :- 496 H =.. [Name,_], 497 G =.. [Name,_]. 498 499server_start_option(http(_)). 500server_start_option(https(_)). 501 502server_option(port(_)). 503server_option(ip(_)). 504server_option(certfile(_)). 505server_option(keyfile(_)). 506server_option(pwfile(_)). 507server_option(password(_)). 508server_option(cipherlist(_)). 509server_option(workers(_)). 510server_option(redirect(_)). 511server_option(timeout(_)). 512server_option(keep_alive_timeout(_)). 513 514make_server(http(Address0), Options0, server(http, Address, Options)) :- 515 make_address(Address0, 80, Address, Options0, Options). 516make_server(https(Address0), Options0, server(https, Address, SSLOptions)) :- 517 make_address(Address0, 443, Address, Options0, Options), 518 merge_https_options(Options, SSLOptions). 519 520make_address(true, DefPort, Address, Options0, Options) :- 521 !, 522 option(port(Port), Options0, DefPort), 523 ( option(ip(Bind), Options0) 524 -> Address = (Bind:Port) 525 ; Address = Port 526 ), 527 merge_options([port(Port)], Options0, Options). 528make_address(Bind:Port, _, Bind:Port, Options0, Options) :- 529 !, 530 must_be(atom, Bind), 531 must_be(integer, Port), 532 merge_options([port(Port), ip(Bind)], Options0, Options). 533make_address(Port, _, Address, Options0, Options) :- 534 integer(Port), 535 !, 536 ( option(ip(Bind), Options0) 537 -> Address = (Bind:Port) 538 ; Address = Port, 539 merge_options([port(Port)], Options0, Options) 540 ). 541make_address(Spec, _, Address, Options0, Options) :- 542 atomic(Spec), 543 split_string(Spec, ":", "", [BindString, PortString]), 544 number_string(Port, PortString), 545 !, 546 atom_string(Bind, BindString), 547 Address = (Bind:Port), 548 merge_options([port(Port), ip(Bind)], Options0, Options). 549make_address(Spec, _, _, _, _) :- 550 domain_error(address, Spec). 551 552:- dynamic sni/3. 553 554merge_https_options(Options, [SSL|Options]) :- 555 ( option(certfile(CertFile), Options), 556 option(keyfile(KeyFile), Options) 557 -> prepare_https_certificate(CertFile, KeyFile, Passwd0), 558 read_file_to_string(CertFile, Certificate, []), 559 read_file_to_string(KeyFile, Key, []), 560 Pairs = [Certificate-Key] 561 ; Pairs = [] 562 ), 563 ssl_secure_ciphers(SecureCiphers), 564 option(cipherlist(CipherList), Options, SecureCiphers), 565 ( string(Passwd0) 566 -> Passwd = Passwd0 567 ; options_password(Options, Passwd) 568 ), 569 findall(HostName-HostOptions, http:sni_options(HostName, HostOptions), SNIs), 570 maplist(sni_contexts, SNIs), 571 SSL = ssl([ certificate_key_pairs(Pairs), 572 cipher_list(CipherList), 573 password(Passwd), 574 sni_hook(http_unix_daemon:sni) 575 ]). 576 577sni_contexts(Host-Options) :- 578 ssl_context(server, SSL, Options), 579 assertz(sni(_, Host, SSL)).
589prepare_https_certificate(CertFile, KeyFile, Password) :- 590 http_certificate_hook(CertFile, KeyFile, Password), 591 !. 592prepare_https_certificate(_, _, _). 593 594 595options_password(Options, Passwd) :- 596 option(password(Passwd), Options), 597 !. 598options_password(Options, Passwd) :- 599 option(pwfile(File), Options), 600 !, 601 read_file_to_string(File, String, []), 602 split_string(String, "", "\r\n\t ", [Passwd]). 603options_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
624start_servers(Servers) :- 625 broadcast(http(pre_server_start)), 626 maplist(start_server, Servers), 627 broadcast(http(post_server_start)). 628 629start_server(server(_Scheme, Socket, Options)) :- 630 option(redirect(To), Options), 631 !, 632 http_server(server_redirect(To), [tcp_socket(Socket)|Options]). 633start_server(server(_Scheme, Socket, Options)) :- 634 http_server_hook([tcp_socket(Socket)|Options]), 635 !. 636start_server(server(_Scheme, Socket, Options)) :- 637 option(port(Port), Options), 638 broadcast(http(pre_server_start(Port))), 639 http_server(http_dispatch, [tcp_socket(Socket)|Options]), 640 broadcast(http(post_server_start(Port))). 641 642make_socket(server(Scheme, Address, Options), 643 server(Scheme, Socket, Options)) :- 644 tcp_socket(Socket), 645 catch(bind_socket(Socket, Address), Error, 646 make_socket_error(Error, Address)), 647 debug(daemon(socket), 648 'Created socket ~p, listening on ~p', [Socket, Address]). 649 650bind_socket(Socket, Address) :- 651 tcp_setopt(Socket, reuseaddr), 652 tcp_bind(Socket, Address), 653 tcp_listen(Socket, 5). 654 655make_socket_error(error(socket_error(_,_), _), Address) :- 656 address_port(Address, Port), 657 integer(Port), 658 Port =< 1000, 659 !, 660 verify_root(open_port(Port)). 661make_socket_error(Error, _) :- 662 throw(Error). 663 664address_port(_:Port, Port) :- !. 665address_port(Port, Port).
671disable_development_system :-
672 set_prolog_flag(editor, '/bin/false').
680enable_development_system :-
681 assertz(interactive),
682 set_prolog_flag(xpce_threaded, true),
683 set_prolog_flag(message_ide, true),
684 ( current_prolog_flag(xpce_version, _)
685 -> call(pce_dispatch([]))
686 ; true
687 ),
688 set_prolog_flag(toplevel_goal, prolog).
694setup_syslog(Options) :- 695 option(syslog(Ident), Options), 696 !, 697 openlog(Ident, [pid], user). 698setup_syslog(_).
output(File)
, all output is written to File.707setup_output(Options) :- 708 option(output(File), Options), 709 !, 710 open(File, write, Out, [encoding(utf8)]), 711 set_stream(Out, buffer(line)), 712 detach_IO(Out). 713setup_output(_) :- 714 open_null_stream(Out), 715 detach_IO(Out).
pidfile(File)
is present, write the PID of the
daemon to this file.723write_pid(Options) :- 724 option(pidfile(File), Options), 725 current_prolog_flag(pid, PID), 726 !, 727 setup_call_cleanup( 728 open(File, write, Out), 729 format(Out, '~d~n', [PID]), 730 close(Out)), 731 at_halt(catch(delete_file(File), _, true)). 732write_pid(_).
740switch_user(Options) :- 741 option(user(User), Options), 742 !, 743 verify_root(switch_user(User)), 744 ( option(group(Group), Options) 745 -> set_user_and_group(User, Group) 746 ; set_user_and_group(User) 747 ), 748 prctl(set_dumpable(true)). % re-enable core dumps on Linux 749switch_user(_Options) :- 750 verify_no_root.
757can_switch_user(Options) :- 758 option(user(User), Options), 759 !, 760 verify_root(switch_user(User)). 761can_switch_user(_Options) :- 762 verify_no_root. 763 764verify_root(_Task) :- 765 geteuid(0), 766 !. 767verify_root(Task) :- 768 print_message(error, http_daemon(no_root(Task))), 769 halt(1). 770 771verify_no_root :- 772 geteuid(0), 773 !, 774 throw(error(permission_error(open, server, http), 775 context('Refusing to run HTTP server as root', _))). 776verify_no_root. 777 778:- if(\+current_predicate(prctl/1)). 779prctl(_). 780:- endif.
true
--redirect
. Redirects to
an HTTPS server in the same Prolog process.--http --redirect=https://myhost.org --https
802server_redirect(Port, Request) :- 803 integer(Port), 804 http_server_property(Port, scheme(Scheme)), 805 http_public_host(Request, Host, _Port, []), 806 memberchk(request_uri(Location), Request), 807 ( default_port(Scheme, Port) 808 -> format(string(To), '~w://~w~w', [Scheme, Host, Location]) 809 ; format(string(To), '~w://~w:~w~w', [Scheme, Host, Port, Location]) 810 ), 811 throw(http_reply(moved_temporary(To))). 812server_redirect(true, Request) :- 813 !, 814 http_server_property(P, scheme(https)), 815 server_redirect(P, Request). 816server_redirect(URI, Request) :- 817 memberchk(request_uri(Location), Request), 818 atom_concat(URI, Location, To), 819 throw(http_reply(moved_temporary(To))). 820 821default_port(http, 80). 822default_port(https, 443).
--debug
option may be used
multiple times.830setup_debug(Options) :- 831 setup_trace(Options), 832 nodebug(_), 833 debug(daemon), 834 enable_debug(Options). 835 836enable_debug([]). 837enable_debug([debug(Topic)|T]) :- 838 !, 839 atom_to_term(Topic, Term, _), 840 debug(Term), 841 enable_debug(T). 842enable_debug([_|T]) :- 843 enable_debug(T). 844 845setup_trace(Options) :- 846 option(gtrace(true), Options), 847 !, 848 gtrace. 849setup_trace(_).
856kill_x11(Options) :- 857 getenv('DISPLAY', Display), 858 Display \== '', 859 option(interactive(false), Options, false), 860 !, 861 setenv('DISPLAY', ''), 862 set_prolog_flag(gui, false). 863kill_x11(_).
872setup_signals(Options) :- 873 option(interactive(true), Options, false), 874 !. 875setup_signals(Options) :- 876 on_signal(int, _, quit), 877 on_signal(term, _, quit), 878 option(sighup(Action), Options, reload), 879 must_be(oneof([reload,quit]), Action), 880 on_signal(usr1, _, logrotate), 881 on_signal(hup, _, Action). 882 883:- public 884 quit/1, 885 reload/1, 886 logrotate/1. 887 888quit(Signal) :- 889 debug(daemon, 'Dying on signal ~w', [Signal]), 890 thread_send_message(main, quit(Signal)). 891 892reload(Signal) :- 893 debug(daemon, 'Reload on signal ~w', [Signal]), 894 thread_send_message(main, reload). 895 896logrotate(Signal) :- 897 debug(daemon, 'Closing log files on signal ~w', [Signal]), 898 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.909wait(Options) :- 910 option(interactive(true), Options, false), 911 !, 912 enable_development_system. 913wait(Options) :- 914 thread_self(Me), 915 option(maintenance_interval(Interval), Options, 300), 916 Interval > 0, 917 !, 918 first_deadline(Interval, FirstDeadline), 919 State = deadline(0), 920 repeat, 921 State = deadline(Count), 922 Deadline is FirstDeadline+Count*Interval, 923 ( thread_idle(thread_get_message(Me, Msg, [deadline(Deadline)]), 924 long) 925 -> catch(ignore(handle_message(Msg)), E, 926 print_message(error, E)), 927 Msg = quit(Signal), 928 catch(broadcast(http(shutdown)), E, 929 print_message(error, E)), 930 halt(Signal) 931 ; Count1 is Count + 1, 932 nb_setarg(1, State, Count1), 933 catch(broadcast(maintenance(Interval, Deadline)), E, 934 print_message(error, E)), 935 fail 936 ). 937wait(_) :- 938 thread_self(Me), 939 repeat, 940 thread_idle(thread_get_message(Me, Msg), long), 941 catch(ignore(handle_message(Msg)), E, 942 print_message(error, E)), 943 Msg == quit, 944 !, 945 halt(0). 946 947handle_message(reload) :- 948 make, 949 broadcast(logrotate). 950handle_message(logrotate) :- 951 broadcast(logrotate). 952 953first_deadline(Interval, Deadline) :- 954 get_time(Now), 955 Deadline is ((integer(Now) + Interval - 1)//Interval)*Interval. 956 957 958 /******************************* 959 * HOOKS * 960 *******************************/
http_server(Handler, Options)
. The default is
provided by start_server/1.979 /******************************* 980 * MESSAGES * 981 *******************************/ 982 983:- multifile 984 prolog:message//1. 985 986prologmessage(http_daemon(no_root(switch_user(User)))) --> 987 [ 'Program must be started as root to use --user=~w.'-[User] ]. 988prologmessage(http_daemon(no_root(open_port(Port)))) --> 989 [ '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: