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) 2007-2018, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(http_ssl_plugin, []). 37:- use_module(library(ssl)). 38:- use_module(library(socket)). 39:- use_module(library(debug)). 40:- use_module(library(option)). 41:- use_module(library(http/thread_httpd)). 42:- use_module(library(http/http_header)). 43 44/** <module> SSL plugin for HTTP libraries 45 46This module can be loaded next to library(thread_httpd) and 47library(http_open) to provide secure HTTP (HTTPS) services and client 48access. 49 50An example secure server using self-signed certificates can be found in 51the <plbase>/doc/packages/examples/ssl/https.pl, where <plbase> is the 52SWI-Prolog installation directory. 53*/ 54 55:- multifile 56 thread_httpd:make_socket_hook/3, 57 thread_httpd:accept_hook/2, 58 thread_httpd:open_client_hook/6, 59 http:http_protocol_hook/5, 60 http:open_options/2, 61 http:http_connection_over_proxy/6, 62 http:ssl_server_create_hook/3, 63 http:ssl_server_open_client_hook/3. 64 65 66 /******************************* 67 * SERVER HOOKS * 68 *******************************/ 69 70%! thread_httpd:make_socket_hook(?Port, :OptionsIn, -OptionsOut) 71%! is semidet. 72% 73% Hook into http_server/2 to create an SSL server if the option 74% ssl(SSLOptions) is provided. 75% 76% @see thread_httpd:accept_hook/2 handles the corresponding accept 77 78thread_httpdmake_socket_hook(Port, M:Options0, Options) :- 79 select(ssl(SSLOptions0), Options0, Options1), 80 !, 81 add_secure_ciphers(SSLOptions0, SSLOptions1), 82 disable_sslv3(SSLOptions1, SSLOptions), 83 make_socket(Port, Socket, Options1), 84 ssl_context(server, SSL0, M:SSLOptions), 85 ( http:ssl_server_create_hook(SSL0, SSL, Options1) 86 -> true 87 ; SSL = SSL0 88 ), 89 atom_concat('httpsd', Port, Queue), 90 Options = [ queue(Queue), 91 tcp_socket(Socket), 92 ssl_instance(SSL) 93 | Options1 94 ]. 95 96%! add_secure_ciphers(+SSLOptions0, -SSLOptions) 97% 98% Add ciphers from ssl_secure_ciphers/1 if no ciphers are provided. 99 100add_secure_ciphers(SSLOptions0, SSLOptions) :- 101 ( option(cipher_list(_), SSLOptions0) 102 -> SSLOptions = SSLOptions0 103 ; ssl_secure_ciphers(Ciphers), 104 SSLOptions = [cipher_list(Ciphers)|SSLOptions0] 105 ). 106 107%! disable_sslv3(+SSLOptions0, -SSLOptions) 108% 109% Disable SSLv3, which is considered insecure unless the caller 110% specifies the allowed versions explicitly, so we assume s/he knows 111% what s/he is doing. 112 113disable_sslv3(SSLOptions0, SSLOptions) :- 114 ( option(min_protocol_version(_), SSLOptions0) 115 ; option(disable_ssl_methods(_), SSLOptions0) 116 ), 117 !, 118 SSLOptions = SSLOptions0. 119disable_sslv3(SSLOptions0, 120 [ disable_ssl_methods([sslv3,sslv23]), % old OpenSSL versions 121 min_protocol_version(tlsv1) % OpenSSL 1.1.0 and later 122 | SSLOptions0 123 ]). 124 125 126make_socket(_Port, Socket, Options) :- 127 option(tcp_socket(Socket), Options), 128 !. 129make_socket(Port, Socket, _Options) :- 130 tcp_socket(Socket), 131 tcp_setopt(Socket, reuseaddr), 132 tcp_bind(Socket, Port), 133 tcp_listen(Socket, 5). 134 135 136%! thread_httpd:accept_hook(:Goal, +Options) is semidet. 137% 138% Implement the accept for HTTPS connections. 139 140thread_httpdaccept_hook(Goal, Options) :- 141 memberchk(ssl_instance(SSL), Options), 142 !, 143 memberchk(queue(Queue), Options), 144 memberchk(tcp_socket(Socket), Options), 145 tcp_accept(Socket, Client, Peer), 146 debug(http(connection), 'New HTTPS connection from ~p', [Peer]), 147 http_enough_workers(Queue, accept, Peer), 148 thread_send_message(Queue, ssl_client(SSL, Client, Goal, Peer)). 149 150%! http:ssl_server_create_hook(+SSL0, -SSL, +Options) is semidet. 151% 152% Extensible predicate that is called once after creating an HTTPS 153% server. If this predicate succeeds, SSL is the context that is used 154% for negotiating new connections. Otherwise, SSL0 is used, which is 155% the context that was created with the given options. 156% 157% @see ssl_context/3 for creating an SSL context 158 159 160%! http:ssl_server_open_client_hook(+SSL0, -SSL, +Options) is semidet. 161% 162% Extensible predicate that is called before each connection that the 163% server negotiates with a client. If this predicate succeeds, SSL is 164% the context that is used for the new connection. Otherwise, SSL0 is 165% used, which is the context that was created when launching the 166% server. 167% 168% @see ssl_context/3 for creating an SSL context 169 170 171thread_httpdopen_client_hook(ssl_client(SSL0, Client, Goal, Peer), 172 Goal, In, Out, 173 [peer(Peer), protocol(https)], 174 Options) :- 175 ( http:ssl_server_open_client_hook(SSL0, SSL1, Options) 176 -> true 177 ; SSL1 = SSL0 178 ), 179 option(timeout(TMO), Options, 60), 180 tcp_open_socket(Client, Read, Write), 181 set_stream(Read, timeout(TMO)), 182 set_stream(Write, timeout(TMO)), 183 ssl_set_options(SSL1, SSL, [close_parent(true)]), 184 catch(ssl_negotiate(SSL, Read, Write, In, Out), 185 E, 186 ssl_failed(Read, Write, E)). 187 188ssl_failed(Read, Write, E) :- 189 close(Write, [force(true)]), 190 close(Read, [force(true)]), 191 throw(E). 192 193 194 /******************************* 195 * CLIENT HOOKS * 196 *******************************/ 197 198%! http:http_protocol_hook(+Scheme, +Parts, +PlainStreamPair, 199%! -StreamPair, +Options) is semidet. 200% 201% Hook for http_open/3 to connect to an HTTPS (SSL-based HTTP) 202% server. This plugin also passes the default option 203% `cacert_file(system(root_certificates))` to ssl_context/3. 204 205httphttp_protocol_hook(https, Parts, PlainStreamPair, StreamPair, Options) :- 206 ssl_protocol_hook(Parts, PlainStreamPair, StreamPair, Options). 207httphttp_protocol_hook(wss, Parts, PlainStreamPair, StreamPair, Options) :- 208 ssl_protocol_hook(Parts, PlainStreamPair, StreamPair, Options). 209 210ssl_protocol_hook(Parts, PlainStreamPair, StreamPair, Options) :- 211 memberchk(host(Host), Parts), 212 ssl_context(client, SSL, [ host(Host), 213 close_parent(true) 214 | Options 215 ]), 216 stream_pair(PlainStreamPair, PlainIn, PlainOut), 217 % if an exception arises, http_open/3 closes the stream for us 218 ssl_negotiate(SSL, PlainIn, PlainOut, In, Out), 219 stream_pair(StreamPair, In, Out). 220 221%! http:open_options(Parts, Options) is nondet. 222% 223% Implementation of the multifile hook http:open_options/2 used by 224% library(http/http_open). By default, we use the system trusted 225% root certificate database for validating an SSL certificate. 226 227httpopen_options(Parts, Options) :- 228 memberchk(scheme(S), Parts), 229 ssl_scheme(S), 230 Options = [cacert_file(system(root_certificates))]. 231 232ssl_scheme(https). 233ssl_scheme(wss). 234 235%! http:http_connection_over_proxy(+Proxy, +Parts, +HostPort, -StreamPair, 236%! +OptionsIn, -OptionsOut) 237% 238% Facilitate an HTTPS connection via a proxy using HTTP CONNECT. 239% Note that most proxies will only support this for connecting on 240% port 443 241 242httphttp_connection_over_proxy(proxy(ProxyHost, ProxyPort), Parts, 243 Host:Port, StreamPair, Options, Options) :- 244 memberchk(scheme(https), Parts), 245 !, 246 tcp_connect(ProxyHost:ProxyPort, StreamPair, [bypass_proxy(true)]), 247 catch(negotiate_http_connect(StreamPair, Host:Port), 248 Error, 249 ( close(StreamPair, [force(true)]), 250 throw(Error) 251 )). 252 253negotiate_http_connect(StreamPair, Address):- 254 format(StreamPair, 'CONNECT ~w HTTP/1.1\r\n\r\n', [Address]), 255 flush_output(StreamPair), 256 http_read_reply_header(StreamPair, Header), 257 memberchk(status(_, Status, Message), Header), 258 ( Status == ok 259 -> true 260 ; throw(error(proxy_rejection(Message), _)) 261 )