37
38:- module(http_unix_daemon,
39 [ http_daemon/0,
40 http_daemon/1, 41 http_opt_type/3, 42 http_opt_help/2, 43 http_opt_meta/2 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, 69 http_certificate_hook/3, 70 http:sni_options/2. 71
72:- initialization(http_daemon, main). 73
160
161:- debug(daemon). 162
166
167:- set_prolog_flag(xpce_threaded, false). 168:- set_prolog_flag(message_ide, false). 169:- set_prolog_flag(message_context, [thread,time('%F %T.%3f')]). 170:- dynamic interactive/0. 171
306
307http_daemon :-
308 current_prolog_flag(argv, Argv),
309 argv_options(Argv, _RestArgv, Options),
310 http_daemon(Options).
311
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').
377
383
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).
393
394
404
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).
415
420
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 ).
447
457
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)).
579
587
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(_, '').
603
622
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).
665
669
670disable_development_system :-
671 set_prolog_flag(editor, '/bin/false').
672
678
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).
688
692
693setup_syslog(Options) :-
694 option(syslog(Ident), Options),
695 !,
696 openlog(Ident, [pid], user).
697setup_syslog(_).
698
699
705
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).
715
716
721
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(_).
732
733
738
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)). 748switch_user(_Options) :-
749 verify_no_root.
750
755
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. 780
800
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).
822
823
828
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(_).
849
850
854
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(_).
863
864
870
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).
898
907
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 960
966
967
976
977
978 981
982:- multifile
983 prolog:message//1. 984
985prolog:message(http_daemon(no_root(switch_user(User)))) -->
986 [ 'Program must be started as root to use --user=~w.'-[User] ].
987prolog:message(http_daemon(no_root(open_port(Port)))) -->
988 [ 'Cannot open port ~w. Only root can open ports below 1000.'-[Port] ]