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
7    This demo code is released in the _public domain_, which implies
8    you may copy, modify and reuse this code without restriction.
9*/
10
11:- module(https,
12          [ http_download/2,                    % +URL, -String
13
14            http_server/1,                      % ?Port
15            https_server/1,                     % ?Port
16            https_server_with_client_cert/1,    % ?Port
17
18            http_client/2,                      % +Port, +Page
19            https_client/2,                     % +Port, +Page
20            https_client_with_client_cert/2     % +Port, +Page
21          ]).
22
23% Include  our  dependencies.  The  conditions  are  to  accomodate  for
24% different locations of some of  the  files   in  the  source  tree and
25% examples tree.
26
27:- prolog_load_context(directory, D),
28   atom_concat(D, '/..', DD),
29   asserta(user:file_search_path(library, DD)).
30:- if(exists_source(library(http/examples/demo_body))).
31:- use_module(library(http/examples/demo_body)).    % location in source tree
32:- elif(exists_source(swi(doc/packages/examples/http/demo_body))).
33:- use_module(swi(doc/packages/examples/http/demo_body)).
34:- else.
35:- use_module(library(http/demo_body)).             % location in demo tree
36:- endif.
37:- use_module(library(http/thread_httpd)).
38:- if(exists_source(library(http/http_ssl_plugin))).
39:- use_module(library(http/http_ssl_plugin)).
40:- else.
41:- use_module(http_ssl_plugin).
42:- endif.
43:- use_module(library(debug)).
44
45/** <module> Demo HTTPS server
46
47This demo illustrates how to use the SSL library for dealing with HTTPS.
48It provides examples for simple download of HTTPS documents from the web
49and provides demo code  for  several   HTTPS  servers  and corresponding
50client code using  (self-signed)  certificates.   The  certificates  are
51provided in the  `etc`  directory.  These   certificates  are  the  same
52certificates that are used for testing the SSL library. You may use them
53for testing purposes, but you should not  use them for your own services
54because the private key is not so private.
55
56This demo implements three different servers:
57
58  - http_server/1 implements a typical HTTP server.
59  - https_server/1 implements a typical HTTPS server.
60  - https_server_with_client_cert/1 implements a server that asks
61
62The startup sequence to run the  server   at  port  1443 is shown below.
63Directing your browser to the indicated URL should cause your browser to
64warn you about an untrusted certificate. After accepting you can use the
65simple demo through HTTPS.
66
67  ==
68  $ swipl https.pl
69  ...
70  ?- https_server(1443).
71  % Started server at https://localhost:1443/
72  true.
73  ==
74
75The demo is primarily intended to  access   from  a  browser, but at the
76bottom of this file are predicates to access the server from Prolog. The
77first argument is the port and must be the same as the value returned by
78or given to the *_server predicate. The   second  is the location on the
79server, e.g., `/`, `/quit`, `/env`, etc.
80
81  - http_client/2 accesses http_server/1.
82  - https_client/2 accesses https_server/1.
83  - https_client_with_client_cert/2 accesses https_server_with_client_cert/1.
84
85An example session is given  below.  Now   that  you  can either run the
86client calls from the Prolog window in   which you started the server or
87load this file into another Prolog.
88
89  ==
90  ?- https_client(1443, '/quit').
91  Bye Bye
92  true.
93  ==
94*/
95
96%!  http_download(+URL, -Data) is det.
97%
98%   Download data from an HTTP or HTTPS   server.  If HTTPS is used,
99%   the certificate is verified  by   the  system's root certificate
100%   store.  This  means  you  cannot  download  from  servers  using
101%   self-signed certificates, but  you  can   download  from  proper
102%   public websites with official authorized keys.  For example:
103%
104%     ==
105%     ?- http_download('https://raw.githubusercontent.com\c
106%                      /SWI-Prolog/packages-ssl/master/README.md',
107%                      String).
108%     ==
109
110http_download(URL, String) :-
111    http_open(URL, In, []),
112    call_cleanup(
113        read_string(In, _, String),
114        close(In)).
115
116%!  http_server(?Port) is det.
117%
118%   Our baseline is a plain HTTP server.  No HTTPS involved here. We
119%   give it for the case you want to do timing and other experiments
120%   comparing the HTTP with HTTPS.
121
122http_server(Port) :-
123    http_server(reply,
124                [ port(Port)
125                ]).
126
127
128%!  https_server(?Port) is det.
129%
130%   Start an HTTPS demo server at Port.   Compared  to a normal HTTP
131%   server, this requires two additional SSL components:
132%
133%     1. The server certificate.  This is basically a public
134%     key, so there is no need to keep this secret.
135%     2. The server private key.  If someone manages to grab
136%     this key, he can setup a server that claims to be you.
137%     There are two ways to protect it.  One is to make sure
138%     the file cannot be obtained and the other is to protect
139%     it using a password and make sure that the password is
140%     kept secret.  Our server uses a password, but it is not
141%     very secret.  See also the `pem_password_hook` option
142%     of ssl_context/3.
143%
144%   Note that anyone can access this  server. You can implement HTTP
145%   authentication or cookie based password login in the application
146%   to realise a safe login procedure  where attackers cannot easily
147%   steal the HTTP authentication token or cookie.
148
149https_server(Port) :-
150    http_server(reply,
151                [ port(Port),
152                  ssl([ certificate_file('etc/server/server-cert.pem'),
153                        key_file('etc/server/server-key.pem'),
154                        password("apenoot1")
155                      ])
156                ]).
157
158
159%!  https_server_with_client_cert(?Port)
160%
161%   Our second server  is  a  setup   that  is  typically  used  for
162%   administrative tasks where users  are   handed  a certificate to
163%   login. In our example, we use the client certificate and private
164%   key that can be found in etc/client.   First  of all, we need to
165%   combine these into a `.p12` (PKCS12)   file.  This is done using
166%   `openssl`  as  below.  We  provide  the    .p12  file  for  your
167%   convenience.
168%
169%     ==
170%     $ openssl pkcs12 -export \
171%           -inkey client-key.pem -in client-cert.pem \
172%           -name jan -out client-cert.p12
173%     Enter pass phrase for client-key.pem: apenoot2
174%     Enter Export Password: secret
175%     ==
176%
177%   Next, import `client-cert.p12` into your   browser. For firefox,
178%   this is in   Edit/Preference/Advanced/View  Certificates/Import.
179%   When requested for the password, enter "secret".
180
181https_server_with_client_cert(Port) :-
182    http_server(reply,
183                [ port(Port),
184                  ssl([ certificate_file('etc/server/server-cert.pem'),
185                        key_file('etc/server/server-key.pem'),
186                        password("apenoot1"),
187                        peer_cert(true),
188                        cacert_file('etc/demoCA/cacert.pem'),
189                        cert_verify_hook(client_cert_verify)
190                      ])
191                ]).
192
193%!  client_cert_verify(+SSL,
194%!                     +ProblemCert, +AllCerts, +FirstCer,
195%!                     +Error) is semidet.
196%
197%   This hook is called for  validating   the  peer certificate. The
198%   certificate has already been validated   against the known _root
199%   certificates_ and Error either contains   `verified` to indicate
200%   that this part of the  validation   was  successful or a message
201%   from OpenSSL indicating why it did   not verify. The certificate
202%   is accepted if this hook  succeeds,   regardless  of the initial
203%   verification. If this hook  is   not  defined, certificates that
204%   verify against the root certificates are accepted and others are
205%   rejected, i.e., the default implementation  behaves as `Error ==
206%   verified`.
207
208% :- debug(cert_verify_hook).
209
210:- public
211    client_cert_verify/5.
212
213client_cert_verify(_SSL, _Problem, _AllCerts, First, Error) :-
214    debug(cert_verify_hook,
215          'Handling client certificate verification~n\c
216              Certificate: ~p, error: ~w~n', [First, Error]).
217
218
219                 /*******************************
220                 *            CLIENTS           *
221                 *******************************/
222
223:- use_module(library(http/http_open)).
224
225%!  http_client(+Port, +Page) is det.
226%
227%   Access the server created with http_server/1. Note that the only
228%   significant difference to  https_client/2  is   the  URL  scheme
229%   (`http` vs. `https`.
230
231http_client(Port, Page) :-
232    format(atom(URL), 'http://localhost:~d~w', [Port, Page]),
233    http_open(URL, In,
234              [
235                  ]),
236    copy_stream_data(In, current_output),
237    close(In).
238
239%!  https_client(+Port, +Page) is det.
240%
241%   Access the server created with https_server/1.  Note that, as we
242%   are using a self-signed  certificate,  we   pass  our  own  root
243%   certificate instead of using the system one.
244
245https_client(Port, Page) :-
246    format(atom(URL), 'https://localhost:~d~w', [Port, Page]),
247    http_open(URL, In,
248              [ cacert_file('etc/demoCA/cacert.pem')
249              ]),
250    copy_stream_data(In, current_output),
251    close(In).
252
253%!  https_client_with_client_cert(+Port, +Page) is det.
254%
255%   Access the server created  with https_server_with_client_cert/1,
256%   providing our client certificate.
257
258https_client_with_client_cert(Port, Page) :-
259    format(atom(URL), 'https://localhost:~d~w', [Port, Page]),
260    http_open(URL, In,
261              [ cacert_file('etc/demoCA/cacert.pem'),
262                certificate_file('etc/client/client-cert.pem'),
263                key_file('etc/client/client-key.pem'),
264                password('apenoot2')
265              ]),
266    copy_stream_data(In, current_output),
267    close(In).
268