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