1/*  Part of SWI-Prolog
    2
    3    WWW:           http://www.swi-prolog.org
    4    Copyright (c)  2021, SWI-Prolog Solutions b.v.
    5    All rights reserved.
    6
    7    Redistribution and use in source and binary forms, with or without
    8    modification, are permitted provided that the following conditions
    9    are met:
   10
   11    1. Redistributions of source code must retain the above copyright
   12       notice, this list of conditions and the following disclaimer.
   13
   14    2. Redistributions in binary form must reproduce the above copyright
   15       notice, this list of conditions and the following disclaimer in
   16       the documentation and/or other materials provided with the
   17       distribution.
   18
   19    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   20    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   21    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   22    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   23    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   24    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   25    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   26    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   27    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   28    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   29    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   30    POSSIBILITY OF SUCH DAMAGE.
   31*/
   32
   33:- module(sicstus4_sockets,
   34	  [ socket_client_open/3,
   35	    socket_server_open/2,
   36	    socket_server_open/3,
   37	    socket_server_accept/4,
   38	    socket_server_close/1,
   39	    socket_select/7,
   40	    current_host/1
   41	  ]).   42
   43:- reexport('../sicstus/sockets',
   44	    [ current_host/1
   45	    ]).   46
   47:- use_module(library(lists)).   48:- use_module(library(socket), [tcp_connect/3]).   49
   50:- multifile sicstus4:rename_module/2.   51
   52sicstus4:rename_module(sockets, sicstus4_sockets).

   63sicstus_address_to_swi(Address, Address) :- var(Address), !.
   64sicstus_address_to_swi(inet(Nodename, Servname), SwiAddress) :- !,
   65	sicstus_address_to_swi(Nodename:Servname, SwiAddress).
   66sicstus_address_to_swi('':Servname, Servname) :- !.
   67sicstus_address_to_swi(Address, Address).
   68
   69% The following options are not supported yet:
   70% * eof_action(Action)
   71% * eol(Eol)
   72sicstus_parse_stream_options(Options, [type(Type), encoding(Encoding)]) :-
   73	(   selectchk(type(Type), Options, Options1)
   74	->  true
   75	;   Type = text,
   76	    Options1 = Options
   77	),
   78	(   selectchk(encoding(Encoding), Options1, Options2)
   79	->  true
   80	;   Encoding = iso_latin_1,
   81	    Options2 = Options1
   82	),
   83	% Check that no unsupported options were passed
   84	Options2 == [].
   85
   86sicstus_apply_stream_options(Stream, ParsedOptions) :-
   87	maplist(set_stream(Stream), ParsedOptions).
   88
   89socket_client_open(Addr, Stream, Options) :-
   90	sicstus_address_to_swi(Addr, SwiAddr),
   91	sicstus_parse_stream_options(Options, ParsedOptions),
   92	tcp_connect(SwiAddr, Stream, []),
   93	sicstus_apply_stream_options(Stream, ParsedOptions).
   94
   95sicstus_address_handle_loopback(Address, false, Address) :- !.
   96sicstus_address_handle_loopback(Servname, true, localhost:Servname) :- var(Servname), !.
   97sicstus_address_handle_loopback(_Nodename:Servname, true, localhost:Servname) :- !.
   98sicstus_address_handle_loopback(Servname, true, localhost:Servname) :- !.
   99
  100sicstus_server_address_to_swi(Address, Loopback, SwiAddress) :-
  101	sicstus_address_to_swi(Address, TempAddress),
  102	sicstus_address_handle_loopback(TempAddress, Loopback, SwiAddress).
  103
  104% The following options are not supported yet:
  105% * numeric_nodename(Bool)
  106% * numeric_servname(Bool)
  107socket_server_open(Addr, ServerSocket) :- socket_server_open(Addr, ServerSocket, []).
  108socket_server_open(Addr, ServerSocket, Options) :-
  109	(   selectchk(reuseaddr(ReuseAddr), Options, Options1)
  110	->  (ReuseAddr == true ; ReuseAddr == false)
  111	;   ReuseAddr = false,
  112	    Options1 = Options
  113	),
  114	(   selectchk(loopback(Loopback), Options1, Options2)
  115	->  (Loopback == true ; Loopback == false)
  116	;   Loopback = false,
  117	    Options2 = Options1
  118	),
  119	sicstus_server_address_to_swi(Addr, Loopback, SwiAddr),
  120	% Check that no unsupported options were passed
  121	Options2 == [],
  122	tcp_socket(SocketId),
  123	(   ReuseAddr == true
  124	->  tcp_setopt(SocketId, reuseaddr)
  125	;   true
  126	),
  127	tcp_bind(SocketId, SwiAddr),
  128	tcp_listen(SocketId, 5),
  129	tcp_open_socket(SocketId, ServerSocket).
  130
  131socket_server_accept(ServerSocket, Client, Stream, StreamOptions) :-
  132	sicstus_parse_stream_options(StreamOptions, ParsedStreamOptions),
  133	tcp_accept(ServerSocket, ClientSocket, Client),
  134	tcp_open_socket(ClientSocket, Stream),
  135	sicstus_apply_stream_options(Stream, ParsedStreamOptions).
  136
  137socket_server_close(ServerSocket) :- close(ServerSocket).
  138
  139sicstus_timeout_to_swi(off, infinite).
  140sicstus_timeout_to_swi(Seconds:Microseconds, N) :-
  141	number(Seconds),
  142	number(Microseconds),
  143	N is Seconds + Microseconds / 1000000,
  144	N > 0.
  145sicstus_timeout_to_swi(N, N) :-
  146	number(N),
  147	N > 0.
  148
  149:- use_module(library(lists), [list_to_set/2, intersection/3]).  150% On SICStus, the input lists can contain not just streams/sockets,
  151% but also pairs of the form Identifier-Stream, where Identifier may be
  152% an arbitrary term. If a stream from such a pair is ready, the entire
  153% pair is returned in the corresponding ready list(s). This allows the
  154% calling code to tell apart different ready streams more easily.
  155% This emulation currently does *not* support this feature
  156% and only accepts and returns bare streams.
  157socket_select(ServerSockets, SReady, ReadStreams, RReady, WriteStreams, WReady, Timeout) :-
  158	sicstus_timeout_to_swi(Timeout, SwiTimeout),
  159	append([ServerSockets, ReadStreams, WriteStreams], AllStreamsDup),
  160	list_to_set(AllStreamsDup, AllStreams),
  161	wait_for_input(AllStreams, ReadyList, SwiTimeout),
  162	intersection(ServerSockets, ReadyList, SReady),
  163	intersection(ReadStreams, ReadyList, RReady),
  164	intersection(WriteStreams, ReadyList, WReady)