1/*  Part of SWI-Prolog
2
3    Author:        Jan Wielemaker and Matt Lilley
4    E-mail:        J.Wielemaker@vu.nl
5    WWW:           http://www.swi-prolog.org
6    Copyright (c)  2018, VU University Amsterdam
7			 CWI, 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(mkcerts,
37          [ make_ssl_test_data/0,
38            make_ssl_test_data/2        % +SrcDir, +CertDir
39          ]).
40:- use_module(library(process)).
41:- use_module(library(apply)).
42:- use_module(library(lists)).
43:- use_module(library(filesex)).
44:- use_module(library(pure_input)).
45:- use_module(library(readutil)).
46:- use_module(library(main)).
47:- use_module(library(option)).
48:- use_module(library(debug)).
49:- use_module(library(dcg/basics)).
50:- use_module(library(error)).
51
52:- initialization(main, main).
53
54openssl_executable('@PROG_OPENSSL@').
55
56/** <module> Create SSL test certificates
57
58This  module  uses  the  `openssl`   program    to   generate  the  test
59certificates. It is derived from `mkcerts.sh`  written by Matt Lilley. A
60Prolog version enables building and   testing  in non-POSIX environments
61and is hopefully a little easier to  understand. This module was adapted
62to generate the certificates in a   different  directory than the config
63files such that we can generate these in the CMAKE binary directory.
64*/
65
66main(Argv) :-
67    argv_options(Argv, _, Options),
68    (   option(debug(true), Options)
69    ->  debug(mkcerts)
70    ;   true
71    ),
72    (   option(dest(Dir), Options)
73    ->  working_directory(_, Dir)
74    ;   true
75    ),
76    option(source(SrcDir), Options),
77    make_ssl_test_data(SrcDir, test_certs),
78    clean_old(test_certs).
79
80make_ssl_test_data :-
81    make_ssl_test_data('../../../packages/ssl/tests', test_certs).
82
83make_ssl_test_data(SrcDir, TestDir) :-
84    clean_output(TestDir),
85    make_ca(TestDir/rootCA, file(SrcDir/'rootCA.cnf'), [], -selfsign),
86    simple_signed_certs(SrcDir, TestDir),
87    make_14(SrcDir, TestDir),
88    modify_11(SrcDir, TestDir),
89    modify_15(SrcDir, TestDir),
90
91    forall(between(18,22,I), intermediary_cert(SrcDir, TestDir, I)),
92    forall(between(23,24,I), crl_cert(SrcDir, TestDir, I)),
93
94    % Certificate 23 has a CRL but has not been revoked
95    % Certificate 24 has a CRL and HAS been revoked
96    openssl([ca, -config, file(SrcDir/'24.cnf'),
97             -revoke, file(TestDir/'24-cert.pem'), -batch, -notext,
98             -key, apenoot]),
99
100    % Certificates 25-27 needs their own CA
101    forall(between(25,27,I), own_ca(SrcDir, TestDir, I)),
102
103    % Revoke the 27 CA certificate from the root
104    openssl([ca, -config, file(SrcDir/'27.cnf'), -revoke,
105             file(TestDir/'27_CA'/'cacert.pem'), -batch,
106             -notext, -key, apenoot]),
107    % Revoke the 26 tail certificate from the 26 CA
108    openssl([ca, -config, file(SrcDir/'26_tail.cnf'),
109             -revoke, file(TestDir/'26-tail-cert.pem'), -batch,
110             -notext, -key, apenoot]),
111    % Generate the root CRL
112    openssl([ca, -config, file(SrcDir/'23.cnf'), -gencrl,
113             -out, file(TestDir/'rootCA-crl.pem')]),
114    % Generate the 25-27 CA CRLS
115    forall(between(25,27,I),
116           openssl([ ca, -config, file(SrcDir/(I+'_tail.cnf')), -gencrl,
117                     -out, file(TestDir/I+'-crl.pem')])),
118
119    % Finally, generate the certificates for all the pre-existing tests:
120    % The server
121    openssl([ req, -new, -config, file(SrcDir/'server.cnf'),
122              -out, file('server.csr'), -nodes,
123              -keyout, file(TestDir/'server-key.pem')]),
124    openssl([ ca, -config, file(SrcDir/'server.cnf'), -batch, -notext,
125              -key, apenoot, -policy, policy_anything,
126              -out, file(TestDir/'server-cert.pem'),
127              -infiles, file('server.csr')]),
128    % The client
129    openssl([ req, -new, -config, file(SrcDir/'client.cnf'),
130              -out, file('client.csr'), -nodes,
131              -keyout, file(TestDir/'client-key.pem')]),
132    openssl([ ca, -config, file(SrcDir/'client.cnf'), -batch, -notext,
133              -key, apenoot, -policy, policy_anything,
134              -out, file(TestDir/'client-cert.pem'),
135              -infiles, file('client.csr')]).
136
137own_ca(SrcDir, TestDir, I) :-
138    atom_concat(I, '_CA', CA),
139    atom_concat(I, '.cnf', Config),
140    make_ca(TestDir/CA, file(SrcDir/Config), [-nodes], []),
141
142    % Generate a CSR (All of these tests relate to the
143    % intermediate CA, not the certificate at the end of the chain)
144    openssl([ req, -new, -config, file(SrcDir/(I+'_tail.cnf')),
145              -out, file(I+'.csr'), -nodes,
146              -keyout, file(TestDir/(I+'-key.pem'))]),
147    % Sign the CSR. We need our own config here because we
148    % want copy_extensions on so we can preserve SubjectAltNames
149    openssl([ ca, -config, file(SrcDir/(I+'_tail.cnf')), -notext, -batch,
150              -key, apenoot, -policy, policy_anything,
151              -out, file(TestDir/(I+'-tail-cert.pem')),
152              -infiles, file(I+'.csr')]),
153    % Finally put the CA and the server cert into one file
154    cat_files([ TestDir/(I+'-tail-cert.pem'),
155                TestDir/(I+'_CA/cacert.pem')
156              ],
157              TestDir/(I+'-cert.pem')).
158
159
160crl_cert(SrcDir, TestDir, I) :-
161    openssl([ req, -new, -config, file(SrcDir/(I+'.cnf')),
162              -out, file(I+'.csr'), -nodes,
163              -keyout, file(TestDir/I+'-key.pem')]),
164    openssl([ ca, -config, file(SrcDir/(I+'.cnf')), -batch, -notext,
165              -key, apenoot, -policy, policy_anything,
166              -out, file(TestDir/(I+'-cert.pem')),
167              -infiles, file(I+'.csr')]).
168
169
170intermediary_cert(SrcDir, TestDir, I) :-
171    atom_concat(I, '_CA', CA),
172    atom_concat(I, '.cnf', Config),
173    make_ca(TestDir/CA, file(SrcDir/Config), [-nodes], []),
174
175    % Generate a CSR (All of these tests relate to the intermediate
176    % CA, not the certificate at the end of the chain
177    openssl([ req, -new, -config, file(SrcDir/(I+'_tail.cnf')),
178              -out, file(I+'.csr'), -nodes,
179              -keyout, file(TestDir/(I+'-key.pem'))]),
180    % Sign the CSR. We need our own config here because we want
181    % copy_extensions on so we can preserve SubjectAltNames
182    openssl([ ca, -config, file(SrcDir/(I+'_tail.cnf')), -notext, -batch,
183              -key, apenoot, -policy, policy_anything,
184              -out, file(TestDir/(I+'-tail-cert.pem')),
185              -infiles, file(I+'.csr')]),
186    % Finally put the CA and the server cert into one file
187    cat_files([ TestDir/(I+'-tail-cert.pem'),
188                TestDir/(I+'_CA/cacert.pem')
189              ],
190              TestDir/(I+'-cert.pem')).
191
192
193%!  modify_11(SrcDir, TestDir)
194%
195%   Hack certificate 11 to add in some   embedded NULLs. The openssl req
196%   utility cannot do this, but we can...
197
198modify_11(SrcDir, TestDir) :-
199    % First, convert PEM -> DER so we can hack on it
200    openssl([ req, -in, file('11.csr'), -out, file('11.der'),
201              -outform, 'DER']),
202    % Then substitute  0x4E,0x55,0x4C,0x4C for the word 0,0,0,0
203    read_file_to_codes('11.der', Codes, [type(binary)]),
204    once(append(Prefix, [0x4E,0x55,0x4C,0x4C|T], Codes)),
205    append(Prefix, [0,0,0,0|T], NewCodes),
206    create_file('11-modified.der', NewCodes, [type(binary)]),
207    % Next we must update the signature. First, get the stuff which is hashed
208    openssl([ asn1parse, -in, file('11-modified.der'), -inform, der,
209              -strparse, 4, -out, '11-hashdata.der']),
210    % Then sign it using our private key
211    openssl([ dgst, -sha256, -sign, file(TestDir/'11-key.pem'),
212              -out, '11-signature.der', '11-hashdata.der' ]),
213    % Then grab the bit of the modified file which is not the
214    % signature and overwrite the original certificate
215    read_but_n_bytes_from_file('11-modified.der', 256, Der11),
216    read_file_to_codes('11-signature.der', Sig11, [type(binary)]),
217    append(Der11, Sig11, Der11b),
218    create_file('11.der', Der11b, [type(binary)]),
219    % Convert back to PEM
220    openssl([ req, -outform, 'PEM', -inform, 'DER',
221              -in, file('11.der'), -out, file('11.csr')]),
222    % Then re-sign it as if nothing unusual has just happened. Easy.
223    openssl([ ca, -config, file(SrcDir/'11.cnf'), -batch, -key, apenoot,
224              -policy, policy_anything,
225              -out, file(TestDir/'11-cert.pem'), -infiles, file('11.csr')]).
226
227
228%!  make_14(+SrcDir, +TestDir)
229%
230%   14 is to be signed by a completely different CA.
231
232make_14(SrcDir, TestDir) :-
233    make_ca(TestDir/'14_CA', file(SrcDir/'14.cnf'), [-nodes], [-selfsign]),
234    I = 14,
235    make_csr(TestDir, I, file(SrcDir/(I+'_tail.cnf'))),
236    sign_csr(TestDir, I, file(SrcDir/(I+'_tail.cnf'))).
237
238%!  modify_15(+SrcDir, +TestDir)
239%
240%   Hack certificate 15 by changing 5  characters   near  the end of the
241%   certificate to AAAAA. Obviously if they  are already AAAAA then this
242%   wont work, but that is pretty  unlikely.   Do  not change the last 3
243%   since base64 coding would require us to   work out the length of the
244%   file and add appropriate number of = signs
245
246modify_15(_SrcDir, TestDir) :-
247    path_file(TestDir/'15-cert.pem', File),
248    phrase_from_file(modify_15(New), File),
249    create_file(File, New).
250
251modify_15(New) -->
252    string(Prefix),
253    [_,_,_,_,_],
254    [A,B,C],
255    `\n-----END CERTIFICATE-----\n`,
256    !,
257    { append([ Prefix, `AAAAA`, [A,B,C],
258               `\n-----END CERTIFICATE-----\n`
259             ], New)
260    }.
261
262
263
264
265% Certificates 1-17 are all signed by the CA, except 14
266
267simple_signed_certs(SrcDir, TestDir) :-
268    forall(( between(1,17,I), I \== 14 ),
269           ( make_csr(TestDir, I, file(SrcDir/(I+'.cnf'))),
270             sign_csr(TestDir, I, file(SrcDir/(I+'.cnf'))) )).
271
272
273make_csr(TestDir, I, Config) :-
274    openssl([ req, -new,
275              -config, Config, -out, file(I+'.csr'),
276              -nodes, -keyout, file(TestDir/(I+'-key.pem'))]).
277
278sign_csr(TestDir, I, Config) :-
279    openssl([ ca, -config, Config, -batch, -notext, -key, apenoot,
280              -policy, policy_anything,
281              -out, file(TestDir/(I+'-cert.pem')),
282              -infiles, file(I+'.csr')]).
283
284
285
286%!  make_ca(+Spec, +Config, +Options1, +Options2)
287%
288%   Create a root CA in Dir.
289
290make_ca(Spec, Config, Options1, Options2) :-
291    path_file(Spec, Dir),
292    forall(ca_dir(SubDir),
293           (   directory_file_path(Dir, SubDir, Path),
294               make_directory_path(Path))),
295    touch(Dir/'index.txt'),
296    create_file(Dir/crlnumber, "01\n"),
297    create_file(Dir/serial,    "1000\n"),
298
299    openssl([req, -new, -config, Config, Options1, % HACK
300             -keyout, file(Dir/'private/cakey.pem'),
301             -out, file(Dir/'careq.pem')]),
302
303    openssl([ca, -config, Config, -notext, -create_serial, Options2,
304             -batch, -key, apenoot, -extensions, v3_ca,
305             -out, file(Dir/'cacert.pem'),
306             -infiles, file(Dir/'careq.pem')]).
307
308ca_dir(certs).
309ca_dir(crl).
310ca_dir(newcerts).
311ca_dir(private).
312
313openssl(Args) :-
314    flatten(Args, Args1),
315    maplist(process_arg, Args1, Args2),
316    debug(mkcerts, 'openssl(~q)', [Args2]),
317    (   openssl_executable(OpenSSL)
318    ->  true
319    ;   OpenSSL = path(openssl)
320    ),
321    process_create(OpenSSL, Args2,
322                   [ stderr(pipe(Error)),
323                     stdout(null),
324                     process(PID)
325                   ]),
326    read_string(Error, _, ErrorMsg),
327    process_wait(PID, Status),
328    (   Status == exit(0)
329    ->  true
330    ;   throw(error(openssl_error(Status, ErrorMsg), _))
331    ).
332
333process_arg(-Arg, Opt) :-
334    !,
335    atom_concat(-, Arg, Opt).
336process_arg(file(Path), file(File)) :-
337    !,
338    path_file(Path, File).
339process_arg(Arg, Arg).
340
341%!  path_file(+Segments, -File)
342%
343%   Expand a term a/b/.. into a file name.  Each segment can be a term
344%   A+B+...
345
346path_file(Segments, File) :-
347    must_be(ground, Segments),
348    phrase(segment_list(Segments), List),
349    atomic_list_concat(List, File).
350
351segment_list(A/B) -->
352    !,
353    segment_list(A),
354    [/],
355    segment_list(B).
356segment_list(A+B) -->
357    !,
358    segment_list(A),
359    segment_list(B).
360segment_list(A) -->
361    [A].
362
363%!  create_file(+Path, +Content) is det.
364%
365%   Create a file at Path that contains Content.
366
367create_file(Path, Content) :-
368    create_file(Path, Content, []).
369
370create_file(Path, Content, Options) :-
371    path_file(Path, File),
372    setup_call_cleanup(
373        open(File, write, Out, Options),
374        format(Out, '~s', [Content]),
375        close(Out)).
376
377touch(Path) :-
378    path_file(Path, File),
379    setup_call_cleanup(
380        open(File, update, Out),
381        true,
382        close(Out)).
383
384clean_output(Dir) :-
385    exists_directory(Dir),
386    !,
387    delete_directory_and_contents(Dir).
388clean_output(_).
389
390%!  read_but_n_bytes_from_file(+File, +Count, -Bytes)
391
392read_but_n_bytes_from_file(File, Count, Bytes) :-
393    size_file(File, Size),
394    Read is Size - Count,
395    setup_call_cleanup(
396        open(File, read, In, [type(binary)]),
397        read_string(In, Read, String),
398        close(In)),
399    string_codes(String, Bytes).
400
401
402%!  cat_files(+Files, +Output)
403
404cat_files(Files, Output) :-
405    path_file(Output, OutFile),
406    setup_call_cleanup(
407        open(OutFile, write, Out, [type(binary)]),
408        maplist(cat_into(Out), Files),
409        close(Out)).
410
411cat_into(Out, Path) :-
412    path_file(Path, File),
413    setup_call_cleanup(
414        open(File, read, In, [type(binary)]),
415        copy_stream_data(In, Out),
416        close(In)).
417
418%!  clean_old(Dir) is det.
419%
420%   Remove *.old files from the certificates.
421
422clean_old(Dir) :-
423    forall(directory_member(Dir, OldFile,
424                            [ recursive(true),
425                              matches('*.old')
426                            ]),
427           delete_file(OldFile)).
428
429
430		 /*******************************
431		 *             MESSAGES		*
432		 *******************************/
433
434:- multifile prolog:error_message//1.
435
436prolog:error_message(openssl_error(Status, Message)) -->
437    { split_string(Message, "\n", "", Lines) },
438    [ 'openssl failed with status ~p'-[Status], nl ],
439    lines(Lines).
440
441lines([]) --> [].
442lines([H|T]) --> [nl, '~s'-[H]], lines(T).
443