1:- module(test_proxy, 2 [ test_proxy/0 3 ]). 4:- asserta(user:file_search_path(foreign, '.')). 5:- asserta(user:file_search_path(foreign, '../clib')). 6:- asserta(user:file_search_path(foreign, '../ssl')). 7:- asserta(user:file_search_path(foreign, '../sgml')). 8:- asserta(user:file_search_path(library, '..')). 9:- asserta(user:file_search_path(library, '../plunit')). 10:- asserta(user:file_search_path(library, '../clib')). 11:- asserta(user:file_search_path(library, '../sgml')). 12:- asserta(user:file_search_path(library, '../ssl')). 13 14:- use_module(library(http/http_header)). 15:- use_module(library(http/http_open)). 16:- use_module(library(http/http_proxy)). 17:- use_module(library(http/thread_httpd)). 18:- use_module(library(option)). 19:- use_module(library(plunit)). 20:- use_module(library(socket)). 21:- if(exists_source(library(unix))). 22:- use_module(library(unix), [pipe/2]). 23:- endif. 24:- use_module(library(debug)). 25:- use_module(library(dcg/basics)). 26:- if(exists_source(library(ssl))). 27:- use_module(library(ssl)). 28:- use_module(library(http/http_ssl_plugin)). 29test_https(true). 30:- else. 31test_https(false). 32:- endif. 33 34test_proxy :- 35 assign_ports, 36 run_tests([ proxy 37 ]). 38 39test_input(Name, Path) :- 40 source_file(test_proxy, MyFile), 41 file_directory_name(MyFile, MyDir), 42 atomic_list_concat([MyDir, Name], /, Path). 43 44:- dynamic 45 port/2. % Role, Port 46 47assign_ports :- 48 port(unused, _), 49 !. 50assign_ports :- 51 free_ports(5, [P1,P2,P3,P4,P5]), 52 assertz(port(http_endpoint, P1)), % our HTTP target server 53 ( test_https(true) 54 -> assertz(port(https_endpoint, P2)) % our HTTPS target server 55 ; true 56 ), 57 assertz(port(socks, P3)), % our socks server 58 assertz(port(http_proxy, P4)), % our HTTP proxy 59 assertz(port(unused, P5)). % port without a server 60 61free_ports(N, Ports) :- 62 length(Sockets, N), 63 maplist(alloc_port, Sockets, Ports), 64 maplist(tcp_close_socket, Sockets). 65 66alloc_port(Socket, Port) :- 67 tcp_socket(Socket), 68 tcp_setopt(Socket, reuseaddr), 69 tcp_bind(Socket, Port). 70 71 72:- begin_tests(proxy, [condition(current_predicate(pipe/2))]). 73 74:- dynamic 75 test_proxy/3, 76 http_proxy_control/3, % Port, Thread, ControlWrite 77 socks_control/3. 78 79:- multifile 80 socket:proxy_for_url/3. 81 82socket:proxy_for_url(URL, Hostname, Proxy):- 83 debug(proxy, 'Proxy requested for ~w (~w)~n', [URL, Hostname]), 84 test_proxy(URL, Hostname, ProxyList), 85 debug(proxy, '... -> ~w~n', [ProxyList]), 86 member(Proxy, ProxyList). 87 88start_http_proxy(Port):- 89 tcp_socket(Socket), 90 tcp_setopt(Socket, reuseaddr), 91 tcp_bind(Socket, Port), 92 tcp_listen(Socket, 5), 93 pipe(ControlRead, ControlWrite), 94 format(atom(Alias), 'http-proxy@~w', [Port]), 95 thread_create(http_proxy_server(Socket, ControlRead), ThreadId, 96 [alias(Alias)]), 97 assert(http_proxy_control(Port, ThreadId, ControlWrite)). 98 99stop_http_proxy_server(Port):- 100 retract(http_proxy_control(Port, ThreadId, ControlWrite)), 101 close(ControlWrite), 102 catch(setup_call_cleanup( 103 tcp_connect(localhost:Port, Tmp, 104 [ bypass_proxy(true) 105 ]), 106 true, 107 close(Tmp)), 108 _, true), 109 thread_join(ThreadId, _). 110 111http_proxy_server(Socket, ControlRead):- 112 setup_call_cleanup( 113 true, 114 http_proxy_server_loop(Socket, ControlRead), 115 ( tcp_close_socket(Socket), 116 close(ControlRead, [force(true)]) 117 )). 118 119http_proxy_server_loop(ServerFd, Control):- 120 catch(http_proxy_accept_client(ServerFd, Control), exit, true), 121 thread_self(Self), 122 ( http_proxy_control(_, Self, _) 123 -> http_proxy_server_loop(ServerFd, Control) 124 ; true 125 ). 126 127http_proxy_accept_client(ServerFd, Control):- 128 tcp_accept(ServerFd, ClientFd, _Peer), 129 tcp_open_socket(ClientFd, Stream), 130 thread_self(Self), 131 ( http_proxy_control(_, Self, _) 132 -> true 133 ; close(Stream, [force(true)]), 134 throw(exit) 135 ), 136 catch(do_http_proxy_request(Stream, Control), 137 _Error, 138 ( format(Stream, 'HTTP/1.0 500 Something smells bad~n~n', []), 139 close(Stream, [force(true)]) 140 )). 141 142 143parse_http_proxy_request(Verb, Target)--> 144 verb(Verb), " ", target(Target), " HTTP/", http_version(_). 145 146verb(connect)--> "CONNECT", !. 147verb(get)--> "GET", !. 148target(Target)--> 149 string_without(" ", TargetString), 150 {atom_string(Target, TargetString)}. 151 152http_version(1-1)--> "1.1". 153http_version(1-0)--> "1.0". 154 155read_headers(Read, Tail):- 156 read_line_to_codes(Read, Codes), 157 ( Codes == [] 158 -> Tail = [] 159 ; http_parse_header(Codes, Header) 160 -> append(Header, NewTail, Tail), 161 read_headers(Read, NewTail) 162 ; read_headers(Read, Tail) 163 ). 164 165do_http_proxy_request(Stream, Control):- 166 read_line_to_codes(Stream, Codes), 167 read_headers(Stream, ReadHeaders), 168 parse_http_proxy_request(Verb, Target, Codes, []), 169 ( Verb == connect 170 -> atomic_list_concat([Hostname, PortAtom], ':', Target), 171 atom_number(PortAtom, Port), 172 ( test_http_connect_mapping( 173 Hostname:Port, MappedHostname:MappedPort) 174 -> true 175 ; MappedHostname = Hostname, 176 MappedPort = Port 177 ), 178 assert(http_proxy_connection_attempt( 179 connect(MappedHostname:MappedPort))), 180 tcp_connect(MappedHostname:MappedPort, SlaveStream, 181 [bypass_proxy(true)]), 182 debug(proxy, 'Connected via CONNECT to ~w', [Hostname:Port]), 183 format(Stream, 'HTTP/1.1 200 Connection established~n~n', []), 184 flush_output(Stream), 185 stream_pair(SlaveStream, SlaveRead, SlaveWrite), 186 shovel_loop(Stream, SlaveRead, SlaveWrite, Control) 187 ; Verb == get 188 -> setup_call_cleanup( 189 http_open(Target, Slave, 190 [ bypass_proxy(true), 191 headers(Headers), 192 version(Version), 193 status_code(Code) 194 ]), 195 http_get_proxy(Code, Version, Headers, Slave, Stream), 196 close(Slave)), 197 ( memberchk(proxy_authorization(_), ReadHeaders) 198 -> assert(http_proxy_connection_attempt( 199 authenticated_get(Target))) 200 ; assert(http_proxy_connection_attempt(get(Target))) 201 ), 202 flush_output(Stream), 203 close(Stream, [force(true)]) 204 ). 205 206http_get_proxy(Code, (Major-Minor), _Headers, Slave, Write):- 207 format(Write, 'HTTP/~w.~w ~w Whatever~n~n', [Major, Minor, Code]), 208 copy_stream_data(Slave, Write). 209 210 211:-dynamic 212 test_socks_mapping/2, 213 test_http_connect_mapping/2. 214 215start_socks_server(Port):- 216 tcp_socket(Socket), 217 tcp_setopt(Socket, reuseaddr), 218 tcp_bind(Socket, Port), 219 tcp_listen(Socket, 5), 220 pipe(ControlRead, ControlWrite), 221 format(atom(Alias), 'socks@~w', [Port]), 222 thread_create(socks_server(Socket, ControlRead), ThreadId, 223 [ alias(Alias) ]), 224 assert(socks_control(Port, ThreadId, ControlWrite)). 225 226stop_socks_server(Port):- 227 retract(socks_control(Port, ThreadId, ControlWrite)), 228 close(ControlWrite), 229 catch(setup_call_cleanup( 230 tcp_connect(localhost:Port, Tmp, 231 [ bypass_proxy(true) 232 ]), 233 true, 234 close(Tmp)), 235 _, true), 236 thread_join(ThreadId, _). 237 238socks_server(Socket, ControlRead):- 239 call_cleanup(socks_server_loop(Socket, ControlRead), 240 ( tcp_close_socket(Socket), 241 close(ControlRead, [force(true)]) 242 )). 243 244socks_server_loop(ServerFd, Control):- 245 catch(socks_accept_client(ServerFd, Control), exit, true), 246 thread_self(Self), 247 ( socks_control(_, Self, _) 248 -> socks_server_loop(ServerFd, Control) 249 ; true 250 ). 251 252socks_accept_client(ServerFd, Control):- 253 tcp_accept(ServerFd, Socket, _Peer), 254 tcp_open_socket(Socket, Stream), 255 thread_self(Self), 256 ( socks_control(_, Self, _) 257 -> true 258 ; close(Stream, [force(true)]), % asked to stop 259 throw(exit) 260 ), 261 get_byte(Stream, _Version), 262 get_byte(Stream, AuthCount), 263 findall(AuthMethod, 264 ( between(1, AuthCount, _), 265 get_byte(Stream, AuthMethod) 266 ), 267 _AuthMethods), 268 format(Stream, '~s', [[0x5, 0x0]]), 269 flush_output(Stream), 270 do_socks_request(Stream, Control). 271 272do_socks_request(Stream, Control):- 273 get_byte(Stream, _Version), 274 get_byte(Stream, Action), 275 get_byte(Stream, _Reserved), 276 ( Action =:= 1 277 -> get_byte(Stream, AddressType), 278 ( AddressType =:= 1 279 -> get_byte(Stream, A), 280 get_byte(Stream, B), 281 get_byte(Stream, C), 282 get_byte(Stream, D), 283 format(atom(Hostname), '~w.~w.~w.~w', [A, B, C, D]), 284 AddressBytes = [A,B,C,D] 285 ; AddressType =:= 3 286 -> get_byte(Stream, Length), 287 findall(Code, 288 ( between(1, Length, _), 289 get_byte(Stream, Code) 290 ), 291 Codes), 292 AddressBytes = [Length|Codes], 293 atom_codes(Hostname, Codes) 294 ), 295 get_byte(Stream, PortHi), 296 get_byte(Stream, PortLo), 297 Port is (PortHi << 8) \/ PortLo 298 ; format(Stream, '~s', [0x1]), 299 fail 300 ), 301 assert(socks_proxy_connection_attempt(Hostname:Port)), 302 ( test_socks_mapping(Hostname:Port, MappedHostname:MappedPort) 303 -> true 304 ; MappedHostname = Hostname, 305 MappedPort = Port 306 ), 307 tcp_connect(MappedHostname:MappedPort, SlaveStream, 308 [bypass_proxy(true)]), 309 debug(proxy, 'Connected via SOCKS to ~w:~w', [Hostname, Port]), 310 format(Stream, '~s~s~s', 311 [ [0x5, 0x0, 0x0, AddressType], 312 AddressBytes, 313 [PortHi, PortLo] 314 ]), 315 flush_output(Stream), 316 stream_pair(SlaveStream, SlaveRead, SlaveWrite), 317 shovel_loop(Stream, SlaveRead, SlaveWrite, Control). 318 319:- dynamic 320 test_socks_mapping/2. 321 322shovel_loop(Pair, SlaveRead, SlaveWrite, Control) :- 323 wait_for_input([Pair, SlaveRead, Control], ReadyList, infinite), 324 shovel_dispatch(Pair, SlaveRead, SlaveWrite, Control, ReadyList), 325 shovel_loop(Pair, SlaveRead, SlaveWrite, Control). 326 327shovel_dispatch(_, _SlaveRead, _SlaveWrite, _Control, []):- !. 328shovel_dispatch(Pair, SlaveRead, SlaveWrite, Control, [Stream|More]):- 329 ( at_end_of_stream(Stream) 330 -> close(Pair), 331 close(SlaveWrite), 332 close(SlaveRead), 333 close(Control), 334 throw(exit) 335 ; Stream == Pair 336 -> read_pending_codes(Stream, Bytes, []), 337 format(SlaveWrite, '~s', [Bytes]), 338 flush_output(SlaveWrite) 339 ; Stream == SlaveRead 340 -> read_pending_codes(Stream, Bytes, []), 341 format(Pair, '~s', [Bytes]), 342 flush_output(Pair) 343 ; Stream == Control 344 -> true 345 ), 346 shovel_dispatch(Pair, SlaveRead, SlaveWrite, Control, More). 347 348 349:- dynamic 350 socks_proxy_connection_attempt/1, 351 http_proxy_connection_attempt/1, 352 http_page_serve_attempt/1. 353 354http_endpoint(_Request):- 355 assert(http_page_serve_attempt(?)), 356 format('Content-type: text/html~n~nHello', []). 357 358start_servers :- 359 port(http_endpoint, HTTP_port), 360 port(http_proxy, HTTP_PROXY_port), 361 port(socks, SOCKS_port), 362 start_socks_server(SOCKS_port), 363 http_server(http_endpoint, 364 [ port(HTTP_port), 365 workers(2) 366 ]), 367 ( port(https_endpoint, HTTPS_port) 368 -> test_input('../ssl/etc/server/server-cert.pem', ServerCert), 369 test_input('../ssl/etc/server/server-key.pem', ServerKey), 370 http_server(http_endpoint, 371 [ port(HTTPS_port), 372 workers(2), 373 ssl([ certificate_file(ServerCert), 374 key_file(ServerKey), 375 password("apenoot1") 376 ]) 377 ]) 378 ; true 379 ), 380 start_http_proxy(HTTP_PROXY_port). 381 382stop_servers :- 383 port(socks, SOCKS_port), 384 port(http_endpoint, HTTP_port), 385 port(http_proxy, HTTP_PROXY_port), 386 stop_socks_server(SOCKS_port), 387 http_stop_server(HTTP_port, []), 388 ( port(https_endpoint, HTTPS_port) 389 -> http_stop_server(HTTPS_port, []) 390 ; true 391 ), 392 stop_http_proxy_server(HTTP_PROXY_port). 393 394proxy_test(Goal, Cleanup, SocksAttempts, HTTPAttempts, Messages) :- 395 catch_messages(proxy_test(Goal, Cleanup, SocksAttempts, HTTPAttempts), 396 Messages). 397 398proxy_test(Goal, Cleanup, SocksAttempts, HTTPAttempts) :- 399 retractall(socks_proxy_connection_attempt(_)), 400 retractall(http_proxy_connection_attempt(_)), 401 setup_call_cleanup(start_servers, 402 setup_call_cleanup(Goal, 403 true, 404 Cleanup), 405 stop_servers), 406 findall(SocksInfo, 407 retract(socks_proxy_connection_attempt(SocksInfo)), 408 SocksAttempts), 409 findall(HTTPInfo, 410 retract(http_proxy_connection_attempt(HTTPInfo)), 411 HTTPAttempts). 412 413 414 /******************************* 415 * THE TESTS * 416 *******************************/ 417 418test('Direct connection for TCP'):- 419 port(http_endpoint, Port), 420 retractall(test_proxy(_,_,_)), 421 retractall(test_socks_mapping(_,_)), 422 proxy_test(tcp_connect(localhost:Port, StreamPair, []), 423 close(StreamPair), 424 SocksProxyAttempts, 425 HTTPProxyAttempts), 426 assertion(SocksProxyAttempts == []), 427 assertion(HTTPProxyAttempts == []). 428 429test('All connections via SOCKS'):- 430 port(http_endpoint, HTTP_port), 431 port(socks, SOCKS_port), 432 retractall(test_proxy(_,_,_)), 433 retractall(test_socks_mapping(_,_)), 434 assert(test_proxy(_, _, [socks(localhost, SOCKS_port)])), 435 proxy_test(tcp_connect(localhost:HTTP_port, StreamPair, []), 436 close(StreamPair), 437 SocksProxyAttempts, 438 HTTPProxyAttempts), 439 assertion(SocksProxyAttempts == [localhost:HTTP_port]), 440 assertion(HTTPProxyAttempts == []). 441 442test('Some TCP connections via SOCKS'):- 443 port(http_endpoint, HTTP_port), 444 port(socks, SOCKS_port), 445 port(unused, UNUSED_port), 446 format(atom(HTTP_socket_URL), 'socket://localhost:~w', [HTTP_port]), 447 format(atom(UNUSED_URL), 'socket://localhost:~w', [UNUSED_port]), 448 retractall(test_proxy(_,_,_)), 449 retractall(test_socks_mapping(_,_)), 450 assert(test_proxy(UNUSED_URL, _, 451 [socks(localhost, SOCKS_port)])), 452 assert(test_proxy(HTTP_socket_URL, _, [direct])), 453 proxy_test(tcp_connect(localhost:HTTP_port, StreamPair, []), 454 close(StreamPair), 455 SocksProxyAttempts, 456 HTTPProxyAttempts), 457 assertion(SocksProxyAttempts == []), 458 assertion(HTTPProxyAttempts == []). 459 460test('First try SOCKS then fall back to direct'):- 461 port(http_endpoint, HTTP_port), 462 port(unused, UNUSED_port), 463 format(atom(HTTP_socket_URL), 'socket://localhost:~w', [HTTP_port]), 464 retractall(test_proxy(_,_,_)), 465 assert(test_proxy(HTTP_socket_URL, _, 466 [socks(localhost, UNUSED_port), direct])), 467 proxy_test(tcp_connect(localhost:HTTP_port, StreamPair, []), 468 close(StreamPair), 469 SocksProxyAttempts, 470 HTTPProxyAttempts), 471 assertion(SocksProxyAttempts == []), 472 assertion(HTTPProxyAttempts == []). 473 474test('First try direct to a nonexistent-host then fall back to SOCKS'):- 475 port(http_endpoint, HTTP_port), 476 port(socks, SOCKS_port), 477 port(unused, UNUSED_port), 478 retractall(test_proxy(_,_,_)), 479 retractall(test_socks_mapping(_,_)), 480 assert(test_socks_mapping(localhost:UNUSED_port, localhost:HTTP_port)), 481 assert(test_proxy(_, _, [direct, socks(localhost, SOCKS_port)])), 482 proxy_test(tcp_connect(localhost:UNUSED_port, StreamPair, []), 483 close(StreamPair), 484 SocksProxyAttempts, 485 HTTPProxyAttempts), 486 assertion(SocksProxyAttempts == [localhost:UNUSED_port]), 487 assertion(HTTPProxyAttempts == []). 488 489 490test('All TCP connections via HTTP'):- 491 port(http_endpoint, HTTP_port), 492 port(http_proxy, HTTP_PROXY_port), 493 retractall(test_proxy(_,_,_)), 494 assert(test_proxy(_, _, [proxy(localhost, HTTP_PROXY_port)])), 495 proxy_test(tcp_connect(localhost:HTTP_port, StreamPair, []), 496 close(StreamPair), 497 SocksProxyAttempts, 498 HTTPProxyAttempts), 499 SocksProxyAttempts == [], 500 HTTPProxyAttempts == [connect(localhost:HTTP_port)]. 501 502test('All TCP connections via HTTP but to a non-existent server'):- 503 port(unused, UNUSED_port), 504 port(http_proxy, HTTP_PROXY_port), 505 retractall(test_proxy(_,_,_)), 506 assert(test_proxy(_, _, [proxy(localhost, HTTP_PROXY_port)])), 507 catch(proxy_test(tcp_connect(localhost:UNUSED_port, StreamPair, []), 508 close(StreamPair), 509 _SocksProxyAttempts, 510 _HTTPProxyAttempts), 511 Error, 512 Exception = Error), 513 assertion(nonvar(Exception)). 514 515test('Request URL directly'):- 516 port(http_endpoint, HTTP_port), 517 format(atom(URL), 'http://localhost:~w', [HTTP_port]), 518 retractall(test_proxy(_,_,_)), 519 assert(test_proxy(_, _, [direct])), 520 proxy_test(http_open(URL, StreamPair, []), 521 close(StreamPair), 522 SocksProxyAttempts, 523 HTTPProxyAttempts), 524 assertion(SocksProxyAttempts == []), 525 assertion(HTTPProxyAttempts == []). 526 527test('Request URL when all connections go via SOCKS'):- 528 port(http_endpoint, HTTP_port), 529 port(socks, SOCKS_port), 530 format(atom(URL), 'http://localhost:~w', [HTTP_port]), 531 retractall(test_proxy(_,_,_)), 532 assert(test_proxy(_, _, [socks(localhost, SOCKS_port)])), 533 proxy_test(http_open(URL, StreamPair, []), 534 close(StreamPair), 535 SocksProxyAttempts, 536 HTTPProxyAttempts), 537 assertion(SocksProxyAttempts == [localhost:HTTP_port]), 538 assertion(HTTPProxyAttempts == []). 539 540test('Request URL when all connections go via HTTP'):- 541 port(http_endpoint, HTTP_port), 542 port(http_proxy, HTTP_PROXY_port), 543 format(atom(URL), 'http://localhost:~w', [HTTP_port]), 544 retractall(test_proxy(_,_,_)), 545 assert(test_proxy(_, _, [proxy(localhost, HTTP_PROXY_port)])), 546 proxy_test(http_open(URL, StreamPair, []), 547 close(StreamPair), 548 SocksProxyAttempts, 549 HTTPProxyAttempts), 550 assertion(SocksProxyAttempts == []), 551 assertion(HTTPProxyAttempts == [get(URL)]). 552 553test('Request invalid URL directly and expect exception rather than failure'):- 554 port(unused, UNUSED_port), 555 format(atom(URL), 'http://localhost:~w', [UNUSED_port]), 556 retractall(test_proxy(_,_,_)), 557 catch(proxy_test(http_open(URL, StreamPair, []), 558 close(StreamPair), 559 _SocksProxyAttempts, 560 _HTTPProxyAttempts), 561 Error, 562 Exception = Error), 563 assertion(nonvar(Exception)). 564 565test('Request HTTPS url via proxy - should get HTTP CONNECT and not HTTP GET', 566 condition(port(https_endpoint, HTTPS_port))) :- 567 port(http_proxy, HTTP_PROXY_port), 568 format(atom(URL), 'https://localhost:~w', [HTTPS_port]), 569 retractall(test_proxy(_,_,_)), 570 assert(test_proxy(_, _, [proxy(localhost, HTTP_PROXY_port)])), 571 proxy_test(http_open(URL, 572 StreamPair, 573 [ cert_verify_hook(cert_accept_any) 574 ]), 575 close(StreamPair), 576 SocksProxyAttempts, 577 HTTPProxyAttempts), 578 assertion(HTTPProxyAttempts == [connect(localhost:HTTPS_port)]), 579 assertion(SocksProxyAttempts == []). 580 581:- multifile 582 http:http_connection_over_proxy/6. 583 584http:http_connection_over_proxy( 585 proxy(ProxyHost, ProxyPort, User, Pass), 586 _Parts, _, StreamPair, Options, 587 [proxy_authorization(basic(User, Pass))|Options]) :- 588 tcp_connect(ProxyHost:ProxyPort, StreamPair, 589 [ bypass_proxy(true) 590 | Options 591 ]), 592 stream_pair(StreamPair, In, _Out), 593 set_stream(In, record_position(false)), 594 ( option(timeout(Timeout), Options) 595 -> set_stream(In, timeout(Timeout)) 596 ; true 597 ). 598 599test('Test an exotic application-level proxy - http with authentication'):- 600 port(http_endpoint, HTTP_port), 601 port(http_proxy, HTTP_PROXY_port), 602 format(atom(URL), 'http://localhost:~w', [HTTP_port]), 603 retractall(test_proxy(_,_,_)), 604 assert(test_proxy(_, _, [ proxy(localhost, HTTP_PROXY_port, 605 username, password) 606 ])), 607 proxy_test(http_open(URL, StreamPair, []), 608 close(StreamPair), 609 SocksProxyAttempts, 610 HTTPProxyAttempts), 611 assertion(SocksProxyAttempts == []), 612 assertion(HTTPProxyAttempts == [authenticated_get(URL)]). 613 614:- end_tests(proxy). 615 616 /******************************* 617 * MESSAGE TRICKS * 618 *******************************/ 619 620:- meta_predicate 621 catch_messages(0, -). 622 623catch_messages(Goal, Messages) :- 624 nb_setval(messages, []), 625 thread_self(Me), 626 setup_call_cleanup(assert((user:message_hook(Msg, _, _) :- 627 catch_message(Me, Msg)), 628 Ref), 629 once(Goal), 630 collect_messages(Messages, Ref)). 631 632catch_message(Me, Msg) :- 633 thread_self(Me), 634 !, 635 nb_getval(messages, L0), 636 duplicate_term(Msg, Copy), 637 nb_linkval(messages, [Copy|L0]). 638 639collect_messages(Messages, Ref) :- 640 erase(Ref), 641 nb_getval(messages, L), 642 nb_delete(messages), 643 reverse(L, Messages). 644