1 /* Part of SWI-Prolog
2
3 Author: Matt Lilley and Markus Triska
4 WWW: http://www.swi-prolog.org
5 Copyright (c) 2004-2017, SWI-Prolog Foundation
6 VU University Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #include <config.h>
36 #include <assert.h>
37 #include <string.h>
38 #include <SWI-Stream.h>
39 #include <SWI-Prolog.h>
40 #include <openssl/hmac.h>
41 #include <openssl/rand.h>
42 #ifdef HAVE_OPENSSL_KDF_H
43 #include <openssl/kdf.h>
44 #endif
45 #include "cryptolib.c"
46
47 static atom_t ATOM_sslv23;
48 static atom_t ATOM_minus; /* "-" */
49 static atom_t ATOM_text;
50 static atom_t ATOM_octet;
51 static atom_t ATOM_utf8;
52
53 static atom_t ATOM_md5;
54 static atom_t ATOM_sha1;
55 static atom_t ATOM_sha224;
56 static atom_t ATOM_sha256;
57 static atom_t ATOM_sha384;
58 static atom_t ATOM_sha512;
59 static atom_t ATOM_blake2s256;
60 static atom_t ATOM_blake2b512;
61 static atom_t ATOM_sha3_224;
62 static atom_t ATOM_sha3_256;
63 static atom_t ATOM_sha3_384;
64 static atom_t ATOM_sha3_512;
65 static atom_t ATOM_ripemd160;
66
67 static atom_t ATOM_pkcs1;
68 static atom_t ATOM_pkcs1_oaep;
69 static atom_t ATOM_none;
70 static atom_t ATOM_block;
71 static atom_t ATOM_algorithm;
72 static atom_t ATOM_hmac;
73 static atom_t ATOM_close_parent;
74 static atom_t ATOM_encoding;
75 static atom_t ATOM_padding;
76
77 static functor_t FUNCTOR_public_key1;
78 static functor_t FUNCTOR_private_key1;
79
80 typedef enum
81 { RSA_MODE, EVP_MODE
82 } crypt_mode_t;
83
84
85 /***************************
86 * RANDOM BYTES *
87 ****************************/
88
89 static foreign_t
pl_crypto_n_random_bytes(term_t tn,term_t tout)90 pl_crypto_n_random_bytes(term_t tn, term_t tout)
91 { size_t len;
92 int rc;
93 unsigned char *buffer;
94
95 if ( !PL_get_size_ex(tn, &len) )
96 return FALSE;
97
98 if ( !(buffer = malloc(len)) )
99 return PL_resource_error("memory");
100
101 if ( RAND_bytes(buffer, len) == 0 )
102 { free(buffer);
103 return raise_ssl_error(ERR_get_error());
104 }
105
106 rc = PL_unify_chars(tout, PL_CODE_LIST|REP_ISO_LATIN_1,
107 len, (const char *) buffer);
108
109 free(buffer);
110
111 return rc;
112 }
113
114
115 /***************************
116 * HASHING *
117 ****************************/
118
119
120 #define HASH_CONTEXT_MAGIC (~ 0x53481284L)
121
122 typedef struct hash_context
123 { int magic;
124 atom_t atom;
125 IOENC encoding;
126 const EVP_MD *algorithm;
127
128 IOSTREAM *parent_stream; /* Original stream */
129 IOSTREAM *hash_stream;
130 IOENC parent_encoding;
131 int close_parent;
132
133 EVP_MD_CTX *ctx;
134 HMAC_CTX *hmac_ctx;
135 char *hmac_key;
136 } PL_CRYPTO_HASH_CONTEXT;
137
138 static void
free_crypto_hash_context(PL_CRYPTO_HASH_CONTEXT * c)139 free_crypto_hash_context(PL_CRYPTO_HASH_CONTEXT *c)
140 { EVP_MD_CTX_free(c->ctx);
141 free(c->hmac_key);
142 #ifdef HAVE_HMAC_CTX_FREE
143 HMAC_CTX_free(c->hmac_ctx);
144 #endif
145 free(c);
146 }
147
148 static int
release_hash_context(atom_t atom)149 release_hash_context(atom_t atom)
150 { PL_CRYPTO_HASH_CONTEXT **cp = PL_blob_data(atom, NULL, NULL);
151 PL_CRYPTO_HASH_CONTEXT *c = *cp;
152
153 ssl_deb(4, "Releasing PL_CRYPTO_HASH_CONTEXT %p\n", c);
154 free_crypto_hash_context(c);
155 return TRUE;
156 }
157
158 static int
compare_hash_context(atom_t a,atom_t b)159 compare_hash_context(atom_t a, atom_t b)
160 { PL_CRYPTO_HASH_CONTEXT **cp1 = PL_blob_data(a, NULL, NULL);
161 PL_CRYPTO_HASH_CONTEXT **cp2 = PL_blob_data(b, NULL, NULL);
162 PL_CRYPTO_HASH_CONTEXT *c1 = *cp1;
163 PL_CRYPTO_HASH_CONTEXT *c2 = *cp2;
164
165 return ( c1 > c2 ? 1 :
166 c1 < c2 ? -1 : 0
167 );
168 }
169
170 static int
write_hash_context(IOSTREAM * s,atom_t symbol,int flags)171 write_hash_context(IOSTREAM *s, atom_t symbol, int flags)
172 { PL_CRYPTO_HASH_CONTEXT **cp = PL_blob_data(symbol, NULL, NULL);
173 PL_CRYPTO_HASH_CONTEXT *c = *cp;
174
175 Sfprintf(s, "<crypto_hash_context>(%p)", c);
176
177 return TRUE;
178 }
179
180 static void
acquire_hash_context(atom_t atom)181 acquire_hash_context(atom_t atom)
182 { PL_CRYPTO_HASH_CONTEXT **cp = PL_blob_data(atom, NULL, NULL);
183 PL_CRYPTO_HASH_CONTEXT *c = *cp;
184
185 c->atom = atom;
186 }
187
188 static PL_blob_t crypto_hash_context_type =
189 { PL_BLOB_MAGIC,
190 0,
191 "crypto_hash_context",
192 release_hash_context,
193 compare_hash_context,
194 write_hash_context,
195 acquire_hash_context
196 };
197
198
199 static int
unify_hash_context(term_t tcontext,PL_CRYPTO_HASH_CONTEXT * context)200 unify_hash_context(term_t tcontext, PL_CRYPTO_HASH_CONTEXT *context)
201 { if ( PL_unify_blob(tcontext, &context, sizeof(context), &crypto_hash_context_type) )
202 return TRUE;
203
204 free_crypto_hash_context(context);
205 if ( !PL_exception(0) )
206 return PL_uninstantiation_error(tcontext);
207
208 return FALSE;
209 }
210
211
212 static int
get_hash_context(term_t tcontext,PL_CRYPTO_HASH_CONTEXT ** context)213 get_hash_context(term_t tcontext, PL_CRYPTO_HASH_CONTEXT **context)
214 { PL_blob_t *type;
215 void *data;
216
217 if ( PL_get_blob(tcontext, &data, NULL, &type) &&
218 type == &crypto_hash_context_type )
219 { PL_CRYPTO_HASH_CONTEXT *c = *(PL_CRYPTO_HASH_CONTEXT**)data;
220
221 assert(c->magic == HASH_CONTEXT_MAGIC);
222 *context = c;
223
224 return TRUE;
225 }
226
227 return PL_type_error("crypto_hash_context", tcontext);
228 }
229
230 typedef struct algorithm_pair {
231 atom_t a_algorithm;
232 const EVP_MD *algorithm;
233 } ALGORITHM_PAIR;
234
235 #define ALGO(a) { ATOM_## a , EVP_## a() }
236 #define NELEMS(array) (sizeof(array)/sizeof((array)[0]))
237
238 static int
get_hash_algorithm(atom_t a_algorithm,const EVP_MD ** algorithm)239 get_hash_algorithm(atom_t a_algorithm, const EVP_MD **algorithm)
240 { int i;
241 ALGORITHM_PAIR algorithms[] =
242 { ALGO(md5), ALGO(ripemd160),
243 #if defined(HAVE_EVP_BLAKE2B512) && defined(HAVE_EVP_BLAKE2S256)
244 ALGO(blake2s256), ALGO(blake2b512),
245 #endif
246 #if defined(HAVE_EVP_SHA3_224) && defined(HAVE_EVP_SHA3_256) && \
247 defined(HAVE_EVP_SHA3_384) && defined(HAVE_EVP_SHA3_512)
248 ALGO(sha3_224), ALGO(sha3_256), ALGO(sha3_384), ALGO(sha3_512),
249 #endif
250 ALGO(sha1), ALGO(sha224), ALGO(sha256), ALGO(sha384), ALGO(sha512)
251 };
252
253 for (i = 0; i < NELEMS(algorithms); i++)
254 { if (a_algorithm == algorithms[i].a_algorithm)
255 { *algorithm = algorithms[i].algorithm;
256 return TRUE;
257 }
258 }
259
260 return FALSE;
261 }
262
263 static int
get_text_representation(term_t t,int * rep)264 get_text_representation(term_t t, int *rep)
265 { atom_t a;
266
267 if ( PL_get_atom_ex(t, &a) )
268 { if ( a == ATOM_octet ) *rep = REP_ISO_LATIN_1;
269 else if ( a == ATOM_utf8 ) *rep = REP_UTF8;
270 else if ( a == ATOM_text ) *rep = REP_MB;
271 else return PL_domain_error("encoding", t);
272
273 return TRUE;
274 }
275
276 return FALSE;
277 }
278
279
280 static int
hash_options(term_t options,PL_CRYPTO_HASH_CONTEXT * result)281 hash_options(term_t options, PL_CRYPTO_HASH_CONTEXT *result)
282 { term_t opts = PL_copy_term_ref(options);
283 term_t opt = PL_new_term_ref();
284
285 /* defaults */
286 result->encoding = REP_UTF8;
287 result->algorithm = EVP_sha256();
288
289 while(PL_get_list(opts, opt, opts))
290 { atom_t aname;
291 size_t arity;
292
293 if ( PL_get_name_arity(opt, &aname, &arity) && arity == 1 )
294 { term_t a = PL_new_term_ref();
295
296 _PL_get_arg(1, opt, a);
297
298 if ( aname == ATOM_algorithm )
299 { atom_t a_algorithm;
300
301 if ( !PL_get_atom_ex(a, &a_algorithm) )
302 return FALSE;
303
304 if ( !get_hash_algorithm(a_algorithm, &result->algorithm) )
305 return PL_domain_error("algorithm", a);
306 } else if ( aname == ATOM_hmac )
307 { size_t key_len;
308 char *key;
309
310 if ( !PL_get_nchars(a, &key_len, &key,
311 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) )
312 return FALSE;
313 result->hmac_key = ssl_strdup(key);
314 } else if ( aname == ATOM_close_parent )
315 { if ( !PL_get_bool_ex(a, &result->close_parent) )
316 return FALSE;
317 } else if ( aname == ATOM_encoding )
318 { int rep;
319 if ( !get_text_representation(a, &rep) )
320 return PL_domain_error("encoding", a);
321
322 result->encoding = ( rep == REP_UTF8 ) ? REP_UTF8 : REP_ISO_LATIN_1;
323 }
324 } else
325 { return PL_type_error("option", opt);
326 }
327 }
328
329 if ( !PL_get_nil_ex(opts) )
330 return FALSE;
331
332 return TRUE;
333 }
334
335
336 static foreign_t
pl_crypto_hash_context_new(term_t tcontext,term_t options)337 pl_crypto_hash_context_new(term_t tcontext, term_t options)
338 {
339 PL_CRYPTO_HASH_CONTEXT *context = NULL;
340
341 context = malloc(sizeof(*context));
342
343 if ( !context )
344 return FALSE;
345
346 context->magic = HASH_CONTEXT_MAGIC;
347 context->ctx = NULL;
348 context->hmac_ctx = NULL;
349 context->hmac_key = NULL;
350
351 context->parent_stream = NULL;
352 context->hash_stream = NULL;
353
354 if ( !hash_options(options, context) )
355 return FALSE;
356
357 #ifdef HAVE_HMAC_CTX_NEW
358 if ( context->hmac_key )
359 { context->hmac_ctx = HMAC_CTX_new();
360 if ( !HMAC_Init_ex(context->hmac_ctx,
361 context->hmac_key, strlen(context->hmac_key),
362 context->algorithm, NULL) )
363 { HMAC_CTX_free(context->hmac_ctx);
364 return FALSE;
365 }
366 }
367 #endif
368
369 if ( !context->hmac_ctx )
370 { context->ctx = EVP_MD_CTX_new();
371 if ( !EVP_DigestInit_ex(context->ctx, context->algorithm, NULL) )
372 { EVP_MD_CTX_free(context->ctx);
373 return FALSE;
374 }
375 }
376
377 return unify_hash_context(tcontext, context);
378 }
379
380 static foreign_t
pl_crypto_hash_context_copy(term_t tin,term_t tout)381 pl_crypto_hash_context_copy(term_t tin, term_t tout)
382 {
383 PL_CRYPTO_HASH_CONTEXT *in, *out;
384 int rc = 0;
385
386 if ( !get_hash_context(tin, &in) )
387 return FALSE;
388
389 out = malloc(sizeof(*out));
390
391 if ( !out )
392 return FALSE;
393
394 out->magic = HASH_CONTEXT_MAGIC;
395 out->hmac_key = ssl_strdup(in->hmac_key);
396
397 out->encoding = in->encoding;
398 out->algorithm = in->algorithm;
399
400 out->ctx = in->ctx ? EVP_MD_CTX_new() : NULL;
401 if ( out->ctx )
402 { if ( !EVP_DigestInit_ex(out->ctx, out->algorithm, NULL) )
403 { EVP_MD_CTX_free(out->ctx);
404 return FALSE;
405 }
406 rc = EVP_MD_CTX_copy_ex(out->ctx, in->ctx);
407 }
408
409 #if defined(HAVE_HMAC_CTX_NEW) && defined(HAVE_HMAC_CTX_FREE)
410 out->hmac_ctx = in->hmac_ctx ? HMAC_CTX_new() : NULL;
411
412 if ( out->hmac_ctx )
413 { if ( !HMAC_Init_ex(out->hmac_ctx,
414 out->hmac_key, strlen(out->hmac_key),
415 out->algorithm, NULL) )
416 { HMAC_CTX_free(out->hmac_ctx);
417 return FALSE;
418 }
419 rc = HMAC_CTX_copy(out->hmac_ctx, in->hmac_ctx);
420 }
421 #else
422 out->hmac_ctx = NULL;
423 #endif
424
425 return unify_hash_context(tout, out) && rc;
426 }
427
428
429 static int
hash_append(PL_CRYPTO_HASH_CONTEXT * context,void * data,size_t size)430 hash_append(PL_CRYPTO_HASH_CONTEXT *context, void *data, size_t size)
431 {
432 if ( context->hmac_ctx )
433 return HMAC_Update(context->hmac_ctx, data, size);
434
435 return EVP_DigestUpdate(context->ctx, data, size);
436 }
437
438
439 static foreign_t
pl_crypto_update_hash_context(term_t from,term_t tcontext)440 pl_crypto_update_hash_context(term_t from, term_t tcontext)
441 {
442 PL_CRYPTO_HASH_CONTEXT *context = NULL;
443 size_t datalen;
444 char *data;
445
446 if ( !get_hash_context(tcontext, &context) )
447 return FALSE;
448
449 if ( !PL_get_nchars(from, &datalen, &data,
450 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION|context->encoding) )
451 return FALSE;
452
453
454 return hash_append(context, data, datalen);
455 }
456
457 static foreign_t
pl_crypto_hash_context_hash(term_t tcontext,term_t hash)458 pl_crypto_hash_context_hash(term_t tcontext, term_t hash)
459 {
460 PL_CRYPTO_HASH_CONTEXT *context = NULL;
461 unsigned char digest[EVP_MAX_MD_SIZE];
462 unsigned int len;
463
464 if ( !get_hash_context(tcontext, &context) )
465 return FALSE;
466
467 if ( context->hmac_ctx )
468 { HMAC_Final(context->hmac_ctx, digest, &len);
469 } else
470 { EVP_DigestFinal_ex(context->ctx, digest, &len);
471 }
472
473 return PL_unify_list_ncodes(hash, len, (char *) digest);
474 }
475
476
477 /***************************
478 * Hashes on streams *
479 ****************************/
480
481 static ssize_t /* range-limited read */
hash_read(void * handle,char * buf,size_t size)482 hash_read(void *handle, char *buf, size_t size)
483 { PL_CRYPTO_HASH_CONTEXT *ctx = handle;
484 ssize_t rd;
485
486 if ( (rd = Sfread(buf, sizeof(char), size, ctx->parent_stream)) >= 0 )
487 { hash_append(ctx, buf, rd);
488
489 return rd;
490 }
491
492 return rd;
493 }
494
495
496 static ssize_t
hash_write(void * handle,char * buf,size_t size)497 hash_write(void *handle, char *buf, size_t size)
498 { PL_CRYPTO_HASH_CONTEXT *ctx = handle;
499 size_t written = 0;
500
501 hash_append(ctx, buf, size);
502
503 while ( written < size )
504 { ssize_t wr = Sfwrite(buf+written, sizeof(char), size, ctx->parent_stream);
505
506 if ( wr >= 0 )
507 { written += wr;
508 } else
509 return wr;
510 }
511
512 return size;
513 }
514
515
516 static int
hash_control(void * handle,int op,void * data)517 hash_control(void *handle, int op, void *data)
518 { PL_CRYPTO_HASH_CONTEXT *ctx = handle;
519
520 switch(op)
521 { case SIO_SETENCODING:
522 return 0; /* allow switching encoding */
523 default:
524 if ( ctx->parent_stream->functions->control )
525 return (*ctx->parent_stream->functions->control)(ctx->parent_stream->handle, op, data);
526 return -1;
527 }
528 }
529
530
531 static int
hash_close(void * handle)532 hash_close(void *handle)
533 { int rc = 0;
534 PL_CRYPTO_HASH_CONTEXT *ctx = handle;
535
536 ctx->parent_stream->encoding = ctx->parent_encoding;
537 if ( ctx->parent_stream->upstream )
538 Sset_filter(ctx->parent_stream, NULL);
539
540 if ( ctx->close_parent )
541 rc = Sclose(ctx->parent_stream);
542
543 free_crypto_hash_context(ctx);
544
545 return rc;
546 }
547
548 static IOFUNCTIONS hash_functions =
549 { hash_read,
550 hash_write,
551 NULL, /* seek */
552 hash_close,
553 hash_control,
554 NULL, /* seek64 */
555 };
556
557 #define COPY_FLAGS (SIO_INPUT|SIO_OUTPUT| \
558 SIO_TEXT| \
559 SIO_REPXML|SIO_REPPL|\
560 SIO_RECORDPOS)
561
562 static foreign_t
pl_crypto_open_hash_stream(term_t org,term_t new,term_t tcontext)563 pl_crypto_open_hash_stream(term_t org, term_t new, term_t tcontext)
564 { PL_CRYPTO_HASH_CONTEXT *context;
565 IOSTREAM *s, *s2;
566
567 if ( !get_hash_context(tcontext, &context) )
568 return FALSE;
569
570 if ( !PL_get_stream_handle(org, &s) )
571 return FALSE; /* Error */
572
573 context->parent_encoding = s->encoding;
574 context->parent_stream = s;
575
576 if ( !(s2 = Snew(context,
577 (s->flags©_FLAGS)|SIO_FBUF,
578 &hash_functions)) )
579 { PL_release_stream(s);
580
581 return FALSE;
582 }
583
584 s2->encoding = s->encoding;
585 s->encoding = ENC_OCTET;
586 context->hash_stream = s2;
587
588 if ( PL_unify_stream(new, s2) )
589 { Sset_filter(s, s2);
590 PL_release_stream(s);
591 /* Increase atom reference count so that the context is not
592 GCd until this session is complete */
593 PL_register_atom(context->atom);
594
595 return TRUE;
596 } else
597 { PL_release_stream(s);
598 return FALSE;
599 }
600 }
601
602
603 static foreign_t
pl_crypto_stream_hash_context(term_t stream,term_t tcontext)604 pl_crypto_stream_hash_context(term_t stream, term_t tcontext)
605 { IOSTREAM *s;
606 int rc;
607
608 if ( PL_get_stream_handle(stream, &s) )
609 { PL_CRYPTO_HASH_CONTEXT *ctx = s->handle;
610 rc = unify_hash_context(tcontext, ctx);
611 PL_release_stream(s);
612 return rc;
613 }
614
615 return FALSE;
616 }
617
618 /***************************
619 * Hashes of passwords *
620 ****************************/
621
622 static foreign_t
pl_crypto_password_hash(term_t tpw,term_t tsalt,term_t titer,term_t tdigest)623 pl_crypto_password_hash(term_t tpw, term_t tsalt, term_t titer, term_t tdigest)
624 { char *pw, *salt;
625 size_t pwlen, saltlen;
626 int iter;
627 const int DIGEST_LEN = 64;
628 unsigned char digest[DIGEST_LEN];
629
630 if ( !PL_get_nchars(tpw, &pwlen, &pw,
631 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION|REP_UTF8) ||
632 !PL_get_nchars(tsalt, &saltlen, &salt, CVT_LIST) ||
633 !PL_get_integer_ex(titer, &iter) )
634 return FALSE;
635
636 PKCS5_PBKDF2_HMAC((const char *) pw, pwlen,
637 (const unsigned char *) salt, saltlen,
638 iter, EVP_sha512(), DIGEST_LEN, digest);
639
640 return PL_unify_list_ncodes(tdigest, DIGEST_LEN, (char *) digest);
641 }
642
643 static foreign_t
pl_crypto_data_hkdf(term_t tkey,term_t tsalt,term_t tinfo,term_t talg,term_t tencoding,term_t toutlen,term_t tout)644 pl_crypto_data_hkdf(term_t tkey, term_t tsalt, term_t tinfo, term_t talg,
645 term_t tencoding, term_t toutlen, term_t tout)
646 {
647 #if defined(HAVE_OPENSSL_KDF_H) && defined(EVP_PKEY_HKDF)
648 EVP_PKEY_CTX *pctx;
649 char *salt, *key, *info;
650 size_t keylen, infolen, outlen, saltlen;
651 int rep;
652 const EVP_MD *alg;
653 unsigned char *out;
654 atom_t a_algorithm;
655
656 if ( !PL_get_nchars(tsalt, &saltlen, &salt, CVT_LIST) ||
657 !PL_get_size_ex(toutlen, &outlen) ||
658 !PL_get_atom_ex(talg, &a_algorithm) )
659 return FALSE;
660
661 if ( !get_text_representation(tencoding, &rep) )
662 return PL_domain_error("encoding", tencoding);
663
664 if ( !PL_get_nchars(tkey, &keylen, &key,
665 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION|rep) ||
666 !PL_get_nchars(tinfo, &infolen, &info,
667 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) )
668 return FALSE;
669
670 if ( !get_hash_algorithm(a_algorithm, &alg) )
671 return PL_domain_error("algorithm", a_algorithm);
672
673 if ( !(out = malloc(outlen)) )
674 return PL_resource_error("memory");
675
676 pctx = EVP_PKEY_CTX_new_id(EVP_PKEY_HKDF, NULL);
677
678 if ( (EVP_PKEY_derive_init(pctx) > 0) &&
679 (EVP_PKEY_CTX_set_hkdf_md(pctx, alg) > 0) &&
680 (EVP_PKEY_CTX_set1_hkdf_salt(pctx, salt, saltlen) > 0) &&
681 (EVP_PKEY_CTX_set1_hkdf_key(pctx, key, keylen) > 0) &&
682 (EVP_PKEY_CTX_add1_hkdf_info(pctx, info, infolen) > 0) &&
683 (EVP_PKEY_derive(pctx, out, &outlen) > 0) )
684 { int rc = PL_unify_list_ncodes(tout, outlen, (char *) out);
685 free(out);
686 EVP_PKEY_CTX_free(pctx);
687 return rc;
688 }
689
690 free(out);
691 EVP_PKEY_CTX_free(pctx);
692 return raise_ssl_error(ERR_get_error());
693 #else
694 return ssl_missing("HKDF");
695 #endif
696 }
697
698 /***************************
699 * Bignums & Keys *
700 ****************************/
701
702 static int
get_bn_arg(int a,term_t t,BIGNUM ** bn)703 get_bn_arg(int a, term_t t, BIGNUM **bn)
704 { term_t arg;
705 char *hex;
706
707 if ( (arg=PL_new_term_ref()) &&
708 PL_get_arg(a, t, arg) &&
709 PL_get_chars(arg, &hex,
710 CVT_ATOM|CVT_STRING|REP_ISO_LATIN_1|CVT_EXCEPTION) )
711 { if ( strcmp(hex, "-") == 0 )
712 *bn = NULL;
713 else
714 BN_hex2bn(bn, hex);
715
716 return TRUE;
717 }
718
719 return FALSE;
720 }
721
722 #ifndef OPENSSL_NO_EC
723 static int
recover_ec(term_t t,EC_KEY ** rec)724 recover_ec(term_t t, EC_KEY **rec)
725 {
726 EC_KEY *ec;
727 BIGNUM *privkey = NULL;
728 term_t pubkey;
729 unsigned char *codes;
730 size_t codes_len;
731 term_t tcurve = PL_new_term_ref();
732 char *curve;
733
734 if ( !(tcurve &&
735 PL_get_arg(3, t, tcurve) &&
736 PL_get_chars(tcurve, &curve, CVT_ATOM|CVT_STRING|CVT_EXCEPTION) &&
737 (ec = EC_KEY_new_by_curve_name(OBJ_sn2nid(curve)))) )
738 return FALSE;
739
740 if ( !get_bn_arg(1, t, &privkey) )
741 { EC_KEY_free(ec);
742 return FALSE;
743 }
744
745 if ( privkey )
746 EC_KEY_set_private_key(ec, privkey);
747
748 if ( (pubkey=PL_new_term_ref()) &&
749 PL_get_arg(2, t, pubkey) &&
750 PL_get_nchars(pubkey, &codes_len, (char **) &codes,
751 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) &&
752 (ec = o2i_ECPublicKey(&ec, (const unsigned char**) &codes, codes_len)) )
753 { *rec = ec;
754 return TRUE;
755 }
756
757 EC_KEY_free(ec);
758 return FALSE;
759 }
760 #endif
761
762 static int
recover_rsa(term_t t,RSA ** rsap)763 recover_rsa(term_t t, RSA** rsap)
764 { RSA *rsa = RSA_new();
765
766 #if OPENSSL_VERSION_NUMBER < 0x10100000L || defined(LIBRESSL_VERSION_NUMBER)
767 if ( get_bn_arg(1, t, &rsa->n) &&
768 get_bn_arg(2, t, &rsa->e) &&
769 get_bn_arg(3, t, &rsa->d) &&
770 get_bn_arg(4, t, &rsa->p) &&
771 get_bn_arg(5, t, &rsa->q) &&
772 get_bn_arg(6, t, &rsa->dmp1) &&
773 get_bn_arg(7, t, &rsa->dmq1) &&
774 get_bn_arg(8, t, &rsa->iqmp)
775 )
776 {
777 #else
778 BIGNUM *n = NULL, *e = NULL, *d = NULL, *p = NULL,
779 *q = NULL, *dmp1 = NULL, *dmq1 = NULL, *iqmp = NULL;
780
781 if ( get_bn_arg(1, t, &n) &&
782 get_bn_arg(2, t, &e) &&
783 get_bn_arg(3, t, &d) &&
784 get_bn_arg(4, t, &p) &&
785 get_bn_arg(5, t, &q) &&
786 get_bn_arg(6, t, &dmp1) &&
787 get_bn_arg(7, t, &dmq1) &&
788 get_bn_arg(8, t, &iqmp) )
789 {
790 if ( !RSA_set0_key(rsa, n, e, d) ||
791 ( (p || q) && !RSA_set0_factors(rsa, p, q) ) ||
792 ( (dmp1 || dmq1 || iqmp) &&
793 !RSA_set0_crt_params(rsa, dmp1, dmq1, iqmp)) )
794 { RSA_free(rsa);
795 return FALSE;
796 }
797 #endif
798 *rsap = rsa;
799 return TRUE;
800 }
801
802 RSA_free(rsa);
803 return FALSE;
804 }
805
806
807 static int
808 recover_private_key(term_t t, RSA** rsap)
809 { if ( PL_is_functor(t, FUNCTOR_private_key1) )
810 { term_t arg;
811
812 if ( (arg = PL_new_term_ref()) &&
813 PL_get_arg(1, t, arg) )
814 return recover_rsa(arg, rsap);
815
816 return FALSE;
817 }
818
819 return PL_type_error("private_key", t);
820 }
821
822
823 static int
824 recover_public_key(term_t t, RSA** rsap)
825 { if ( PL_is_functor(t, FUNCTOR_public_key1) )
826 { term_t arg;
827
828 if ( (arg = PL_new_term_ref()) &&
829 PL_get_arg(1, t, arg) )
830 return recover_rsa(arg, rsap);
831
832 return FALSE;
833 }
834
835 return PL_type_error("public_key", t);
836 }
837
838
839 /*******************************
840 * OPTION PROCESSING *
841 *******************************/
842
843 static int
844 get_padding(term_t t, crypt_mode_t mode, int *padding)
845 { atom_t a;
846
847 if ( PL_get_atom_ex(t, &a) )
848 { if ( a == ATOM_pkcs1 && mode == RSA_MODE ) *padding = RSA_PKCS1_PADDING;
849 else if ( a == ATOM_pkcs1_oaep && mode == RSA_MODE ) *padding = RSA_PKCS1_OAEP_PADDING;
850 else if ( a == ATOM_none && mode == RSA_MODE ) *padding = RSA_NO_PADDING;
851 else if ( a == ATOM_sslv23 && mode == RSA_MODE ) *padding = RSA_SSLV23_PADDING;
852 else if ( a == ATOM_none && mode == EVP_MODE ) *padding = 0;
853 else if ( a == ATOM_block && mode == EVP_MODE ) *padding = 1;
854 else return PL_domain_error("padding", t);
855
856 return TRUE;
857 }
858
859 return FALSE;
860 }
861
862
863 static int
864 get_enc_text(term_t text, term_t enc, size_t *len, unsigned char **data)
865 { int flags;
866
867 if ( get_text_representation(enc, &flags) )
868 { flags |= CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION;
869 return PL_get_nchars(text, len, (char**)data, flags);
870 }
871
872 return FALSE;
873 }
874
875
876 static int
877 parse_options(term_t options_t, crypt_mode_t mode, int* rep, int* padding)
878 { if (PL_is_atom(options_t)) /* Is really an encoding */
879 { if (rep == NULL)
880 return TRUE;
881 else if ( !get_text_representation(options_t, rep) )
882 return FALSE;
883 } else
884 { term_t tail = PL_copy_term_ref(options_t);
885 term_t head = PL_new_term_ref();
886
887 while( PL_get_list_ex(tail, head, tail) )
888 { atom_t name;
889 size_t arity;
890 term_t arg = PL_new_term_ref();
891
892 if ( !PL_get_name_arity(head, &name, &arity) ||
893 arity != 1 ||
894 !PL_get_arg(1, head, arg) )
895 return PL_type_error("option", head);
896
897 if ( name == ATOM_encoding )
898 { if ( !get_text_representation(arg, rep) )
899 return FALSE;
900 } else if ( name == ATOM_padding && padding != NULL)
901 { if ( !get_padding(arg, mode, padding) )
902 return FALSE;
903 }
904 }
905 if ( !PL_get_nil_ex(tail) )
906 return FALSE;
907 }
908
909 return TRUE;
910 }
911
912
913
914 /*******************************
915 * ECDSA SIGN/VERIFY *
916 *******************************/
917
918
919 static foreign_t
920 pl_ecdsa_sign(term_t Private, term_t Data, term_t Enc, term_t Signature)
921 {
922 #ifndef OPENSSL_NO_ECDSA
923 unsigned char *data;
924 size_t data_len;
925 EC_KEY *key;
926 ECDSA_SIG *sig;
927 unsigned char *signature = NULL;
928 int signature_len, rc;
929
930 if ( !recover_ec(Private, &key) ||
931 !get_enc_text(Data, Enc, &data_len, &data) )
932 return FALSE;
933
934 sig = ECDSA_do_sign(data, (unsigned int)data_len, key);
935 EC_KEY_free(key);
936
937 if ( (signature_len = i2d_ECDSA_SIG(sig, &signature)) < 0 )
938 return raise_ssl_error(ERR_get_error());
939
940 rc = unify_bytes_hex(Signature, signature_len, signature);
941 OPENSSL_free(signature);
942
943 return rc;
944 #else
945 return ssl_missing("ECDSA");
946 #endif
947 }
948
949 static foreign_t
950 pl_ecdsa_verify(term_t Public, term_t Data, term_t Enc, term_t Signature)
951 {
952 #ifndef OPENSSL_NO_ECDSA
953 unsigned char *data;
954 size_t data_len;
955 EC_KEY *key;
956 ECDSA_SIG *sig;
957 unsigned char *signature;
958 const unsigned char *copy;
959 size_t signature_len;
960 int rc;
961
962 if ( !recover_ec(Public, &key) ||
963 !get_enc_text(Data, Enc, &data_len, &data) ||
964 !PL_get_nchars(Signature, &signature_len, (char **) &signature, REP_ISO_LATIN_1|CVT_LIST|CVT_EXCEPTION) )
965 return FALSE;
966
967 copy = signature;
968
969 if ( !(sig = d2i_ECDSA_SIG(NULL, ©, signature_len)) )
970 return FALSE;
971
972 rc = ECDSA_do_verify(data, data_len, sig, key);
973
974 EC_KEY_free(key);
975 ECDSA_SIG_free(sig);
976
977 if (rc == 0 || rc == 1 )
978 return rc;
979
980 return raise_ssl_error(ERR_get_error());
981 #else
982 return ssl_missing("ECDSA");
983 #endif
984 }
985
986
987
988 /*******************************
989 * RSA ENCRYPT/DECRYPT *
990 *******************************/
991
992
993 static foreign_t
994 pl_rsa_private_decrypt(term_t private_t, term_t cipher_t,
995 term_t plain_t, term_t options_t)
996 { size_t cipher_length;
997 unsigned char* cipher;
998 unsigned char* plain;
999 int outsize;
1000 RSA* key;
1001 int rep = REP_UTF8;
1002 int padding = RSA_PKCS1_PADDING;
1003 int retval;
1004
1005 if ( !parse_options(options_t, RSA_MODE, &rep, &padding))
1006 return FALSE;
1007
1008 if( !PL_get_nchars(cipher_t, &cipher_length, (char**)&cipher,
1009 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) )
1010 return FALSE;
1011 if ( !recover_private_key(private_t, &key) )
1012 return FALSE;
1013
1014 outsize = RSA_size(key);
1015 ssl_deb(1, "Output size is going to be %d", outsize);
1016 plain = PL_malloc(outsize);
1017 ssl_deb(1, "Allocated %d bytes for plaintext", outsize);
1018 if ((outsize = RSA_private_decrypt((int)cipher_length, cipher,
1019 plain, key, padding)) <= 0)
1020 { ssl_deb(1, "Failure to decrypt!");
1021 RSA_free(key);
1022 PL_free(plain);
1023 return raise_ssl_error(ERR_get_error());
1024 }
1025 ssl_deb(1, "decrypted bytes: %d", outsize);
1026 ssl_deb(1, "Freeing RSA");
1027 RSA_free(key);
1028 ssl_deb(1, "Assembling plaintext");
1029 retval = PL_unify_chars(plain_t, rep | PL_STRING, outsize, (char*)plain);
1030 ssl_deb(1, "Freeing plaintext");
1031 PL_free(plain);
1032 ssl_deb(1, "Done");
1033
1034 return retval;
1035 }
1036
1037 static foreign_t
1038 pl_rsa_public_decrypt(term_t public_t, term_t cipher_t,
1039 term_t plain_t, term_t options_t)
1040 { size_t cipher_length;
1041 unsigned char* cipher;
1042 unsigned char* plain;
1043 int outsize;
1044 RSA* key;
1045 int rep = REP_UTF8;
1046 int padding = RSA_PKCS1_PADDING;
1047 int retval;
1048
1049 if ( !parse_options(options_t, RSA_MODE, &rep, &padding))
1050 return FALSE;
1051 if ( !PL_get_nchars(cipher_t, &cipher_length, (char**)&cipher,
1052 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) )
1053 return FALSE;
1054 if ( !recover_public_key(public_t, &key) )
1055 return FALSE;
1056
1057 outsize = RSA_size(key);
1058 ssl_deb(1, "Output size is going to be %d", outsize);
1059 plain = PL_malloc(outsize);
1060 ssl_deb(1, "Allocated %d bytes for plaintext", outsize);
1061 if ((outsize = RSA_public_decrypt((int)cipher_length, cipher,
1062 plain, key, padding)) <= 0)
1063 { ssl_deb(1, "Failure to decrypt!");
1064 RSA_free(key);
1065 PL_free(plain);
1066 return raise_ssl_error(ERR_get_error());
1067 }
1068 ssl_deb(1, "decrypted bytes: %d", outsize);
1069 ssl_deb(1, "Freeing RSA");
1070 RSA_free(key);
1071 ssl_deb(1, "Assembling plaintext");
1072 retval = PL_unify_chars(plain_t, rep | PL_STRING, outsize, (char*)plain);
1073 ssl_deb(1, "Freeing plaintext");
1074 PL_free(plain);
1075 ssl_deb(1, "Done");
1076
1077 return retval;
1078 }
1079
1080 static foreign_t
1081 pl_rsa_public_encrypt(term_t public_t,
1082 term_t plain_t, term_t cipher_t, term_t options_t)
1083 { size_t plain_length;
1084 unsigned char* cipher;
1085 unsigned char* plain;
1086 int outsize;
1087 RSA* key;
1088 int rep = REP_UTF8;
1089 int padding = RSA_PKCS1_PADDING;
1090 int retval;
1091
1092 if ( !parse_options(options_t, RSA_MODE, &rep, &padding))
1093 return FALSE;
1094
1095 ssl_deb(1, "Generating terms");
1096 ssl_deb(1, "Collecting plaintext");
1097 if ( !PL_get_nchars(plain_t, &plain_length, (char**)&plain,
1098 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION | rep))
1099 return FALSE;
1100 if ( !recover_public_key(public_t, &key) )
1101 return FALSE;
1102
1103 outsize = RSA_size(key);
1104 ssl_deb(1, "Output size is going to be %d\n", outsize);
1105 cipher = PL_malloc(outsize);
1106 ssl_deb(1, "Allocated %d bytes for ciphertext\n", outsize);
1107 if ( (outsize = RSA_public_encrypt((int)plain_length, plain,
1108 cipher, key, padding)) <= 0)
1109 { ssl_deb(1, "Failure to encrypt!");
1110 PL_free(cipher);
1111 RSA_free(key);
1112 return raise_ssl_error(ERR_get_error());
1113 }
1114 ssl_deb(1, "encrypted bytes: %d\n", outsize);
1115 ssl_deb(1, "Freeing RSA");
1116 RSA_free(key);
1117 ssl_deb(1, "Assembling plaintext");
1118 retval = PL_unify_chars(cipher_t, PL_STRING|REP_ISO_LATIN_1,
1119 outsize, (char*)cipher);
1120 ssl_deb(1, "Freeing plaintext");
1121 PL_free(cipher);
1122 ssl_deb(1, "Done");
1123
1124 return retval;
1125 }
1126
1127
1128 static foreign_t
1129 pl_rsa_private_encrypt(term_t private_t,
1130 term_t plain_t, term_t cipher_t, term_t options_t)
1131 { size_t plain_length;
1132 unsigned char* cipher;
1133 unsigned char* plain;
1134 int outsize;
1135 RSA* key;
1136 int rep = REP_UTF8;
1137 int padding = RSA_PKCS1_PADDING;
1138 int retval;
1139
1140 if ( !parse_options(options_t, RSA_MODE, &rep, &padding))
1141 return FALSE;
1142
1143 if ( !PL_get_nchars(plain_t, &plain_length, (char**)&plain,
1144 CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION | rep))
1145 return FALSE;
1146 if ( !recover_private_key(private_t, &key) )
1147 return FALSE;
1148
1149 outsize = RSA_size(key);
1150 ssl_deb(1, "Output size is going to be %d", outsize);
1151 cipher = PL_malloc(outsize);
1152 ssl_deb(1, "Allocated %d bytes for ciphertext", outsize);
1153 if ((outsize = RSA_private_encrypt((int)plain_length, plain,
1154 cipher, key, padding)) <= 0)
1155 { ssl_deb(1, "Failure to encrypt!");
1156 PL_free(cipher);
1157 RSA_free(key);
1158 return raise_ssl_error(ERR_get_error());
1159 }
1160 ssl_deb(1, "encrypted bytes: %d", outsize);
1161 ssl_deb(1, "Freeing RSA");
1162 RSA_free(key);
1163 ssl_deb(1, "Assembling plaintext");
1164 retval = PL_unify_chars(cipher_t, PL_STRING|REP_ISO_LATIN_1,
1165 outsize, (char*)cipher);
1166 ssl_deb(1, "Freeing cipher");
1167 PL_free(cipher);
1168 ssl_deb(1, "Done");
1169
1170 return retval;
1171 }
1172
1173
1174 static int
1175 get_digest_type(term_t t, int *type)
1176 { atom_t a;
1177
1178 if ( PL_get_atom_ex(t, &a) )
1179 { if ( a == ATOM_sha1 ) *type = NID_sha1;
1180 else if ( a == ATOM_sha224 ) *type = NID_sha224;
1181 else if ( a == ATOM_sha256 ) *type = NID_sha256;
1182 else if ( a == ATOM_sha384 ) *type = NID_sha384;
1183 else if ( a == ATOM_sha512 ) *type = NID_sha512;
1184 else
1185 { PL_domain_error("digest_type", t);
1186 return FALSE;
1187 }
1188
1189 return TRUE;
1190 }
1191
1192 return FALSE;
1193 }
1194
1195
1196 static foreign_t
1197 pl_rsa_sign(term_t Private, term_t Type, term_t Enc,
1198 term_t Data, term_t Signature)
1199 { unsigned char *data;
1200 size_t data_len;
1201 RSA *key;
1202 unsigned char *signature;
1203 unsigned int signature_len;
1204 int rc;
1205 int type;
1206
1207 if ( !get_enc_text(Data, Enc, &data_len, &data) ||
1208 !recover_private_key(Private, &key) ||
1209 !get_digest_type(Type, &type) )
1210 return FALSE;
1211
1212 signature_len = RSA_size(key);
1213 signature = PL_malloc(signature_len);
1214 rc = RSA_sign(type,
1215 data, (unsigned int)data_len,
1216 signature, &signature_len, key);
1217 RSA_free(key);
1218 if ( rc != 1 )
1219 { PL_free(signature);
1220 return raise_ssl_error(ERR_get_error());
1221 }
1222 rc = unify_bytes_hex(Signature, signature_len, signature);
1223 PL_free(signature);
1224
1225 return rc;
1226 }
1227
1228 static foreign_t
1229 pl_rsa_verify(term_t Public, term_t Type, term_t Enc,
1230 term_t Data, term_t Signature)
1231 { unsigned char *data;
1232 size_t data_len;
1233 RSA *key;
1234 unsigned char *signature;
1235 size_t signature_len;
1236 int rc;
1237 int type;
1238
1239 if ( !get_enc_text(Data, Enc, &data_len, &data) ||
1240 !recover_public_key(Public, &key) ||
1241 !get_digest_type(Type, &type) ||
1242 !PL_get_nchars(Signature, &signature_len, (char**)&signature, REP_ISO_LATIN_1|CVT_LIST|CVT_EXCEPTION) )
1243 return FALSE;
1244
1245 rc = RSA_verify(type,
1246 data, (unsigned int)data_len,
1247 signature, (unsigned int)signature_len, key);
1248 RSA_free(key);
1249
1250 if ( rc == 0 || rc == 1 )
1251 return rc;
1252
1253 return raise_ssl_error(ERR_get_error());
1254 }
1255
1256
1257
1258 #ifndef HAVE_EVP_CIPHER_CTX_RESET
1259 #define EVP_CIPHER_CTX_reset(C) EVP_CIPHER_CTX_init(C)
1260 #endif
1261
1262 static foreign_t
1263 pl_crypto_data_decrypt(term_t ciphertext_t, term_t algorithm_t,
1264 term_t key_t, term_t iv_t,
1265 term_t authtag_t,
1266 term_t plaintext_t,
1267 term_t options_t)
1268 { EVP_CIPHER_CTX* ctx = NULL;
1269 const EVP_CIPHER *cipher;
1270 char* key;
1271 char* iv;
1272 char* ciphertext;
1273 size_t cipher_length;
1274 int plain_length;
1275 char* algorithm;
1276 char* plaintext;
1277 int cvt_flags = CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION;
1278 int rep = REP_UTF8;
1279 int padding = 1;
1280 #ifdef EVP_CTRL_AEAD_SET_TAG
1281 char *authtag;
1282 size_t authlen;
1283 #endif
1284
1285 if ( !parse_options(options_t, EVP_MODE, &rep, &padding) )
1286 return FALSE;
1287
1288 if ( !PL_get_chars(key_t, &key, cvt_flags) ||
1289 !PL_get_chars(iv_t, &iv, cvt_flags) ||
1290 !PL_get_nchars(ciphertext_t, &cipher_length, &ciphertext, cvt_flags) ||
1291 !PL_get_chars(algorithm_t, &algorithm, cvt_flags) )
1292 return FALSE;
1293
1294 if ( (cipher = EVP_get_cipherbyname(algorithm)) == NULL )
1295 return PL_domain_error("cipher", algorithm_t);
1296 if ((ctx = EVP_CIPHER_CTX_new()) == NULL)
1297 return FALSE;
1298
1299 EVP_CIPHER_CTX_reset(ctx);
1300 EVP_DecryptInit_ex(ctx, cipher, NULL,
1301 (const unsigned char*)key, (const unsigned char*)iv);
1302
1303 #ifdef EVP_CTRL_AEAD_SET_TAG
1304 if ( PL_get_nchars(authtag_t, &authlen, &authtag, CVT_LIST) &&
1305 ( authlen > 0 ) )
1306 { if ( !EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_SET_TAG, authlen, authtag) )
1307 { EVP_CIPHER_CTX_free(ctx);
1308 return raise_ssl_error(ERR_get_error());
1309 }
1310 }
1311 #endif
1312
1313 EVP_CIPHER_CTX_set_padding(ctx, padding);
1314 plaintext = PL_malloc(cipher_length + EVP_CIPHER_block_size(cipher));
1315 if ( EVP_DecryptUpdate(ctx, (unsigned char*)plaintext, &plain_length,
1316 (unsigned char*)ciphertext, cipher_length) == 1 )
1317 { int last_chunk = plain_length;
1318 int rc;
1319 rc = EVP_DecryptFinal_ex(ctx, (unsigned char*)(plaintext + plain_length),
1320 &last_chunk);
1321
1322 EVP_CIPHER_CTX_free(ctx);
1323
1324 if ( !rc )
1325 return raise_ssl_error(ERR_get_error());
1326
1327 ERR_print_errors_fp(stderr);
1328 rc &= PL_unify_chars(plaintext_t, rep | PL_STRING, plain_length + last_chunk,
1329 plaintext);
1330 PL_free(plaintext);
1331 return rc;
1332 }
1333
1334 PL_free(plaintext);
1335 EVP_CIPHER_CTX_free(ctx);
1336
1337 return raise_ssl_error(ERR_get_error());
1338 }
1339
1340 static foreign_t
1341 pl_crypto_data_encrypt(term_t plaintext_t, term_t algorithm_t,
1342 term_t key_t, term_t iv_t,
1343 term_t authlen_t, term_t authtag_t,
1344 term_t ciphertext_t,
1345 term_t options_t)
1346 { EVP_CIPHER_CTX* ctx = NULL;
1347 const EVP_CIPHER *cipher;
1348 char* key;
1349 char* iv;
1350 char* ciphertext;
1351 int cipher_length;
1352 char* algorithm;
1353 char* plaintext;
1354 size_t plain_length;
1355 int cvt_flags = CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION;
1356 int rep = REP_UTF8;
1357 int padding = 1;
1358 int authlen;
1359 const int MAX_AUTHLEN = 256;
1360 #ifdef EVP_CTRL_AEAD_SET_TAG
1361 char authtag[MAX_AUTHLEN];
1362 #endif
1363
1364 if ( !parse_options(options_t, EVP_MODE, &rep, &padding) ||
1365 !PL_get_integer_ex(authlen_t, &authlen) ||
1366 ( authlen > MAX_AUTHLEN ) )
1367 return FALSE;
1368
1369 if ( !PL_get_chars(key_t, &key, cvt_flags) ||
1370 !PL_get_chars(iv_t, &iv, cvt_flags) ||
1371 !PL_get_nchars(plaintext_t, &plain_length, &plaintext, cvt_flags | rep) ||
1372 !PL_get_chars(algorithm_t, &algorithm, cvt_flags) )
1373 return FALSE;
1374
1375 if ( (cipher = EVP_get_cipherbyname(algorithm)) == NULL )
1376 return PL_domain_error("cipher", algorithm_t);
1377 if ((ctx = EVP_CIPHER_CTX_new()) == NULL)
1378 return FALSE;
1379
1380 EVP_CIPHER_CTX_reset(ctx);
1381 EVP_EncryptInit_ex(ctx, cipher, NULL,
1382 (const unsigned char*)key, (const unsigned char*)iv);
1383 EVP_CIPHER_CTX_set_padding(ctx, padding);
1384 ciphertext = PL_malloc(plain_length + EVP_CIPHER_block_size(cipher));
1385 if ( EVP_EncryptUpdate(ctx, (unsigned char*)ciphertext, &cipher_length,
1386 (unsigned char*)plaintext, plain_length) == 1 )
1387 { int last_chunk;
1388 int rc;
1389
1390 if ( !EVP_EncryptFinal_ex(ctx, (unsigned char*)(ciphertext + cipher_length),
1391 &last_chunk) )
1392 return raise_ssl_error(ERR_get_error());
1393
1394 #ifdef EVP_CTRL_AEAD_SET_TAG
1395 if ( authlen >= 0 )
1396 { if ( !EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_AEAD_GET_TAG, authlen, authtag) )
1397 return raise_ssl_error(ERR_get_error());
1398
1399 if ( !PL_unify_list_ncodes(authtag_t, authlen, authtag) )
1400 return FALSE;
1401 }
1402 #endif
1403
1404 EVP_CIPHER_CTX_free(ctx);
1405 rc = PL_unify_chars(ciphertext_t, PL_STRING|REP_ISO_LATIN_1,
1406 cipher_length + last_chunk, ciphertext);
1407 PL_free(ciphertext);
1408 return rc;
1409 }
1410
1411 PL_free(ciphertext);
1412 EVP_CIPHER_CTX_free(ctx);
1413
1414 return raise_ssl_error(ERR_get_error());
1415 }
1416
1417
1418 /*******************************************
1419 * MODULAR MULTIPLICATIVE INVERSE *
1420 ********************************************/
1421
1422 static foreign_t
1423 pl_crypto_modular_inverse(term_t tx, term_t tm, term_t tout)
1424 { BIGNUM *x = NULL, *m = NULL, *r = NULL;
1425 BN_CTX *ctx = NULL;
1426 char *hex = NULL;
1427 int rc, ssl_err = FALSE;
1428
1429 if ( get_bn_arg(1, tx, &x) &&
1430 get_bn_arg(1, tm, &m) &&
1431 ( ctx = BN_CTX_new() ) &&
1432 ( r = BN_mod_inverse(NULL, x, m, ctx) ) &&
1433 ( hex = BN_bn2hex(r) ) )
1434 { rc = PL_unify_chars(tout, PL_STRING|REP_ISO_LATIN_1, strlen(hex), hex);
1435 } else
1436 { ssl_err = TRUE;
1437 }
1438
1439 OPENSSL_free(hex);
1440 BN_free(x);
1441 BN_free(m);
1442 BN_free(r);
1443 BN_CTX_free(ctx);
1444
1445 if ( ssl_err )
1446 { return raise_ssl_error(ERR_get_error());
1447 }
1448
1449 return rc;
1450 }
1451
1452 /*******************
1453 * PRIMES *
1454 ********************/
1455
1456 static foreign_t
1457 pl_crypto_generate_prime(term_t tbits, term_t tprime, term_t tsafe,
1458 term_t toptions)
1459 { BIGNUM *prime = NULL;
1460 int bits, safe;
1461 char *hex = NULL;
1462 int rc, ssl_err = FALSE;
1463
1464 if ( !PL_get_integer_ex(tbits, &bits) )
1465 return FALSE;
1466
1467 if ( !PL_get_bool_ex(tsafe, &safe) )
1468 return FALSE;
1469
1470 if ( ( prime = BN_new() ) &&
1471 ( BN_generate_prime_ex(prime, bits, safe, NULL, NULL, NULL ) ) &&
1472 ( hex = BN_bn2hex(prime) ) )
1473 { rc = PL_unify_chars(tprime, PL_STRING|REP_ISO_LATIN_1, strlen(hex), hex);
1474 } else
1475 { ssl_err = TRUE;
1476 }
1477
1478 OPENSSL_free(hex);
1479 BN_free(prime);
1480
1481 if ( ssl_err )
1482 { return raise_ssl_error(ERR_get_error());
1483 }
1484
1485 return rc;
1486 }
1487
1488 static foreign_t
1489 pl_crypto_is_prime(term_t tprime, term_t tnchecks)
1490 { BIGNUM *prime = NULL;
1491 BN_CTX *ctx = NULL;
1492 int nchecks;
1493 int ret = -1;
1494
1495 if ( !PL_get_integer_ex(tnchecks, &nchecks) )
1496 return FALSE;
1497
1498 nchecks = ( nchecks < 0 ) ? BN_prime_checks : nchecks;
1499
1500 if ( ( ctx = BN_CTX_new() ) &&
1501 get_bn_arg(1, tprime, &prime) )
1502 { ret = BN_is_prime_ex(prime, nchecks, ctx, NULL);
1503 }
1504
1505 BN_free(prime);
1506 BN_CTX_free(ctx);
1507
1508 if ( ret == -1 )
1509 { return raise_ssl_error(ERR_get_error());
1510 }
1511
1512 return ret;
1513 }
1514
1515
1516 /*******************************
1517 * ELLIPTIC CURVES *
1518 *******************************/
1519
1520 #ifndef OPENSSL_NO_EC
1521
1522 #define CURVE_MAGIC (~ 0x51431485L)
1523
1524 typedef struct curve
1525 { int magic;
1526 atom_t atom;
1527
1528 EC_GROUP *group;
1529 BN_CTX *ctx;
1530 } PL_CRYPTO_CURVE;
1531
1532 static int
1533 free_crypto_curve(PL_CRYPTO_CURVE *c)
1534 { BN_CTX_free(c->ctx);
1535 EC_GROUP_free(c->group);
1536 free(c);
1537 return TRUE;
1538 }
1539
1540 static int
1541 release_curve(atom_t atom)
1542 { size_t size;
1543 PL_CRYPTO_CURVE **cp = PL_blob_data(atom, &size, NULL);
1544 PL_CRYPTO_CURVE *c = *cp;
1545 ssl_deb(4, "Releasing PL_CRYPTO_CURVE %p\n", c);
1546 free_crypto_curve(c);
1547 return TRUE;
1548 }
1549
1550 static int
1551 compare_curve(atom_t a, atom_t b)
1552 { PL_CRYPTO_CURVE**cp1 = PL_blob_data(a, NULL, NULL);
1553 PL_CRYPTO_CURVE**cp2 = PL_blob_data(b, NULL, NULL);
1554 PL_CRYPTO_CURVE *c1 = *cp1;
1555 PL_CRYPTO_CURVE *c2 = *cp2;
1556
1557 return ( c1 > c2 ? 1 :
1558 c1 < c2 ? -1 : 0
1559 );
1560 }
1561
1562 static int
1563 write_curve(IOSTREAM *s, atom_t symbol, int flags)
1564 { PL_CRYPTO_CURVE **cp = PL_blob_data(symbol, NULL, NULL);
1565 PL_CRYPTO_CURVE *c = *cp;
1566 const char *name = OBJ_nid2sn(EC_GROUP_get_curve_name(c->group));
1567
1568 Sfprintf(s, "<crypto_curve>(%s, %p)", name, c);
1569
1570 return TRUE;
1571 }
1572
1573 static void
1574 acquire_curve(atom_t atom)
1575 { size_t size;
1576 PL_CRYPTO_CURVE **cp = PL_blob_data(atom, &size, NULL);
1577 PL_CRYPTO_CURVE *c = *cp;
1578 c->atom = atom;
1579 }
1580
1581 static PL_blob_t crypto_curve_type =
1582 { PL_BLOB_MAGIC,
1583 0,
1584 "crypto_curve",
1585 release_curve,
1586 compare_curve,
1587 write_curve,
1588 acquire_curve
1589 };
1590
1591 static int
1592 unify_curve(term_t tcurve, PL_CRYPTO_CURVE *curve)
1593 { if ( PL_unify_blob(tcurve, &curve, sizeof(curve), &crypto_curve_type) )
1594 return TRUE;
1595
1596 free_crypto_curve(curve);
1597
1598 if ( !PL_exception(0) )
1599 return PL_uninstantiation_error(tcurve);
1600
1601 return FALSE;
1602 }
1603
1604 static int
1605 get_curve(term_t tcurve, PL_CRYPTO_CURVE **curve)
1606 { PL_blob_t *type;
1607 void *data;
1608
1609 if ( PL_get_blob(tcurve, &data, NULL, &type) &&
1610 type == &crypto_curve_type )
1611 { PL_CRYPTO_CURVE *c = *(PL_CRYPTO_CURVE**)data;
1612
1613 assert(c->magic == CURVE_MAGIC);
1614 *curve = c;
1615
1616 return TRUE;
1617 }
1618
1619 return PL_type_error("crypto_curve", tcurve);
1620 }
1621
1622 #endif
1623
1624 static foreign_t
1625 pl_crypto_name_curve(term_t tname, term_t tcurve)
1626 {
1627 #ifndef OPENSSL_NO_EC
1628 PL_CRYPTO_CURVE *curve = NULL;
1629 char *name;
1630
1631 if ( !PL_get_chars(tname, &name, CVT_ATOM|CVT_STRING|CVT_EXCEPTION) )
1632 return FALSE;
1633
1634 if ( !(curve = malloc(sizeof(*curve))) )
1635 return PL_resource_error("memory");
1636
1637 curve->magic = CURVE_MAGIC;
1638 curve->ctx = NULL;
1639 curve->group = NULL;
1640
1641 if ( ( curve->group = EC_GROUP_new_by_curve_name(OBJ_sn2nid(name)) ) &&
1642 ( curve->ctx = BN_CTX_new() ) )
1643 { return unify_curve(tcurve, curve);
1644 } else
1645 { BN_CTX_free(curve->ctx);
1646 EC_GROUP_free(curve->group);
1647 free(curve);
1648
1649 return raise_ssl_error(ERR_get_error());
1650 }
1651 #else
1652 return ssl_missing("EC");
1653 #endif
1654 }
1655
1656 static foreign_t
1657 pl_crypto_curve_order(term_t tcurve, term_t torder)
1658 {
1659 #ifndef OPENSSL_NO_EC
1660 PL_CRYPTO_CURVE *curve = NULL;
1661 BIGNUM *order = NULL;
1662 char *hex = NULL;
1663 int rc = FALSE, ssl_err = FALSE;
1664
1665 if ( !get_curve(tcurve, &curve) )
1666 return FALSE;
1667
1668 if ( ( order = BN_new() ) &&
1669 EC_GROUP_get_order(curve->group, order, curve->ctx) &&
1670 ( hex = BN_bn2hex(order) ) )
1671 { rc = PL_unify_chars(torder, PL_STRING|REP_ISO_LATIN_1, strlen(hex), hex);
1672 } else
1673 { ssl_err = TRUE;
1674 }
1675
1676 OPENSSL_free(hex);
1677 BN_free(order);
1678
1679 if ( ssl_err )
1680 { return raise_ssl_error(ERR_get_error());
1681 }
1682
1683 return rc;
1684 #else
1685 return ssl_missing("EC");
1686 #endif
1687 }
1688
1689
1690 static foreign_t
1691 pl_crypto_curve_generator(term_t tcurve, term_t tx, term_t ty)
1692 {
1693 #ifndef OPENSSL_NO_EC
1694 PL_CRYPTO_CURVE *curve = NULL;
1695 BIGNUM *x = NULL, *y = NULL;
1696 char *xhex = NULL, *yhex = NULL;
1697 int rc = FALSE, ssl_err = FALSE;
1698
1699 if ( !get_curve(tcurve, &curve) )
1700 return FALSE;
1701
1702 if ( ( x = BN_new() ) &&
1703 ( y = BN_new() ) &&
1704 EC_POINT_get_affine_coordinates_GFp(curve->group,
1705 EC_GROUP_get0_generator(curve->group),
1706 x, y, curve->ctx) &&
1707 ( xhex = BN_bn2hex(x) ) &&
1708 ( yhex = BN_bn2hex(y) ) )
1709 { rc = PL_unify_chars(tx, PL_STRING|REP_ISO_LATIN_1, strlen(xhex), xhex)
1710 && PL_unify_chars(ty, PL_STRING|REP_ISO_LATIN_1, strlen(yhex), yhex);
1711 } else
1712 { ssl_err = TRUE;
1713 }
1714
1715 OPENSSL_free(xhex); OPENSSL_free(yhex);
1716 BN_free(x); BN_free(y);
1717
1718 if ( ssl_err )
1719 { return raise_ssl_error(ERR_get_error());
1720 }
1721
1722 return rc;
1723 #else
1724 return ssl_missing("EC");
1725 #endif
1726 }
1727
1728
1729
1730 static foreign_t
1731 pl_crypto_curve_scalar_mult(term_t tcurve, term_t ts,
1732 term_t tx, term_t ty, term_t ta, term_t tb)
1733 {
1734 #ifndef OPENSSL_NO_EC
1735 BIGNUM *s = NULL, *x = NULL, *y = NULL, *a = NULL, *b = NULL;
1736 EC_POINT *r = NULL, *q = NULL;
1737 char *ahex = NULL, *bhex = NULL;
1738 PL_CRYPTO_CURVE *curve = NULL;
1739 int rc, ssl_err = FALSE;
1740
1741 if ( !get_curve(tcurve, &curve) )
1742 return FALSE;
1743
1744 if ( get_bn_arg(1, ts, &s) &&
1745 get_bn_arg(1, tx, &x) &&
1746 get_bn_arg(1, ty, &y) &&
1747 ( q = EC_POINT_new(curve->group) ) &&
1748 EC_POINT_set_affine_coordinates_GFp(curve->group, q, x, y, curve->ctx) &&
1749 ( r = EC_POINT_new(curve->group) ) &&
1750 EC_POINT_mul(curve->group, r, NULL, q, s, curve->ctx) &&
1751 ( a = BN_new() ) &&
1752 ( b = BN_new() ) &&
1753 EC_POINT_get_affine_coordinates_GFp(curve->group, r, a, b, curve->ctx) &&
1754 ( ahex = BN_bn2hex(a) ) &&
1755 ( bhex = BN_bn2hex(b) ) )
1756 { rc = PL_unify_chars(ta, PL_STRING|REP_ISO_LATIN_1, strlen(ahex), ahex)
1757 && PL_unify_chars(tb, PL_STRING|REP_ISO_LATIN_1, strlen(bhex), bhex);
1758 } else
1759 { rc = FALSE; /* silence compiler */
1760 ssl_err = TRUE;
1761 }
1762
1763 OPENSSL_free(ahex); OPENSSL_free(bhex);
1764 BN_free(a); BN_free(b);
1765 BN_free(s); BN_free(x); BN_free(y);
1766 EC_POINT_free(q); EC_POINT_free(r);
1767
1768 if ( ssl_err )
1769 return raise_ssl_error(ERR_get_error());
1770
1771 return rc;
1772 #else
1773 return ssl_missing("EC");
1774 #endif
1775 }
1776
1777
1778 /*******************************
1779 * THREADING *
1780 *******************************/
1781
1782 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1783 OpenSSL is only thread-safe as of version 1.1.0.
1784
1785 For earlier versions, we need to install the hooks below. This code is
1786 based on mttest.c distributed with the OpenSSL library.
1787 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1788
1789 #ifdef _REENTRANT
1790
1791 #include <pthread.h>
1792
1793 #if OPENSSL_VERSION_NUMBER < 0x10100000L
1794 static pthread_mutex_t *lock_cs;
1795 static long *lock_count;
1796 static void (*old_locking_callback)(int, int, const char*, int) = NULL;
1797 #ifdef HAVE_CRYPTO_THREADID_GET_CALLBACK
1798 static void (*old_id_callback)(CRYPTO_THREADID*) = NULL;
1799 #else
1800 static unsigned long (*old_id_callback)(void) = NULL;
1801 #endif
1802
1803 static void
1804 crypto_thread_exit(void* ignored)
1805 {
1806 #ifdef HAVE_ERR_REMOVE_THREAD_STATE
1807 ERR_remove_thread_state(0);
1808 #elif defined(HAVE_ERR_REMOVE_STATE)
1809 ERR_remove_state(0);
1810 #else
1811 #error "Do not know how to remove SSL error state"
1812 #endif
1813 }
1814
1815 static void
1816 pthreads_locking_callback(int mode, int type, const char *file, int line)
1817 { if (mode & CRYPTO_LOCK)
1818 { pthread_mutex_lock(&(lock_cs[type]));
1819 lock_count[type]++;
1820 } else
1821 { pthread_mutex_unlock(&(lock_cs[type]));
1822 }
1823 }
1824
1825
1826 /* From OpenSSL manual:
1827
1828 id_function(void) is a function that returns a thread ID. It is not
1829 needed on Windows nor on platforms where getpid() returns a different
1830 ID for each thread (most notably Linux).
1831
1832 As for pthreads_win32 version 2, the thread identifier is no longer
1833 integral, we are going to test this claim from the manual
1834
1835 JW: I don't think getpid() returns different thread ids on Linux any
1836 longer, nor on many other Unix systems. Maybe we should use
1837 PL_thread_self()?
1838 */
1839
1840 #ifndef __WINDOWS__
1841 #ifdef HAVE_CRYPTO_THREADID_SET_CALLBACK
1842 static void
1843 pthreads_thread_id(CRYPTO_THREADID* id)
1844 { CRYPTO_THREADID_set_numeric(id, (unsigned long)pthread_self());
1845 }
1846 #else
1847 static unsigned long
1848 pthreads_thread_id(void)
1849 { unsigned long ret;
1850
1851 ret=(unsigned long)pthread_self();
1852 return(ret);
1853 }
1854 #endif /* OpenSSL 1.0.0 */
1855 #endif /* WINDOWS */
1856 #endif /* OpenSSL 1.1.0 */
1857
1858 #if !defined(HAVE_CRYPTO_THREADID_GET_CALLBACK) && !defined(CRYPTO_THREADID_get_callback)
1859 #define CRYPTO_THREADID_get_callback CRYPTO_get_id_callback
1860 #define CRYPTO_THREADID_set_callback CRYPTO_set_id_callback
1861 #endif
1862
1863 static int
1864 crypto_lib_init(void)
1865 {
1866 #if OPENSSL_VERSION_NUMBER < 0x10100000L
1867 OpenSSL_add_all_algorithms();
1868 ERR_load_crypto_strings();
1869
1870 if ( (old_id_callback=CRYPTO_THREADID_get_callback()) == 0 )
1871 { int i;
1872
1873 lock_cs = OPENSSL_malloc(CRYPTO_num_locks() * sizeof(pthread_mutex_t));
1874 lock_count = OPENSSL_malloc(CRYPTO_num_locks() * sizeof(long));
1875
1876 for (i=0; i<CRYPTO_num_locks(); i++)
1877 { lock_count[i]=0;
1878 pthread_mutex_init(&(lock_cs[i]), NULL);
1879 }
1880
1881 old_locking_callback = CRYPTO_get_locking_callback();
1882 #ifndef __WINDOWS__ /* JW: why not for Windows? */
1883 CRYPTO_THREADID_set_callback(pthreads_thread_id);
1884 #endif
1885 CRYPTO_set_locking_callback(pthreads_locking_callback);
1886
1887 PL_thread_at_exit(crypto_thread_exit, NULL, TRUE);
1888 }
1889 #endif /*OPENSSL_VERSION_NUMBER < 0x10100000L*/
1890
1891 return TRUE;
1892 }
1893
1894 #else /*_REENTRANT*/
1895
1896 static int
1897 crypto_lib_init(void)
1898 { return FALSE;
1899 }
1900
1901 #endif /*_REENTRANT*/
1902
1903
1904 static int
1905 crypto_lib_exit(void)
1906 /*
1907 * One-time library exit calls
1908 */
1909 {
1910 /*
1911 * If the module is being unloaded, we should remove callbacks pointing to
1912 * our address space
1913 */
1914 #if OPENSSL_VERSION_NUMBER < 0x10100000L
1915 #ifdef _REENTRANT
1916 #ifndef __WINDOWS__
1917 CRYPTO_THREADID_set_callback(old_id_callback);
1918 #endif
1919 CRYPTO_set_locking_callback(old_locking_callback);
1920 #endif
1921 #endif
1922 return 0;
1923 }
1924
1925 static foreign_t
1926 crypto_set_debug(term_t level)
1927 { int l;
1928
1929 if ( !PL_get_integer_ex(level, &l) )
1930 return FALSE;
1931
1932 ssl_set_debug(l);
1933
1934 return TRUE;
1935 }
1936
1937 /*******************************
1938 * INSTALL *
1939 *******************************/
1940
1941 #define MKATOM(n) ATOM_ ## n = PL_new_atom(#n);
1942
1943 install_t
1944 install_crypto4pl(void)
1945 {
1946 ATOM_minus = PL_new_atom("-");
1947 MKATOM(sslv23);
1948 MKATOM(text);
1949 MKATOM(octet);
1950 MKATOM(utf8);
1951
1952 MKATOM(sha1);
1953 MKATOM(sha224);
1954 MKATOM(sha256);
1955 MKATOM(sha384);
1956 MKATOM(sha512);
1957 MKATOM(md5);
1958 MKATOM(blake2b512);
1959 MKATOM(blake2s256);
1960 MKATOM(sha3_224);
1961 MKATOM(sha3_256);
1962 MKATOM(sha3_384);
1963 MKATOM(sha3_512);
1964 MKATOM(ripemd160);
1965
1966 MKATOM(pkcs1);
1967 MKATOM(pkcs1_oaep);
1968 MKATOM(none);
1969 MKATOM(block);
1970 MKATOM(encoding);
1971 MKATOM(algorithm);
1972 MKATOM(hmac);
1973 MKATOM(close_parent);
1974 MKATOM(padding);
1975
1976 FUNCTOR_public_key1 = PL_new_functor(PL_new_atom("public_key"), 1);
1977 FUNCTOR_private_key1 = PL_new_functor(PL_new_atom("private_key"), 1);
1978
1979 PL_register_foreign("crypto_n_random_bytes", 2, pl_crypto_n_random_bytes, 0);
1980
1981 PL_register_foreign("_crypto_context_new", 2,
1982 pl_crypto_hash_context_new, 0);
1983 PL_register_foreign("_crypto_update_hash_context", 2,
1984 pl_crypto_update_hash_context, 0);
1985 PL_register_foreign("_crypto_hash_context_copy", 2,
1986 pl_crypto_hash_context_copy, 0);
1987 PL_register_foreign("_crypto_hash_context_hash", 2,
1988 pl_crypto_hash_context_hash, 0);
1989
1990 PL_register_foreign("_crypto_open_hash_stream", 3,
1991 pl_crypto_open_hash_stream, 0);
1992 PL_register_foreign("_crypto_stream_hash_context", 2,
1993 pl_crypto_stream_hash_context, 0);
1994
1995 PL_register_foreign("_crypto_password_hash", 4, pl_crypto_password_hash, 0);
1996 PL_register_foreign("_crypto_data_hkdf", 7, pl_crypto_data_hkdf, 0);
1997
1998 PL_register_foreign("_crypto_ecdsa_sign", 4, pl_ecdsa_sign, 0);
1999 PL_register_foreign("_crypto_ecdsa_verify", 4, pl_ecdsa_verify, 0);
2000
2001 PL_register_foreign("rsa_private_decrypt", 4, pl_rsa_private_decrypt, 0);
2002 PL_register_foreign("rsa_private_encrypt", 4, pl_rsa_private_encrypt, 0);
2003 PL_register_foreign("rsa_public_decrypt", 4, pl_rsa_public_decrypt, 0);
2004 PL_register_foreign("rsa_public_encrypt", 4, pl_rsa_public_encrypt, 0);
2005 PL_register_foreign("rsa_sign", 5, pl_rsa_sign, 0);
2006 PL_register_foreign("rsa_verify", 5, pl_rsa_verify, 0);
2007 PL_register_foreign("_crypto_data_decrypt", 7, pl_crypto_data_decrypt, 0);
2008 PL_register_foreign("_crypto_data_encrypt", 8, pl_crypto_data_encrypt, 0);
2009
2010 PL_register_foreign("_crypto_modular_inverse", 3,
2011 pl_crypto_modular_inverse, 0);
2012 PL_register_foreign("_crypto_generate_prime", 4,
2013 pl_crypto_generate_prime, 0);
2014 PL_register_foreign("_crypto_is_prime", 2, pl_crypto_is_prime, 0);
2015
2016 PL_register_foreign("crypto_name_curve", 2, pl_crypto_name_curve, 0);
2017 PL_register_foreign("_crypto_curve_order", 2, pl_crypto_curve_order, 0);
2018 PL_register_foreign("_crypto_curve_generator", 3,
2019 pl_crypto_curve_generator, 0);
2020 PL_register_foreign("_crypto_curve_scalar_mult", 6,
2021 pl_crypto_curve_scalar_mult, 0);
2022 PL_register_foreign("crypto_set_debug", 1,
2023 crypto_set_debug, 0);
2024
2025 /*
2026 * Initialize crypto library
2027 */
2028 (void) crypto_lib_init();
2029
2030 }
2031
2032 install_t
2033 uninstall_crypto4pl(void)
2034 { crypto_lib_exit();
2035 }
2036