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-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(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 ip_name/2 52 ]).
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 ?-
91prolog_server(Port, Options) :- 92 tcp_socket(ServerSocket), 93 tcp_setopt(ServerSocket, reuseaddr), 94 tcp_bind(ServerSocket, Port), 95 tcp_listen(ServerSocket, 5), 96 thread_create(server_loop(ServerSocket, Options), _, 97 [ alias(prolog_server) 98 ]). 99 100server_loop(ServerSocket, Options) :- 101 tcp_accept(ServerSocket, Slave, Peer), 102 tcp_open_socket(Slave, InStream, OutStream), 103 set_stream(InStream, close_on_abort(false)), 104 set_stream(OutStream, close_on_abort(false)), 105 catch(tcp_host_to_address(Host, Peer), 106 error(socket_error(_,_),_), 107 ip_name(Peer, Host)), 108 ( Postfix = [] 109 ; between(2, 1000, Num), 110 Postfix = [-, Num] 111 ), 112 atomic_list_concat(['client@', Host | Postfix], Alias), 113 catch(thread_create( 114 service_client(InStream, OutStream, Peer, Options), 115 _, 116 [ alias(Alias), 117 detached(true) 118 ]), 119 error(permission_error(create, thread, Alias), _), 120 fail), 121 !, 122 server_loop(ServerSocket, Options). 123 124service_client(InStream, OutStream, Peer, Options) :- 125 allow(Peer, Options), 126 !, 127 thread_self(Id), 128 set_prolog_IO(InStream, OutStream, OutStream), 129 set_stream(InStream, tty(true)), 130 set_prolog_flag(tty_control, false), 131 current_prolog_flag(encoding, Enc), 132 set_stream(user_input, encoding(Enc)), 133 set_stream(user_output, encoding(Enc)), 134 set_stream(user_error, encoding(Enc)), 135 set_stream(user_input, newline(detect)), 136 set_stream(user_output, newline(dos)), 137 set_stream(user_error, newline(dos)), 138 format(user_error, 139 'Welcome to the SWI-Prolog server on thread ~w~n~n', 140 [Id]), 141 call_cleanup(prolog, 142 ( close(InStream, [force(true)]), 143 close(OutStream, [force(true)]))). 144service_client(InStream, OutStream, _, _):- 145 thread_self(Id), 146 format(OutStream, 'Go away!!~n', []), 147 close(InStream), 148 close(OutStream), 149 thread_detach(Id). 150 151 152allow(Peer, Options) :- 153 ( member(allow(Allow), Options) 154 *-> Peer = Allow, 155 ! 156 ; Peer = ip(127,0,0,1) 157 )