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) 2000-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(socket, 39 [ socket_create/2, % -Socket, +Options 40 tcp_socket/1, % -Socket 41 tcp_close_socket/1, % +Socket 42 tcp_open_socket/3, % +Socket, -Read, -Write 43 tcp_connect/2, % +Socket, +Address 44 tcp_connect/3, % +Address, -StreamPair, +Options 45 tcp_connect/4, % +Socket, +Address, -Read, -Write) 46 tcp_bind/2, % +Socket, +Address 47 tcp_accept/3, % +Master, -Slave, -PeerName 48 tcp_listen/2, % +Socket, +BackLog 49 tcp_fcntl/3, % +Socket, +Command, ?Arg 50 tcp_setopt/2, % +Socket, +Option 51 tcp_getopt/2, % +Socket, ?Option 52 host_address/3, % ?HostName, ?Address, +Options 53 tcp_host_to_address/2, % ?HostName, ?Ip-nr 54 tcp_select/3, % +Inputs, -Ready, +Timeout 55 gethostname/1, % -HostName 56 57 ip_name/2, % ?Ip, ?Name 58 59 tcp_open_socket/2, % +Socket, -StreamPair 60 61 udp_socket/1, % -Socket 62 udp_receive/4, % +Socket, -Data, -Sender, +Options 63 udp_send/4, % +Socket, +Data, +Sender, +Options 64 65 negotiate_socks_connection/2% +DesiredEndpoint, +StreamPair 66 ]). 67:- use_module(library(debug), [assertion/1, debug/3]). 68:- autoload(library(lists), [last/2, member/2, append/3, append/2]). 69:- autoload(library(apply), [maplist/3, maplist/2]). 70:- autoload(library(error), 71 [instantiation_error/1, syntax_error/1, must_be/2, domain_error/2]). 72:- autoload(library(option), [option/2, option/3]). 73 74:- multifile 75 rewrite_host/3. % +HostIn, -Host, +Socket 76 77/** <module> Network socket (TCP and UDP) library 78 79The library(socket) provides TCP and UDP inet-domain sockets from 80SWI-Prolog, both client and server-side communication. The interface of 81this library is very close to the Unix socket interface, also supported 82by the MS-Windows _winsock_ API. SWI-Prolog applications that wish to 83communicate with multiple sources have two options: 84 85 - Use I/O multiplexing based on wait_for_input/3. On Windows 86 systems this can only be used for sockets, not for general 87 (device-) file handles. 88 - Use multiple threads, handling either a single blocking socket 89 or a pool using I/O multiplexing as above. 90 91## Client applications {#socket-server} 92 93Using this library to establish a TCP connection to a server is as 94simple as opening a file. See also http_open/3. 95 96== 97dump_swi_homepage :- 98 setup_call_cleanup( 99 tcp_connect('www.swi-prolog.org':http, Stream, []), 100 ( format(Stream, 101 'GET / HTTP/1.1~n\c 102 Host: www.swi-prolog.org~n\c 103 Connection: close~n~n', []), 104 flush_output(Stream), 105 copy_stream_data(Stream, current_output) 106 ), 107 close(Stream)). 108== 109 110To deal with timeouts and multiple connections, threads, 111wait_for_input/3 and/or non-blocking streams (see tcp_fcntl/3) can be 112used. 113 114## Server applications {#socket-client} 115 116The typical sequence for generating a server application is given below. 117To close the server, use close/1 on `AcceptFd`. 118 119 == 120 create_server(Port) :- 121 tcp_socket(Socket), 122 tcp_bind(Socket, Port), 123 tcp_listen(Socket, 5), 124 tcp_open_socket(Socket, AcceptFd, _), 125 <dispatch> 126 == 127 128There are various options for <dispatch>. The most commonly used option 129is to start a Prolog thread to handle the connection. Alternatively, 130input from multiple clients can be handled in a single thread by 131listening to these clients using wait_for_input/3. Finally, on Unix 132systems, we can use fork/1 to handle the connection in a new process. 133Note that fork/1 and threads do not cooperate well. Combinations can be 134realised but require good understanding of POSIX thread and 135fork-semantics. 136 137Below is the typical example using a thread. Note the use of 138setup_call_cleanup/3 to guarantee that all resources are reclaimed, also 139in case of failure or exceptions. 140 141 == 142 dispatch(AcceptFd) :- 143 tcp_accept(AcceptFd, Socket, Peer), 144 thread_create(process_client(Socket, Peer), _, 145 [ detached(true) 146 ]), 147 dispatch(AcceptFd). 148 149 process_client(Socket, Peer) :- 150 setup_call_cleanup( 151 tcp_open_socket(Socket, StreamPair), 152 handle_service(StreamPair), 153 close(StreamPair)). 154 155 handle_service(StreamPair) :- 156 ... 157 == 158 159## Socket exceptions {#socket-exceptions} 160 161Errors that are trapped by the low-level library are mapped to an 162exception of the shape below. In this term, `Code` is a lower case atom 163that corresponds to the C macro name, e.g., `epipe` for a broken pipe. 164`Message` is the human readable string for the error code returned by 165the OS or the same as `Code` if the OS does not provide this 166functionality. Note that `Code` is derived from a static set of macros 167that may or may not be defines for the target OS. If the macro name is 168not known, `Code` is =|ERROR_nnn|=, where _nnn_ is an integer. 169 170 error(socket_error(Code, Message), _) 171 172Note that on Windows `Code` is a ``wsa*`` code which makes it hard to 173write portable code that handles specific socket errors. Even on POSIX 174systems the exact set of errors produced by the network stack is not 175defined. 176 177## Socket addresses (families) {#socket-domains} 178 179The library supports both IP4 and IP6 addresses. On Unix systems it also 180supports _Unix domain sockets_ (``AF_UNIX``). The address of a Unix 181domain sockets is a file name. Unix domain sockets are created using 182socket_create/2 or unix_domain_socket/1. 183 184IP4 or IP6 sockets can be created using socket_create/2 or tcp_connect/3 185with the `inet` (default, IP3) or `inet6` domain option. Some of the 186predicates produce or consume IP addresses as a Prolog term. The format 187of this term is one of: 188 189 - ip(A,B,C,D) 190 Represents an IP4 address. Each field is an integer in the range 191 0..255 (8 bit). 192 - ip(A,B,C,D,E,F,G,H) 193 Represents an IP6 address. Each field is an integer in the range 194 0..65535 (16 bit). 195 196The predicate ip_name/2 translates between the canonical textual 197representation and the above defined address terms. 198 199## Socket predicate reference {#socket-predicates} 200*/ 201 202:- multifile 203 tcp_connect_hook/3, % +Socket, +Addr, -In, -Out 204 tcp_connect_hook/4, % +Socket, +Addr, -Stream 205 proxy_for_url/3, % +URL, +Host, -ProxyList 206 try_proxy/4. % +Proxy, +Addr, -Socket, -Stream 207 208:- predicate_options(tcp_connect/3, 3, 209 [ bypass_proxy(boolean), 210 nodelay(boolean), 211 domain(oneof([inet,inet6])) 212 ]). 213 214:- use_foreign_library(foreign(socket)). 215:- public tcp_debug/1. % set debugging. 216 217:- if(current_predicate(unix_domain_socket/1)). 218:- export(unix_domain_socket/1). % -Socket 219:- endif. 220 221%! socket_create(-SocketId, +Options) is det. 222% 223% Create a socket according to Options. Supported Options are: 224% 225% - domain(+Domain) 226% One of `inet` (default), `inet6`, `unix` or `local` (same 227% as `unix`) 228% - type(+Type) 229% One of `stream` (default) to create a TCP connection or 230% `dgram` to create a UDP socket. 231% 232% This predicate subsumes tcp_socket/1, udp_socket/1 and 233% unix_domain_socket/1. 234 235%! tcp_socket(-SocketId) is det. 236% 237% Equivalent to socket_create(SocketId, []) or, explicit, 238% socket_create(SocketId, [domain(inet), type(stream)]). 239 240%! unix_domain_socket(-SocketId) is det. 241% 242% Equivalent to socket_create(SocketId, [domain(unix)]) or, 243% explicit, socket_create(SocketId, [domain(unix), type(stream)]) 244% 245% Unix domain socket affect tcp_connect/2 (for clients) and 246% tcp_bind/2 and tcp_accept/3 (for servers). The address is an atom 247% or string that is handled as a file name. On most systems the 248% length of this file name is limited to 128 bytes (including null 249% terminator), but according to the Linux documentation (unix(7)), 250% portable applications must keep the address below 92 bytes. Note 251% that these lengths are in bytes. Non-ascii characters may be 252% represented as multiple bytes. If the length limit is exceeded a 253% representation_error(af_unix_name) exception is raised. 254 255%! tcp_close_socket(+SocketId) is det. 256% 257% Closes the indicated socket, making SocketId invalid. Normally, 258% sockets are closed by closing both stream handles returned by 259% open_socket/3. There are two cases where tcp_close_socket/1 is 260% used because there are no stream-handles: 261% 262% - If, after tcp_accept/3, the server uses fork/1 to handle the 263% client in a sub-process. In this case the accepted socket is 264% not longer needed from the main server and must be discarded 265% using tcp_close_socket/1. 266% - If, after discovering the connecting client with 267% tcp_accept/3, the server does not want to accept the 268% connection, it should discard the accepted socket 269% immediately using tcp_close_socket/1. 270 271%! tcp_open_socket(+SocketId, -StreamPair) is det. 272% 273% Create streams to communicate to SocketId. If SocketId is a 274% master socket (see tcp_bind/2), StreamPair should be used for 275% tcp_accept/3. If SocketId is a connected (see tcp_connect/2) or 276% accepted socket (see tcp_accept/3), StreamPair is unified to a 277% stream pair (see stream_pair/3) that can be used for reading and 278% writing. The stream or pair must be closed with close/1, which 279% also closes SocketId. 280 281tcp_open_socket(Socket, Stream) :- 282 tcp_open_socket(Socket, In, Out), 283 ( var(Out) 284 -> Stream = In 285 ; stream_pair(Stream, In, Out) 286 ). 287 288%! tcp_open_socket(+SocketId, -InStream, -OutStream) is det. 289% 290% Similar to tcp_open_socket/2, but creates two separate sockets 291% where tcp_open_socket/2 would have created a stream pair. 292% 293% @deprecated New code should use tcp_open_socket/2 because 294% closing a stream pair is much easier to perform safely. 295 296%! tcp_bind(SocketId, ?Address) is det. 297% 298% Bind the socket to Address on the current machine. This 299% operation, together with tcp_listen/2 and tcp_accept/3 implement 300% the _server-side_ of the socket interface. Address is either an 301% plain `Port` or a term HostPort. The first form binds the socket 302% to the given port on all interfaces, while the second only binds 303% to the matching interface. A typical example is below, causing 304% the socket to listen only on port 8080 on the local machine's 305% network. 306% 307% == 308% tcp_bind(Socket, localhost:8080) 309% == 310% 311% If `Port` is unbound, the system picks an arbitrary free port 312% and unifies `Port` with the selected port number. `Port` is 313% either an integer or the name of a registered service. See also 314% tcp_connect/4. 315 316%! tcp_listen(+SocketId, +BackLog) is det. 317% 318% Tells, after tcp_bind/2, the socket to listen for incoming 319% requests for connections. Backlog indicates how many pending 320% connection requests are allowed. Pending requests are requests 321% that are not yet acknowledged using tcp_accept/3. If the 322% indicated number is exceeded, the requesting client will be 323% signalled that the service is currently not available. A 324% commonly used default value for Backlog is 5. 325 326%! tcp_accept(+Socket, -Slave, -Peer) is det. 327% 328% This predicate waits on a server socket for a connection request by 329% a client. On success, it creates a new socket for the client and 330% binds the identifier to Slave. Peer is bound to the IP-address of 331% the client or the atom `af_unix` if Socket is an AF_UNIX socket (see 332% unix_domain_socket/1). 333 334%! tcp_connect(+SocketId, +Address) is det. 335% 336% Connect SocketId. After successful completion, tcp_open_socket/3 337% can be used to create I/O-Streams to the remote socket. This 338% predicate is part of the low level client API. A connection to a 339% particular host and port is realised using these steps: 340% 341% == 342% tcp_socket(Socket), 343% tcp_connect(Socket, Host:Port), 344% tcp_open_socket(Socket, StreamPair) 345% == 346% 347% Typical client applications should use the high level interface 348% provided by tcp_connect/3 which avoids resource leaking if a 349% step in the process fails, and can be hooked to support proxies. 350% For example: 351% 352% == 353% setup_call_cleanup( 354% tcp_connect(Host:Port, StreamPair, []), 355% talk(StreamPair), 356% close(StreamPair)) 357% == 358% 359% If SocketId is an AF_UNIX socket (see unix_domain_socket/1), Address 360% is an atom or string denoting a file name. 361 362tcp_connect(Socket, Host0:Port) => 363 ( rewrite_host(Host0, Host, Socket) 364 -> true 365 ; Host = Host0 366 ), 367 tcp_connect_(Socket, Host:Port). 368tcp_connect(Socket, Address) => 369 tcp_connect_(Socket, Address). 370 371%! rewrite_host(+HostIn, -HostOut, +Socket) is nondet. 372% 373% Allow rewriting the host for tcp_connect/2 and therefore all other 374% predicates to connect a socket. 375% 376% This hook is currently defined in Windows to map `localhost` to 377% ip(127,0,0,1) as resolving `localhost` on Windows is often very 378% slow. Note that we do not want to do that in general as a system may 379% prefer to map `localhost` to `::1`, i.e., the IPv6 loopback address. 380 381:- if(current_prolog_flag(windows, true)). 382rewrite_host(localhost, ip(127,0,0,1), _). 383:- endif. 384 385 386 /******************************* 387 * HOOKABLE CONNECT * 388 *******************************/ 389 390%! tcp_connect(+Socket, +Address, -Read, -Write) is det. 391% 392% Connect a (client) socket to Address and return a bi-directional 393% connection through the stream-handles Read and Write. This 394% predicate may be hooked by defining socket:tcp_connect_hook/4 395% with the same signature. Hooking can be used to deal with proxy 396% connections. E.g., 397% 398% == 399% :- multifile socket:tcp_connect_hook/4. 400% 401% socket:tcp_connect_hook(Socket, Address, Read, Write) :- 402% proxy(ProxyAdress), 403% tcp_connect(Socket, ProxyAdress), 404% tcp_open_socket(Socket, Read, Write), 405% proxy_connect(Address, Read, Write). 406% == 407% 408% @deprecated New code should use tcp_connect/3 called as 409% tcp_connect(+Address, -StreamPair, +Options). 410 411tcp_connect(Socket, Address, Read, Write) :- 412 tcp_connect_hook(Socket, Address, Read, Write), 413 !. 414tcp_connect(Socket, Address, Read, Write) :- 415 tcp_connect(Socket, Address), 416 tcp_open_socket(Socket, Read, Write). 417 418 419 420%! tcp_connect(+Address, -StreamPair, +Options) is det. 421%! tcp_connect(+Socket, +Address, -StreamPair) is det. 422% 423% Establish a TCP communication as a client. The +,-,+ mode is the 424% preferred way for a client to establish a connection. This predicate 425% can be hooked to support network proxies. To use a proxy, the hook 426% proxy_for_url/3 must be defined. Permitted options are: 427% 428% * bypass_proxy(+Boolean) 429% Defaults to =false=. If =true=, do not attempt to use any 430% proxies to obtain the connection 431% 432% * nodelay(+Boolean) 433% Defaults to =false=. If =true=, set nodelay on the 434% resulting socket using tcp_setopt(Socket, nodelay) 435% 436% * domain(+Domain) 437% One of `inet' or `inet6`. When omitted we use host_address/2 438% with type(stream) and try the returned addresses in order. 439% 440% The +,+,- mode is deprecated and does not support proxies. It 441% behaves like tcp_connect/4, but creates a stream pair (see 442% stream_pair/3). 443% 444% @arg Address is either a Host:Port term or a file name (atom or 445% string). The latter connects to an AF_UNIX socket and requires 446% unix_domain_socket/1. 447% 448% @error proxy_error(tried(ResultList)) is raised by mode (+,-,+) if 449% proxies are defines by proxy_for_url/3 but no proxy can establsh the 450% connection. `ResultList` contains one or more terms of the form 451% false(Proxy) for a hook that simply failed or error(Proxy, 452% ErrorTerm) for a hook that raised an exception. 453% 454% @see library(http/http_proxy) defines a hook that allows to connect 455% through HTTP proxies that support the =CONNECT= method. 456 457% Main mode: +,-,+ 458tcp_connect(Address, StreamPair, Options) :- 459 var(StreamPair), 460 !, 461 ( memberchk(bypass_proxy(true), Options) 462 -> tcp_connect_direct(Address, Socket, StreamPair, Options) 463 ; findall(Result, 464 try_a_proxy(Address, Result), 465 ResultList), 466 last(ResultList, Status) 467 -> ( Status = true(_Proxy, Socket, StreamPair) 468 -> true 469 ; throw(error(proxy_error(tried(ResultList)), _)) 470 ) 471 ; tcp_connect_direct(Address, Socket, StreamPair, Options) 472 ), 473 ( memberchk(nodelay(true), Options) 474 -> tcp_setopt(Socket, nodelay) 475 ; true 476 ). 477% backward compatibility mode +,+,- 478tcp_connect(Socket, Address, StreamPair) :- 479 tcp_connect_hook(Socket, Address, StreamPair0), 480 !, 481 StreamPair = StreamPair0. 482tcp_connect(Socket, Address, StreamPair) :- 483 connect_stream_pair(Socket, Address, StreamPair). 484 485:- public tcp_connect_direct/3. % used by HTTP proxy code. 486tcp_connect_direct(Address, Socket, StreamPair) :- 487 tcp_connect_direct(Address, Socket, StreamPair, []). 488 489%! tcp_connect_direct(+Address, +Socket, -StreamPair, +Options) is det. 490% 491% Make a direct connection to a TCP address, i.e., do not take proxy 492% rules into account. If no explicit domain (`inet`, `inet6` is 493% given, perform a getaddrinfo() call to obtain the relevant 494% addresses. 495 496tcp_connect_direct(Host0:Port, Socket, StreamPair, Options) :- 497 must_be(ground, Host0), 498 \+ option(domain(_), Options), 499 !, 500 ( rewrite_host(Host0, Host, Socket) 501 -> true 502 ; Host = Host0 503 ), 504 State = error(_), 505 ( ( is_ip(Host, Domain) 506 -> IP = Host 507 ; host_address(Host, Address, [type(stream)]), 508 Domain = Address.domain, 509 IP = Address.address 510 ), 511 socket_create(Socket, [domain(Domain)]), 512 E = error(_,_), 513 catch(connect_or_discard_socket(Socket, IP:Port, StreamPair), 514 E, store_error_and_fail(State, E)), 515 debug(socket, '~p: connected to ~p', [Host, IP]) 516 -> true 517 ; arg(1, State, Error), 518 assertion(nonvar(Error)), 519 throw(Error) 520 ). 521tcp_connect_direct(Address, Socket, StreamPair, Options) :- 522 make_socket(Address, Socket, Options), 523 connect_or_discard_socket(Socket, Address, StreamPair). 524 525is_ip(ip(_,_,_,_), inet). 526is_ip(ip(_,_,_,_, _,_,_,_), inet6). 527 528connect_or_discard_socket(Socket, Address, StreamPair) :- 529 setup_call_catcher_cleanup( 530 true, 531 connect_stream_pair(Socket, Address, StreamPair), 532 Catcher, cleanup(Catcher, Socket)). 533 534cleanup(exit, _) :- !. 535cleanup(_, Socket) :- 536 tcp_close_socket(Socket). 537 538connect_stream_pair(Socket, Address, StreamPair) :- 539 tcp_connect(Socket, Address, Read, Write), 540 stream_pair(StreamPair, Read, Write). 541 542store_error_and_fail(State, E) :- 543 arg(1, State, E0), 544 var(E0), 545 nb_setarg(1, State, E), 546 fail. 547 548:- if(current_predicate(unix_domain_socket/1)). 549make_socket(Address, Socket, _Options) :- 550 ( atom(Address) 551 ; string(Address) 552 ), 553 !, 554 unix_domain_socket(Socket). 555:- endif. 556make_socket(_Address, Socket, Options) :- 557 option(domain(Domain), Options, inet), 558 socket_create(Socket, [domain(Domain)]). 559 560 561%! tcp_select(+ListOfStreams, -ReadyList, +TimeOut) 562% 563% Same as the built-in wait_for_input/3. Used to allow for interrupts 564% and timeouts on Windows. A redesign of the Windows socket interface 565% makes it impossible to do better than Windows select() call 566% underlying wait_for_input/3. As input multiplexing typically happens 567% in a background thread anyway we accept the loss of timeouts and 568% interrupts. 569% 570% @deprecated Use wait_for_input/3 571 572tcp_select(ListOfStreams, ReadyList, TimeOut) :- 573 wait_for_input(ListOfStreams, ReadyList, TimeOut). 574 575 576 /******************************* 577 * PROXY SUPPORT * 578 *******************************/ 579 580try_a_proxy(Address, Result) :- 581 format(atom(URL), 'socket://~w', [Address]), 582 ( Address = Host:_ 583 -> true 584 ; Host = Address 585 ), 586 proxy_for_url(URL, Host, Proxy), 587 debug(socket(proxy), 'Socket connecting via ~w~n', [Proxy]), 588 ( catch(try_proxy(Proxy, Address, Socket, Stream), E, true) 589 -> ( var(E) 590 -> !, Result = true(Proxy, Socket, Stream) 591 ; Result = error(Proxy, E) 592 ) 593 ; Result = false(Proxy) 594 ), 595 debug(socket(proxy), 'Socket: ~w: ~p', [Proxy, Result]). 596 597%! try_proxy(+Proxy, +TargetAddress, -Socket, -StreamPair) is semidet. 598% 599% Attempt a socket-level connection via the given proxy to 600% TargetAddress. The Proxy argument must match the output argument 601% of proxy_for_url/3. The predicate tcp_connect/3 (and http_open/3 602% from the library(http/http_open)) collect the results of failed 603% proxies and raise an exception no proxy is capable of realizing 604% the connection. 605% 606% The default implementation recognises the values for Proxy 607% described below. The library(http/http_proxy) adds 608% proxy(Host,Port) which allows for HTTP proxies using the 609% =CONNECT= method. 610% 611% - direct 612% Do not use any proxy 613% - socks(Host, Port) 614% Use a SOCKS5 proxy 615 616:- multifile 617 try_proxy/4. 618 619try_proxy(direct, Address, Socket, StreamPair) :- 620 !, 621 tcp_connect_direct(Address, Socket, StreamPair). 622try_proxy(socks(Host, Port), Address, Socket, StreamPair) :- 623 !, 624 tcp_connect_direct(Host:Port, Socket, StreamPair), 625 catch(negotiate_socks_connection(Address, StreamPair), 626 Error, 627 ( close(StreamPair, [force(true)]), 628 throw(Error) 629 )). 630 631%! proxy_for_url(+URL, +Hostname, -Proxy) is nondet. 632% 633% This hook can be implemented to return a proxy to try when 634% connecting to URL. Returned proxies are tried in the order in 635% which they are returned by the multifile hook try_proxy/4. 636% Pre-defined proxy methods are: 637% 638% * direct 639% connect directly to the resource 640% * proxy(Host, Port) 641% Connect to the resource using an HTTP proxy. If the 642% resource is not an HTTP URL, then try to connect using the 643% CONNECT verb, otherwise, use the GET verb. 644% * socks(Host, Port) 645% Connect to the resource via a SOCKS5 proxy 646% 647% These correspond to the proxy methods defined by PAC [Proxy 648% auto-config](http://en.wikipedia.org/wiki/Proxy_auto-config). 649% Additional methods can be returned if suitable clauses for 650% http:http_connection_over_proxy/6 or try_proxy/4 are defined. 651 652:- multifile 653 proxy_for_url/3. 654 655%! udp_socket(-SocketId) is det. 656% 657% Equivalent to socket_create(SocketId, [type(dgram)]) or, explicit, 658% socket_create(SocketId, [domain(inet), type(dgram)]). 659 660%! udp_receive(+Socket, -Data, -From, +Options) is det. 661% 662% Wait for and return the next datagram. The Data is returned as a 663% Prolog term depending on Options. From is a term of the format 664% Ip:Port indicating the sender of the message. Here, `Ip` is either 665% an ip4 or ip6 structure. Socket can be waited for using 666% wait_for_input/3. Defined Options: 667% 668% - as(+Type) 669% Defines the type for Data. Possible values are `atom`, `codes`, 670% `string` (default) or `term` (parse as Prolog term). 671% - encoding(+Encoding) 672% Specify the encoding used to interpret the message. It is one of 673% `octet`. `iso_latin_1`, `text` or `utf8`. 674% - max_message_size(+Size) 675% Specify the maximum number of bytes to read from a UDP 676% datagram. Size must be within the range 0-65535. If unspecified, 677% a maximum of 4096 bytes will be read. 678% 679% For example: 680% 681% ``` 682% receive(Port) :- 683% udp_socket(Socket), 684% tcp_bind(Socket, Port), 685% repeat, 686% udp_receive(Socket, Data, From, [as(atom)]), 687% format('Got ~q from ~q~n', [Data, From]), 688% fail. 689% ``` 690 691 692%! udp_send(+Socket, +Data, +To, +Options) is det. 693% 694% Send a UDP message. Data is a string, atom or code-list providing 695% the data. To is an address of the form Host:Port where Host is 696% either the hostname or an IP address. Defined Options are: 697% 698% - encoding(+Encoding) 699% Specifies the encoding to use for the string. See 700% udp_receive/4 for details 701% - as(+Type) 702% This uses the same values for Type as the as(Type) option of 703% udp_receive/4. The are interpreted differently though. No Type 704% corresponds to CVT_ALL of PL_get_chars(). Using atom 705% corresponds to CVT_ATOM and any of string or codes is mapped 706% to CVT_STRING|CVT_LIST, allowing for a SWI-Prolog string 707% object, list of character codes or list of characters. 708% Finally, `term` maps to CVT_WRITE_CANONICAL. This implies that 709% arbitrary Prolog terms can be sent reliably using the option 710% list `[as(term),encoding(utf8)])`, using the same option list 711% for udp_receive/4. 712% 713% For example 714% 715% ``` 716% send(Host, Port, Message) :- 717% udp_socket(S), 718% udp_send(S, Message, Host:Port, []), 719% tcp_close_socket(S). 720% ``` 721% 722% A broadcast is achieved by using tcp_setopt(Socket, broadcast) 723% prior to sending the datagram and using the local network 724% broadcast address as a ip/4 term. 725 726 727 /******************************* 728 * OPTIONS * 729 *******************************/ 730 731%! tcp_setopt(+SocketId, +Option) is det. 732% 733% Set options on the socket. Defined options are: 734% 735% - reuseaddr 736% Allow servers to reuse a port without the system being 737% completely sure the port is no longer in use. 738% 739% - bindtodevice(+Device) 740% Bind the socket to Device (an atom). For example, the code 741% below binds the socket to the _loopback_ device that is 742% typically used to realise the _localhost_. See the manual 743% pages for setsockopt() and the socket interface (e.g., 744% socket(7) on Linux) for details. 745% 746% == 747% tcp_socket(Socket), 748% tcp_setopt(Socket, bindtodevice(lo)) 749% == 750% 751% - nodelay 752% - nodelay(true) 753% If =true=, disable the Nagle optimization on this socket, 754% which is enabled by default on almost all modern TCP/IP 755% stacks. The Nagle optimization joins small packages, which is 756% generally desirable, but sometimes not. Please note that the 757% underlying TCP_NODELAY setting to setsockopt() is not 758% available on all platforms and systems may require additional 759% privileges to change this option. If the option is not 760% supported, tcp_setopt/2 raises a domain_error exception. See 761% [Wikipedia](http://en.wikipedia.org/wiki/Nagle's_algorithm) 762% for details. 763% 764% - broadcast 765% UDP sockets only: broadcast the package to all addresses 766% matching the address. The address is normally the address of 767% the local subnet (i.e. 192.168.1.255). See udp_send/4. 768% 769% - ip_add_membership(+MultiCastGroup) 770% - ip_add_membership(+MultiCastGroup, +LocalInterface) 771% - ip_add_membership(+MultiCastGroup, +LocalInterface, +InterfaceIndex) 772% - ip_drop_membership(+MultiCastGroup) 773% - ip_drop_membership(+MultiCastGroup, +LocalInterface) 774% - ip_drop_membership(+MultiCastGroup, +LocalInterface, +InterfaceIndex) 775% Join/leave a multicast group. Calls setsockopt() with the 776% corresponding arguments. 777% 778% - dispatch(+Boolean) 779% In GUI environments (using XPCE or the Windows =swipl-win.exe= 780% executable) this flags defines whether or not any events are 781% dispatched on behalf of the user interface. Default is 782% =true=. Only very specific situations require setting 783% this to =false=. 784% 785% - sndbuf(+Integer) 786% Sets the send buffer size to Integer (bytes). On Windows this defaults 787% (now) to 64kb. Higher latency links may benefit from increasing this 788% further since the maximum theoretical throughput on a link is given by 789% buffer-size / latency. 790% See https://support.microsoft.com/en-gb/help/823764/slow-performance-occurs-when-you-copy-data-to-a-tcp-server-by-using-a 791% for Microsoft's discussion 792 793%! tcp_fcntl(+Stream, +Action, ?Argument) is det. 794% 795% Interface to the fcntl() call. Currently only suitable to deal 796% switch stream to non-blocking mode using: 797% 798% == 799% tcp_fcntl(Stream, setfl, nonblock), 800% == 801% 802% An attempt to read from a non-blocking stream while there is no 803% data available returns -1 (or =end_of_file= for read/1), but 804% at_end_of_stream/1 fails. On actual end-of-input, 805% at_end_of_stream/1 succeeds. 806 807tcp_fcntl(Socket, setfl, nonblock) :- 808 !, 809 tcp_setopt(Socket, nonblock). 810 811%! tcp_getopt(+Socket, ?Option) is semidet. 812% 813% Get information about Socket. Defined properties are below. 814% Requesting an unknown option results in a `domain_error` exception. 815% 816% - file_no(-File) 817% Get the OS file handle as an integer. This may be used for 818% debugging and integration. 819 820%! host_address(+HostName, -Address, +Options) is nondet. 821%! host_address(-HostName, +Address, +Options) is det. 822% 823% Translate between a machines host-name and it's (IP-)address. 824% Supported options: 825% 826% - domain(+Domain) 827% One of `inet` or `inet6` to limit the results to the given 828% family. 829% - type(+Type) 830% One of `stream` or `dgram`. 831% - canonname(+Boolean) 832% If `true` (default `false`), return the canonical host name 833% in the frist answer 834% 835% In mode (+,-,+) Address is unified to a dict with the following keys: 836% 837% - address 838% A Prolog terms describing the ip address. 839% - domain 840% One of `inet` or `inet6`. The underlying getaddrinfo() calls 841% this `family`. We use `domain` for consistency with 842% socket_create/2. 843% - type 844% Currently one of `stream` or `dgram`. 845% - host 846% Available if canonname(true) is specified on the first 847% returned address. Holds the official canonical host name. 848 849host_address(HostName, Address, Options), ground(HostName) => 850 '$host_address'(HostName, Addresses, Options), 851 member(Address, Addresses). 852host_address(HostName, Address, Options), is_dict(Address) => 853 '$host_address'(HostName, Address.address, Options). 854host_address(HostName, Address, Options), ground(Address) => 855 '$host_address'(HostName, Address, Options). 856 857%! tcp_host_to_address(?HostName, ?Address) is det. 858% 859% Translate between a machines host-name and it's (IP-)address. If 860% HostName is an atom, it is resolved using getaddrinfo() and the 861% IP-number is unified to Address using a term of the format 862% ip(Byte1,Byte2,Byte3,Byte4). Otherwise, if Address is bound to an 863% ip(Byte1,Byte2,Byte3,Byte4) term, it is resolved by gethostbyaddr() 864% and the canonical hostname is unified with HostName. 865% 866% @deprecated New code should use host_address/3. This version is 867% bootstrapped from host_address/3 and only searches for IP4 addresses 868% that support TCP connections. 869 870tcp_host_to_address(Host, Address), ground(Address) => 871 host_address(Host, Address, []). 872tcp_host_to_address(Host, Address), ground(Host) => 873 host_address(Host, [Dict|_], [domain(inet), type(stream)]), 874 Address = Dict.address. 875 876 877%! gethostname(-Hostname) is det. 878% 879% Return the canonical fully qualified name of this host. This is 880% achieved by calling gethostname() and return the canonical name 881% returned by getaddrinfo(). 882 883 884%! ip_name(?IP, ?Name) is det. 885% 886% Translate between the textual representation of an IP address and 887% the Prolog data structure. Prolog represents ip4 addresses as 888% ip(A,B,C,D) and ip6 addresses as ip(A,B,C,D,E,F,H). For example: 889% 890% ?- ip_name(ip(1,2,3,4), Name) 891% Name = '1.2.3.4'. 892% ?- ip_name(IP, '::'). 893% IP = ip(0,0,0,0,0,0,0,0). 894% ?- ip_name(IP, '1:2::3'). 895% IP = ip(1,2,0,0,0,0,0,3). 896 897ip_name(Ip, Atom), ground(Atom) => 898 name_to_ip(Atom, Ip). 899ip_name(Ip, Atom), ground(Ip) => 900 ip_to_name(Ip, Atom). 901ip_name(Ip, _) => 902 instantiation_error(Ip). 903 904name_to_ip(Atom, Ip4) :- 905 split_string(Atom, '.', '', Parts), 906 length(Parts, 4), 907 maplist(string_byte, Parts, Bytes), 908 !, 909 Ip4 =.. [ip|Bytes]. 910name_to_ip(Atom, Ip6) :- 911 split_string(Atom, ':', '', Parts0), 912 clean_ends(Parts0, Parts1), 913 length(Parts1, Len), 914 ( Len < 8 915 -> append(Pre, [""|Post], Parts1), 916 Zeros is 8-(Len-1), 917 length(ZList, Zeros), 918 maplist(=("0"), ZList), 919 append([Pre, ZList, Post], Parts) 920 ; Len == 8 921 -> Parts = Parts1 922 ), 923 !, 924 maplist(string_short, Parts, Shorts), 925 Ip6 =.. [ip|Shorts]. 926name_to_ip(Atom, _) :- 927 syntax_error(ip_address(Atom)). 928 929clean_ends([""|T0], T) :- 930 !, 931 ( append(T1, [""], T0) 932 -> T = T1 933 ; T = T0 934 ). 935clean_ends(T0, T) :- 936 append(T1, [""], T0), 937 !, 938 T = T1. 939clean_ends(T, T). 940 941string_byte(String, Byte) :- 942 number_string(Byte, String), 943 must_be(between(0, 255), Byte). 944 945string_short(String, Short) :- 946 string_concat('0x', String, String1), 947 number_string(Short, String1), 948 must_be(between(0, 65535), Short). 949 950ip_to_name(ip(A,B,C,D), Atom) :- 951 !, 952 atomic_list_concat([A,B,C,D], '.', Atom). 953ip_to_name(IP, Atom) :- 954 compound(IP), 955 compound_name_arity(IP, ip, 8), 956 !, 957 IP =.. [ip|Parts], 958 ( zero_seq(Parts, Pre, Post, Len), 959 Len > 1, 960 \+ ( zero_seq(Post, _, _, Len2), 961 Len2 > Len 962 ) 963 -> append([Pre, [''], Post], Parts1), 964 ( Pre == [] 965 -> Parts2 = [''|Parts1] 966 ; Parts2 = Parts1 967 ), 968 ( Post == [] 969 -> append(Parts2, [''], Parts3) 970 ; Parts3 = Parts2 971 ) 972 ; Parts3 = Parts 973 ), 974 maplist(to_hex, Parts3, Parts4), 975 atomic_list_concat(Parts4, ':', Atom). 976ip_to_name(IP, _) :- 977 domain_error(ip_address, IP). 978 979zero_seq(List, Pre, Post, Count) :- 980 append(Pre, [0|Post0], List), 981 leading_zeros(Post0, Post, 1, Count). 982 983leading_zeros([0|T0], T, C0, C) => 984 C1 is C0+1, 985 leading_zeros(T0, T, C1, C). 986leading_zeros(L0, L, C0, C) => 987 L = L0, 988 C = C0. 989 990to_hex('', '') :- 991 !. 992to_hex(Num, Hex) :- 993 format(string(Hex), '~16r', [Num]). 994 995 996 997 /******************************* 998 * SOCKS * 999 *******************************/ 1000 1001%! negotiate_socks_connection(+DesiredEndpoint, +StreamPair) is det. 1002% 1003% Negotiate a connection to DesiredEndpoint over StreamPair. 1004% DesiredEndpoint should be in the form of either: 1005% 1006% * hostname : port 1007% * ip(A,B,C,D) : port 1008% 1009% @error socks_error(Details) if the SOCKS negotiation failed. 1010 1011negotiate_socks_connection(Host:Port, StreamPair):- 1012 format(StreamPair, '~s', [[0x5, % Version 5 1013 0x1, % 1 auth method supported 1014 0x0]]), % which is 'no auth' 1015 flush_output(StreamPair), 1016 get_byte(StreamPair, ServerVersion), 1017 get_byte(StreamPair, AuthenticationMethod), 1018 ( ServerVersion =\= 0x05 1019 -> throw(error(socks_error(invalid_version(5, ServerVersion)), _)) 1020 ; AuthenticationMethod =:= 0xff 1021 -> throw(error(socks_error(invalid_authentication_method( 1022 0xff, 1023 AuthenticationMethod)), _)) 1024 ; true 1025 ), 1026 ( Host = ip(A,B,C,D) 1027 -> AddressType = 0x1, % IPv4 Address 1028 format(atom(Address), '~s', [[A, B, C, D]]) 1029 ; AddressType = 0x3, % Domain 1030 atom_length(Host, Length), 1031 format(atom(Address), '~s~w', [[Length], Host]) 1032 ), 1033 P1 is Port /\ 0xff, 1034 P2 is Port >> 8, 1035 format(StreamPair, '~s~w~s', [[0x5, % Version 5 1036 0x1, % Please establish a connection 1037 0x0, % reserved 1038 AddressType], 1039 Address, 1040 [P2, P1]]), 1041 flush_output(StreamPair), 1042 get_byte(StreamPair, _EchoedServerVersion), 1043 get_byte(StreamPair, Status), 1044 ( Status =:= 0 % Established! 1045 -> get_byte(StreamPair, _Reserved), 1046 get_byte(StreamPair, EchoedAddressType), 1047 ( EchoedAddressType =:= 0x1 1048 -> get_byte(StreamPair, _), % read IP4 1049 get_byte(StreamPair, _), 1050 get_byte(StreamPair, _), 1051 get_byte(StreamPair, _) 1052 ; get_byte(StreamPair, Length), % read host name 1053 forall(between(1, Length, _), 1054 get_byte(StreamPair, _)) 1055 ), 1056 get_byte(StreamPair, _), % read port 1057 get_byte(StreamPair, _) 1058 ; throw(error(socks_error(negotiation_rejected(Status)), _)) 1059 ). 1060 1061 1062 /******************************* 1063 * MESSAGES * 1064 *******************************/ 1065 1066/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1067The C-layer generates exceptions of the following format, where Message 1068is extracted from the operating system. 1069 1070 error(socket_error(Code, Message), _) 1071- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1072 1073:- multifile 1074 prolog:error_message//1. 1075 1076prologerror_message(socket_error(_Code, Message)) --> 1077 [ 'Socket error: ~w'-[Message] ]. 1078prologerror_message(socks_error(Error)) --> 1079 socks_error(Error). 1080prologerror_message(proxy_error(tried(Tried))) --> 1081 [ 'Failed to connect using a proxy. Tried:'-[], nl], 1082 proxy_tried(Tried). 1083 1084socks_error(invalid_version(Supported, Got)) --> 1085 [ 'SOCKS: unsupported version: ~p (supported: ~p)'- 1086 [ Got, Supported ] ]. 1087socks_error(invalid_authentication_method(Supported, Got)) --> 1088 [ 'SOCKS: unsupported authentication method: ~p (supported: ~p)'- 1089 [ Got, Supported ] ]. 1090socks_error(negotiation_rejected(Status)) --> 1091 [ 'SOCKS: connection failed: ~p'-[Status] ]. 1092 1093proxy_tried([]) --> []. 1094proxy_tried([H|T]) --> 1095 proxy_tried(H), 1096 proxy_tried(T). 1097proxy_tried(error(Proxy, Error)) --> 1098 [ '~w: '-[Proxy] ], 1099 '$messages':translate_message(Error). 1100proxy_tried(false(Proxy)) --> 1101 [ '~w: failed with unspecified error'-[Proxy] ]