1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker & Steve Prior 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2004-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(prolog_server, 39 [ prolog_server/2 % +Port, +Options 40 ]). 41 42:- autoload(library(lists),[member/2]). 43:- autoload(library(socket), 44 [ tcp_socket/1, 45 tcp_setopt/2, 46 tcp_bind/2, 47 tcp_listen/2, 48 tcp_accept/3, 49 tcp_open_socket/3, 50 tcp_host_to_address/2 51 ]).
Currently defined options are:
ip(A,B,C,D)
.
Multiple of such terms can exist and access is granted
if the peer IP address unifies to one of them. If no
allow option is provided access is only granted from
ip(127,0,0,1)
(localhost).For example:
?- prolog_server(4000, []). % netcat -N localhost 4000 Welcome to the SWI-Prolog server on thread 3 1 ?-
90prolog_server(Port, Options) :- 91 tcp_socket(ServerSocket), 92 tcp_setopt(ServerSocket, reuseaddr), 93 tcp_bind(ServerSocket, Port), 94 tcp_listen(ServerSocket, 5), 95 thread_create(server_loop(ServerSocket, Options), _, 96 [ alias(prolog_server) 97 ]). 98 99server_loop(ServerSocket, Options) :- 100 tcp_accept(ServerSocket, Slave, Peer), 101 tcp_open_socket(Slave, InStream, OutStream), 102 set_stream(InStream, close_on_abort(false)), 103 set_stream(OutStream, close_on_abort(false)), 104 tcp_host_to_address(Host, Peer), 105 ( Postfix = [] 106 ; between(2, 1000, Num), 107 Postfix = [-, Num] 108 ), 109 atomic_list_concat(['client@', Host | Postfix], Alias), 110 catch(thread_create( 111 service_client(InStream, OutStream, Peer, Options), 112 _, 113 [ alias(Alias), 114 detached(true) 115 ]), 116 error(permission_error(create, thread, Alias), _), 117 fail), 118 !, 119 server_loop(ServerSocket, Options). 120 121service_client(InStream, OutStream, Peer, Options) :- 122 allow(Peer, Options), 123 !, 124 thread_self(Id), 125 set_prolog_IO(InStream, OutStream, OutStream), 126 set_stream(InStream, tty(true)), 127 set_prolog_flag(tty_control, false), 128 current_prolog_flag(encoding, Enc), 129 set_stream(user_input, encoding(Enc)), 130 set_stream(user_output, encoding(Enc)), 131 set_stream(user_error, encoding(Enc)), 132 set_stream(user_input, newline(detect)), 133 set_stream(user_output, newline(dos)), 134 set_stream(user_error, newline(dos)), 135 format(user_error, 136 'Welcome to the SWI-Prolog server on thread ~w~n~n', 137 [Id]), 138 call_cleanup(prolog, 139 ( close(InStream, [force(true)]), 140 close(OutStream, [force(true)]))). 141service_client(InStream, OutStream, _, _):- 142 thread_self(Id), 143 format(OutStream, 'Go away!!~n', []), 144 close(InStream), 145 close(OutStream), 146 thread_detach(Id). 147 148 149allow(Peer, Options) :- 150 ( member(allow(Allow), Options) 151 *-> Peer = Allow, 152 ! 153 ; Peer = ip(127,0,0,1) 154 )