2 openssl.c -- Emacs Lisp binding to OpenSSL ciphers and digests
3 Copyright (C) 2005, 2006 Sebastian Freundt
5 Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 This file is part of SXEmacs
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. */
23 /* Copyright (C) 1995-1998 Eric Young (eay@cryptsoft.com)
24 * All rights reserved.
26 * This package is an SSL implementation written
27 * by Eric Young (eay@cryptsoft.com).
28 * The implementation was written so as to conform with Netscapes SSL.
30 * This library is free for commercial and non-commercial use as long as
31 * the following conditions are aheared to. The following conditions
32 * apply to all code found in this distribution, be it the RC4, RSA,
33 * lhash, DES, etc., code; not just the SSL code. The SSL documentation
34 * included with this distribution is covered by the same copyright terms
35 * except that the holder is Tim Hudson (tjh@cryptsoft.com).
37 * Copyright remains Eric Young's, and as such any Copyright notices in
38 * the code are not to be removed.
39 * If this package is used in a product, Eric Young should be given attribution
40 * as the author of the parts of the library used.
41 * This can be in the form of a textual message at program startup or
42 * in documentation (online or textual) provided with the package.
44 * Redistribution and use in source and binary forms, with or without
45 * modification, are permitted provided that the following conditions
47 * 1. Redistributions of source code must retain the copyright
48 * notice, this list of conditions and the following disclaimer.
49 * 2. Redistributions in binary form must reproduce the above copyright
50 * notice, this list of conditions and the following disclaimer in the
51 * documentation and/or other materials provided with the distribution.
52 * 3. All advertising materials mentioning features or use of this software
53 * must display the following acknowledgement:
54 * "This product includes cryptographic software written by
55 * Eric Young (eay@cryptsoft.com)"
56 * The word 'cryptographic' can be left out if the rouines from the library
57 * being used are not cryptographic related :-).
58 * 4. If you include any Windows specific code (or a derivative thereof) from
59 * the apps directory (application code) you must include an acknowledgement:
60 * "This product includes software written by Tim Hudson (tjh@cryptsoft.com)"
62 * THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND
63 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
64 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
65 * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
66 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
67 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
68 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
69 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
70 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
71 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
74 * The licence and distribution terms for any publically available version or
75 * derivative of this code cannot be changed. i.e. this code cannot simply be
76 * copied and put under another distribution licence
77 * [including the GNU Public Licence.]
81 * openssl provides an assortment of cryptographic routines and interfaces
83 * This API hook attempts to bring them all as pure as possible into SXE
84 * elisp. This in turn means that the feature 'openssl is NOT a higher
85 * level crypto library for elisp. Personally I consider implementing the
86 * latter one, too, based on the API provided by this feature.
89 * * Detailed overview:
90 * Currently provided routines:
91 * - all of openssl message digest algorithms (md)
92 * - all of openssl message authentication algorithms (hmac)
93 * - all of openssl (pseudo) random number generators (rand)
94 * - all of openssl symmetric block and stream cipher algorithms (cipher)
95 * - basic functionality of openssl asymmetric crypto-systems (pkey)
96 * - all of openssl envelope handling (hybrid)
97 * - all of EVP interface functionality minus `engine' support
98 * - all of PEM interface functionality
99 * - a simple SSL client
101 * In addition, we are trying hard to provide not only an exact elisp
102 * copy of openssl, but also a _comprehensive_ one
105 * * src/openssl.c: functions overview:
108 * ossl-version - version info
109 * ossl-available-digests - list of available message digests
110 * ossl-available-ciphers - list of available ciphers
111 * ossl-digest-bits - effective length of the digest in bits
112 * ossl-cipher-bits - effective length of the key in bits
115 * ossl-rand-bytes - generation of (pseudo) randomness
118 * ossl-digest - gateway to digest functions
121 * ossl-hmac - gateway to message authentication codes
124 * ossl-bytes-to-key - key generation for symmetric ciphers
125 * ossl-encrypt - gateway to symmetric cipher encryption
126 * ossl-decrypt - gateway to symmetric cipher decryption
130 * ossl-pkey-p - discriminator of public keys
131 * ossl-pkey-size - selector of public key sizes
132 * ossl-pkey-get-public - strip the private data
133 * Lisp_EVP_PKEY - lrecord object to store public keys
135 * ossl-rsa-generate-key - constructor of RSA public keys
136 * ossl-rsa-pkey-p - discriminator of RSA public keys
137 * ossl-rsa-subkey-p - comparator of two keys
139 * ossl-dsa-generate-key - constructor of DSA public keys
140 * ossl-dsa-pkey-p - discriminator of DSA public keys
141 * ossl-dsa-subkey-p - comparator of two keys
143 * ossl-ec-generate-key - constructor of EC public keys
144 * ossl-ec-pkey-p - discriminator of EC public keys
146 * ossl-dh-pkey-p - discriminator of DH public keys
149 * ossl-seal - gateway to public key hybrid (envelope) encryption
150 * ossl-open - gateway to public key hybrid (envelope) decryption
153 * ossl-sign - gateway to public key signature
154 * ossl-verify - gateway to public key signature verification
157 * ossl-pem-read-public-key
159 * ossl-pem-write-public-key
162 * - SSL (it is highly likely to change entirely)
163 * ossl-connect - constructor for SSL connection objects
164 * ossl-finish - destructor of SSL connection objects
165 * ossl-pending - predicate if data is available for read
168 * ossl-x509-get-subject
169 * ossl-x509-get-issuer
170 * ossl-x509-get-pubkey
171 * ossl-sslcipher-version
172 * ossl-sslcipher-name
173 * ossl-sslcipher-bits
176 * * Todo (internally):
177 * - implement the usage of engines
178 * - implement X.509 stuff
179 * - make TLS/SSL version selectable by user instead of #ifdef'fing it
183 * 1. Implement basic C stuff, mostly for accessing the structures
184 * which is evil and insecure if done with an elisp interface
185 * 2. Implement higher level API functions (without the guts of the actual
186 * OpenSSL libcrypto implementation)
187 * 3. Implement highest level user functions for actual daily consumption
188 * (e.g. keyrings, import/export of keys, stuff like that)
189 * 4. Build an API (called CERTS) on top of that which transparently
190 * brings security functions to elisp-libraries
192 * - install a master password system a la firefox
193 * - implement an opaque lisp type for storing security relevant stuff
194 * - securify parts of the obarray against other parts of it
195 * (useful e.g. for erbot which otherwise brags your secrets to the
200 * - any function using or needing random data assumes you have /dev/urandom
206 * (ossl-rand-bytes 8)
207 * (base16-encode-string (ossl-rand-bytes 16))
210 * (ossl-available-digests)
212 * (ossl-digest 'MD5 "test")
213 * (base16-encode-string (ossl-digest 'MD5 "test"))
217 * (base64-encode-string (ossl-digest 'SHA1 "test"))
219 * (base16-encode-string (ossl-digest 'RIPEMD160 "test"))
222 * (ossl-hmac 'md5 "testmess" "testpass")
224 * (base16-encode-string (ossl-hmac 'dsa-sha1 "testmess" "testpass"))
227 * ;; retrieve a list of available cipher algorithms first
228 * (ossl-available-ciphers)
230 * ;; generate a key/iv pair (iv = initialisation vector)
232 * (ossl-bytes-to-key 'AES-256-ECB 'RIPEMD160 nil "password" 1)
234 * ;; use a key/iv pair to initiate an encryption
235 * (setq key (ossl-bytes-to-key 'BF-CBC 'DSA-SHA1 "somesalt" "somepass" 24))
236 * (setq enc (ossl-encrypt 'BF-CBC "a test string" (car key) (cdr key)))
237 * ;; of course we can decrypt it again
238 * (ossl-decrypt 'BF-CBC enc (car key) (cdr key))
240 * (ossl-decrypt 'BF-ECB enc (car key) (cdr key))
241 * ;; this one yields an error since BF-CBC is not BF-ECB
248 * ;; generate an rsa key of size 2048
249 * (setq pkey (ossl-rsa-generate-key 2048 17))
250 * (ossl-rsa-pkey-p pkey)
252 * ;; generate an rsa key of size 1024 and flush the private data
253 * (setq k1 (ossl-rsa-generate-key 1024 17))
254 * (setq k2 (ossl-rsa-get-public k1))
255 * (setq k2 (ossl-pkey-get-public k1))
256 * ;; now check if k2 fits into k1 (i.e. if the public data is the same)
257 * (ossl-rsa-subkey-p k2 k1)
260 * ;; generate a dsa key of size 1024 (dsa is digital signature algo)
261 * ;; Note: I dont restrict the size, but it has to be <=1024 if
262 * ;; used to actually sign something
263 * (setq pkey (ossl-dsa-generate-key 1024))
264 * (ossl-dsa-pkey-p pkey)
266 * ;; now generate a dsa key again and flush the private data
267 * ;; k2 can then only be used to verify signatures
268 * (setq k1 (ossl-dsa-generate-key 1024))
269 * (setq k2 (ossl-dsa-get-public k1))
270 * (setq k2 (ossl-pkey-get-public k1))
271 * ;; check if k2 is a public copy of k1
272 * (ossl-dsa-subkey-p k2 k1)
275 * Note: For these functions you must have enabled EC in your OpenSSL lib
276 * (setq pkey (ossl-ec-generate-key))
277 * (ossl-ec-pkey-p pkey)
278 * ;; generate an ec (elliptic curve) key
279 * ;; Note: this is probably disabled in your openssl
280 * (when (featurep 'openssl-ec)
281 * (setq pkey (ossl-ec-generate-key))
282 * (ossl-ec-pkey-p pkey))
285 * Note: For these functions you must have enabled DH in your OpenSSL lib
289 * (setq key (ossl-rsa-generate-key 2048 3))
290 * (setq enc (ossl-seal 'AES-256-ECB "a tight secret" key))
291 * (ossl-open 'AES-256-ECB (car enc) key (cadr enc) (caddr enc))
293 * (ossl-open 'AES-256-ECB (car enc) key (cadr enc) "some other iv!!!")
294 * ;; this one is okay, too! since AES-256-ECB needs no IV
296 * (setq key (ossl-rsa-generate-key 2048 3))
297 * (ossl-open 'AES-256-ECB (car enc) key (cadr enc) (caddr enc))
298 * ;; this yields probably an error since now key holds another key!
301 * (setq key (ossl-dsa-generate-key 1024))
302 * (setq sig (ossl-sign 'DSA-SHA1 "this is MY msg" key))
303 * (ossl-verify 'DSA-SHA1 "this is MY msg" sig key)
305 * (ossl-verify 'DSA-SHA1 "this is not MY msg" sig key)
307 * (setq key (ossl-rsa-generate-key 2048 3))
308 * (setq sig1 (ossl-sign 'RSA-MD5 "this is MY msg" key))
309 * (setq sig2 (ossl-sign 'RSA-MD5 "this is MY other msg" key))
310 * (ossl-verify 'RSA-MD5 "this is MY msg" sig1 key)
312 * (ossl-verify 'RSA-SHA1 "this is MY msg" sig2 key)
314 * (setq key (ossl-ec-generate-key))
315 * (setq sig (ossl-sign 'ecdsa-with-SHA1 "this is MY msg" key))
316 * (ossl-verify 'ecdsa-with-SHA1 "this is MY msg" sig key)
319 * (setq key (ossl-rsa-generate-key 1024 3))
320 * (ossl-pem-write-key "/tmp/pkey1.pem" key)
321 * (ossl-pem-write-key "/tmp/pkey2.pem" key 'AES-256-ECB "somepass")
322 * (ossl-pem-write-public-key "/tmp/pkeyp.pem" key)
326 * (setq p (open-network-stream "tmp" "tmp" "www.redhat.com" "443"))
327 * (setq m (ossl-connect p))
328 * (ossl-x509-get-subject m)
329 * (ossl-x509-get-issuer m)
330 * (ossl-x509-get-pubkey m)
331 * (ossl-cipher-get-version m)
332 * (ossl-cipher-get-name m)
348 #include "events/events.h"
350 #include "procimpl.h"
358 #include "mule/file-coding.h"
361 #ifdef HAVE_POSTGRESQL
362 #include "database/postgresql.h"
365 #define OSSL_CODING Qbinary
367 #define OSSL_STRING_LENGTH XSTRING_CHAR_LENGTH
369 static Lisp_Object Qopenssl;
371 #define __OSSL_DEBUG__(args...) fprintf(stderr, "OSSL " args)
372 #ifndef OSSL_DEBUG_FLAG
373 #define OSSL_DEBUG(args...)
375 #define OSSL_DEBUG(args...) __OSSL_DEBUG__(args)
377 #define OSSL_DEBUG_CTX(args...) OSSL_DEBUG("[connection]: " args)
378 #define OSSL_CRITICAL(args...) __OSSL_DEBUG__("CRITICAL: " args)
381 int ossl_pkey_has_public_data(EVP_PKEY *pkey);
382 int ossl_pkey_has_private_data(EVP_PKEY *pkey);
384 int rsa_pkey_p(EVP_PKEY *pkey);
385 #ifndef OPENSSL_NO_RSA
386 int rsa_pkey_has_public_data(RSA *rsakey);
387 int rsa_pkey_has_private_data(RSA *rsakey);
390 int dsa_pkey_p(EVP_PKEY *pkey);
391 #ifndef OPENSSL_NO_DSA
392 int dsa_pkey_has_public_data(DSA *dsakey);
393 int dsa_pkey_has_private_data(DSA *dsakey);
394 DSA *dsa_get_public(EVP_PKEY *pk);
397 int ec_pkey_p(EVP_PKEY *pkey);
398 #ifndef OPENSSL_NO_EC
399 int ec_pkey_has_public_data(EC_KEY *ec_key);
400 int ec_pkey_has_private_data(EC_KEY *ec_key);
401 EC_KEY *ec_get_public(EVP_PKEY *pk);
402 int ec_curve_by_name(char *name);
405 int dh_pkey_p(EVP_PKEY *pkey);
406 #ifndef OPENSSL_NO_DH
407 int dh_pkey_has_public_data(DH *dh_key);
408 int dh_pkey_has_private_data(DH *dh_key);
409 DH *dh_get_public(EVP_PKEY *pk);
412 #ifdef OSSL_DEBUG_FLAG
413 static long ossl_bio_dump_callback(BIO*, int, const char*, int, long, long);
415 static int ossl_ssl_proselytise_process(Lisp_Object, Lisp_Object);
416 static int ossl_ssl_unproselytise_process(Lisp_Object, Lisp_Object);
417 int ossl_ssl_inject_ca(Lisp_Object, Lisp_Object);
418 int ossl_ssl_inject_ca_file(Lisp_Object, Lisp_Object);
419 int ossl_ssl_inject_ca_path(Lisp_Object, Lisp_Object);
420 int ossl_ssl_inject_cert(Lisp_Object, Lisp_Object, Lisp_Object);
421 int ossl_ssl_inject_cert_file(Lisp_Object, Lisp_Object, Lisp_Object);
423 Lisp_Object Qssl2, Qssl23, Qssl3, Qtls1;
425 extern Lisp_Object Qfile_readable_p;
426 extern Lisp_Object Qfile_writable_p;
433 DEFUN("ossl-version", Fossl_version, 0, 0, 0, /*
434 Return a descriptive version number of the OpenSSL in use.
438 return build_string(SSLeay_version(SSLEAY_VERSION));
442 DEFUN("ossl-available-digests", Fossl_available_digests, 0, 0, 0, /*
443 Return a list of digest algorithms in the underlying crypto library.
444 This yields a plain list of symbols.
453 OpenSSL_add_all_digests();
455 /* is there a better way to get the size of the nid list? */
456 for (nid = 10000; nid >= 0; --nid) {
457 const EVP_MD *digest = EVP_get_digestbynid(nid);
459 digests = Fcons(intern(OBJ_nid2sn(nid)), digests);
469 DEFUN("ossl-available-ciphers", Fossl_available_ciphers, 0, 0, 0, /*
470 Return a list of cipher algorithms in the underlying crypto library.
471 This yields a plain list of symbols.
478 OpenSSL_add_all_ciphers();
482 /* is there a better way to get the size of the nid list? */
483 for (nid = 10000; nid >= 0; --nid) {
484 const EVP_CIPHER *cipher = EVP_get_cipherbynid(nid);
486 ciphers = Fcons(intern(OBJ_nid2sn(nid)), ciphers);
496 #define ossl_digest_fun(var, fun) \
499 const EVP_MD *__md; \
501 OpenSSL_add_all_digests(); \
503 __md = EVP_get_digestbyname( \
504 (char *)string_data(XSYMBOL(var)->name)); \
519 ossl_digest_size(Lisp_Object digest)
521 ossl_digest_fun(digest, EVP_MD_size);
525 ossl_digest_block_size(Lisp_Object digest)
527 ossl_digest_fun(digest, EVP_MD_block_size);
530 DEFUN("ossl-digest-size", Fossl_digest_size, 1, 1, 0, /*
531 Return the hash length of DIGEST in bytes.
535 int size = ossl_digest_size(digest);
538 error ("no such cipher");
540 return make_int(size);
544 DEFUN("ossl-digest-bits", Fossl_digest_bits, 1, 1, 0, /*
545 Return the number of effective output bits of DIGEST.
549 int size = ossl_digest_size(digest);
552 error ("no such digest");
554 return make_int(size*8);
557 DEFUN("ossl-digest-block-size", Fossl_digest_block_size, 1, 1, 0, /*
558 Return the block size of DIGEST in bytes.
562 int size = ossl_digest_block_size(digest);
565 error ("no such digest");
567 return make_int(size);
571 #define ossl_cipher_fun(var, fun) \
574 const EVP_CIPHER *__ciph; \
576 OpenSSL_add_all_ciphers(); \
578 __ciph = EVP_get_cipherbyname( \
579 (char *)string_data(XSYMBOL(var)->name)); \
586 __kl = fun(__ciph); \
594 ossl_cipher_key_length(Lisp_Object cipher)
596 ossl_cipher_fun(cipher, EVP_CIPHER_key_length);
600 ossl_cipher_iv_length(Lisp_Object cipher)
602 ossl_cipher_fun(cipher, EVP_CIPHER_iv_length);
606 ossl_cipher_block_size(Lisp_Object cipher)
608 ossl_cipher_fun(cipher, EVP_CIPHER_block_size);
612 ossl_cipher_mode(Lisp_Object cipher)
614 ossl_cipher_fun(cipher, EVP_CIPHER_mode);
617 DEFUN("ossl-cipher-key-length", Fossl_cipher_key_length, 1, 1, 0, /*
618 Return the effective key length of CIPHER in bytes.
622 int size = ossl_cipher_key_length(cipher);
625 error ("no such cipher");
627 return make_int(size);
631 DEFUN("ossl-cipher-bits", Fossl_cipher_bits, 1, 1, 0, /*
632 Return the effective key size of CIPHER in bits.
636 int size = ossl_cipher_key_length(cipher);
639 error ("no such cipher");
641 return make_int(size*8);
644 DEFUN("ossl-cipher-iv-length", Fossl_cipher_iv_length, 1, 1, 0, /*
645 Return the initialisation vector length of CIPHER in bytes.
649 int size = ossl_cipher_iv_length(cipher);
652 error ("no such cipher");
654 return make_int(size);
657 DEFUN("ossl-cipher-block-size", Fossl_cipher_block_size, 1, 1, 0, /*
658 Return the block size of CIPHER in bytes.
662 int size = ossl_cipher_block_size(cipher);
665 error ("no such cipher");
667 return make_int(size);
670 DEFUN("ossl-cipher-mode", Fossl_cipher_mode, 1, 1, 0, /*
671 Return the operation mode of CIPHER.
675 Lisp_Object result = Qnil;
676 int mode = ossl_cipher_mode(cipher);
679 error ("no such cipher");
682 case EVP_CIPH_STREAM_CIPHER:
683 result = intern("stream");
685 case EVP_CIPH_ECB_MODE:
686 result = intern("ecb");
688 case EVP_CIPH_CBC_MODE:
689 result = intern("cbc");
691 case EVP_CIPH_CFB_MODE:
692 result = intern("cfb");
694 case EVP_CIPH_OFB_MODE:
695 result = intern("ofb");
698 result = intern("cbc");
711 DEFUN("ossl-rand-bytes", Fossl_rand_bytes, 1, 1, 0, /*
712 Return COUNT bytes of randomness.
714 Note: You probably want to put a wrapping encoder function
715 \(like `base16-encode-string'\) around it, since this returns
721 Lisp_Object l_outbuf;
724 int speccount = specpdl_depth(), res;
727 count_ext = (int)XINT(count);
729 /* now allocate some output buffer externally */
730 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, count_ext, char);
732 res = RAND_bytes((unsigned char*)outbuf, count_ext);
734 error("RAND_bytes did not have enough seed "
735 "to perform operation");
737 } else if (res < 0) {
738 error("RAND_bytes failed");
742 l_outbuf = make_ext_string(outbuf, count_ext, OSSL_CODING);
743 XMALLOC_UNBIND(outbuf, count_ext, speccount);
748 DEFUN("ossl-rand-bytes-egd", Fossl_rand_bytes_egd, 1, 2, 0, /*
749 Return COUNT bytes of randomness from an EGD socket.
750 By default use the socket /var/run/egd-pool.
752 Note: You probably want to put a wrapping encoder function
753 \(like `base16-encode-string'\) around it, since this returns
758 /* This function can GC */
760 Lisp_Object l_outbuf;
762 int speccount = specpdl_depth(), res;
764 struct gcpro gcpro1, gcpro2;
771 egd = Fexpand_file_name(egd, Qnil);
772 if (NILP(Ffile_exists_p(egd)))
775 count_ext = XINT(count);
777 /* now allocate some output buffer externally */
778 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, count_ext, char);
781 res = RAND_query_egd_bytes((char*)XSTRING_DATA(egd),
782 (unsigned char*)outbuf, count_ext);
784 res = RAND_query_egd_bytes("/var/run/egd-pool",
785 (unsigned char*)outbuf, count_ext);
789 error("RAND_query_egd_bytes did not have enough seed "
790 "to perform operation");
792 } else if (res < 0) {
794 error("RAND_query_egd_bytes failed");
798 l_outbuf = make_ext_string(outbuf, count_ext, OSSL_CODING);
799 XMALLOC_UNBIND(outbuf, count_ext, speccount);
810 DEFUN("ossl-digest", Fossl_digest, 2, 2, 0, /*
811 Return the message digest of STRING computed by DIGEST.
812 DIGEST may be one of the OpenSSL digests you have compiled.
813 See `ossl-available-digests'.
815 Note: You probably want to put a wrapping encoder function
816 \(like `base16-encode-string'\) around it, since this returns
823 char md_value[EVP_MAX_MD_SIZE];
826 CHECK_SYMBOL(digest);
827 CHECK_STRING(string);
829 OpenSSL_add_all_digests();
830 md = EVP_get_digestbyname(
831 (char *)string_data(XSYMBOL(digest)->name));
835 error ("no such digest");
838 mdctx = xnew(EVP_MD_CTX);
839 EVP_MD_CTX_init(mdctx);
840 EVP_DigestInit_ex(mdctx, md, NULL);
841 EVP_DigestUpdate(mdctx,(char*)XSTRING_DATA(string),
842 XSTRING_LENGTH(string));
843 EVP_DigestFinal_ex(mdctx, (unsigned char *)md_value, &md_len);
844 EVP_MD_CTX_cleanup(mdctx);
849 return make_ext_string(md_value, md_len, OSSL_CODING);
852 DEFUN("ossl-digest-file", Fossl_digest_file, 2, 2, 0, /*
853 Return the message digest of the contents of FILE computed by DIGEST.
854 DIGEST may be one of the OpenSSL digests you have compiled.
855 See `ossl-available-digests'.
857 Note: You probably want to put a wrapping encoder function
858 \(like `base16-encode-string'\) around it, since this returns
865 unsigned char md_value[EVP_MAX_MD_SIZE];
866 unsigned int md_len, md_blocksize;
872 CHECK_SYMBOL(digest);
876 file = Fexpand_file_name(file, Qnil);
878 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
879 (fseek(fp, 0, SEEK_SET))) {
882 return wrong_type_argument(Qfile_readable_p, file);
885 OpenSSL_add_all_digests();
886 md = EVP_get_digestbyname(
887 (char *)string_data(XSYMBOL(digest)->name));
892 error ("no such digest");
895 mdctx = xnew(EVP_MD_CTX);
896 EVP_MD_CTX_init(mdctx);
897 md_blocksize = (unsigned int)(EVP_MD_block_size(md) / 8);
899 EVP_DigestInit_ex(mdctx, md, NULL);
901 /* we reuse md_value here for streaming over fp */
903 n = fread(md_value, 1, EVP_MAX_MD_SIZE, fp);
908 error("file corrupted");
911 EVP_DigestUpdate(mdctx, md_value, n);
914 EVP_DigestFinal_ex(mdctx, md_value, &md_len);
915 EVP_MD_CTX_cleanup(mdctx);
921 return make_ext_string((char *)md_value, md_len, OSSL_CODING);
927 * HMAC (aka keyed hashes)
930 DEFUN("ossl-hmac", Fossl_hmac, 3, 3, 0, /*
931 Return the message authentication code of MSG
932 using the hash function DIGEST and the key PASSWORD.
934 Note: You probably want to put a wrapping encoder function
935 \(like `base16-encode-string'\) around it, since this returns
938 (digest, msg, password))
943 /* buffer for the ciphertext */
944 unsigned char outbuf[EVP_MAX_MD_SIZE];
946 /* buffer for external password */
948 unsigned int password_len;
950 /* buffer for external message */
952 unsigned int msg_len;
955 CHECK_SYMBOL(digest);
957 CHECK_STRING(password);
959 OpenSSL_add_all_digests();
960 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
964 error ("no such digest");
967 TO_EXTERNAL_FORMAT (LISP_STRING, password,
968 C_STRING_ALLOCA, password_ext, OSSL_CODING);
969 password_len = OSSL_STRING_LENGTH(password);
971 #if 0 /* i wonder why */
972 TO_EXTERNAL_FORMAT (LISP_STRING, msg,
973 C_STRING_ALLOCA, msg_ext, OSSL_CODING);
974 msg_len = OSSL_STRING_LENGTH(msg);
977 hmacctx = xnew(HMAC_CTX);
978 HMAC_CTX_init(hmacctx);
979 HMAC_Init(hmacctx, password_ext, password_len, md);
980 HMAC_Update(hmacctx, (unsigned char*)XSTRING_DATA(msg),
981 XSTRING_LENGTH(msg));
982 HMAC_Final(hmacctx, outbuf, &outlen);
983 HMAC_CTX_cleanup(hmacctx);
988 return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
991 DEFUN("ossl-hmac-file", Fossl_hmac_file, 3, 3, 0, /*
992 Return the message authentication code of the contents of FILE
993 using the hash function DIGEST and the key PASSWORD.
995 Note: You probably want to put a wrapping encoder function
996 \(like `base16-encode-string'\) around it, since this returns
999 (digest, file, password))
1004 /* buffer for the ciphertext */
1005 unsigned char outbuf[EVP_MAX_MD_SIZE];
1006 unsigned int outlen;
1008 /* buffer for external password */
1010 unsigned int password_len;
1014 CHECK_SYMBOL(digest);
1016 CHECK_STRING(password);
1018 file = Fexpand_file_name(file, Qnil);
1020 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1021 (fseek(fp, 0, SEEK_SET))) {
1024 return wrong_type_argument(Qfile_readable_p, file);
1028 OpenSSL_add_all_digests();
1029 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
1033 error ("no such digest");
1036 TO_EXTERNAL_FORMAT (LISP_STRING, password,
1037 C_STRING_ALLOCA, password_ext, OSSL_CODING);
1038 password_len = OSSL_STRING_LENGTH(password);
1040 hmacctx = xnew(HMAC_CTX);
1041 HMAC_CTX_init(hmacctx);
1042 HMAC_Init(hmacctx, password_ext, password_len, md);
1044 /* we reuse md_value here for streaming over fp */
1046 n = fread(outbuf, 1, EVP_MAX_MD_SIZE, fp);
1051 error("file corrupted");
1054 HMAC_Update(hmacctx, outbuf, n);
1057 HMAC_Final(hmacctx, outbuf, &outlen);
1058 HMAC_CTX_cleanup(hmacctx);
1064 return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1073 DEFUN("ossl-bytes-to-key", Fossl_bytes_to_key, 5, 5, 0, /*
1074 Derive a key and initialisation vector (iv) suitable for a cipher.
1075 Return a string KEY being the key. The initialisation vector is
1076 put into KEY's property list as 'iv.
1078 CIPHER \(a symbol\) is the cipher to derive the key and IV for.
1079 Valid ciphers can be obtained by `ossl-available-ciphers'.
1081 DIGEST \(a symbol\) is the message digest to use.
1082 Valid digests can be obtained by `ossl-available-digests'.
1084 SALT \(string or `nil'\) is used as a salt in the derivation.
1085 Use `nil' here to indicate that no salt is used.
1087 PASSWORD is an arbitrary string which is processed to derive a
1090 COUNT \(a positive integer\) is the iteration count to use. This
1091 indicates how often the hash algorithm is called recursively.
1093 Note: You probably want to put a wrapping encoder function
1094 \(like `base16-encode-string'\) around it, since this returns
1097 (cipher, digest, salt, password, count))
1100 const EVP_CIPHER *ciph;
1101 const char *salt_ext;
1104 unsigned int password_len;
1106 char key[EVP_MAX_KEY_LENGTH];
1107 char iv[EVP_MAX_IV_LENGTH];
1111 CHECK_STRING(password);
1112 CHECK_SYMBOL(cipher);
1113 CHECK_SYMBOL(digest);
1114 CHECK_NATNUM(count);
1118 error ("count has to be a non-zero positive integer");
1120 OpenSSL_add_all_algorithms();
1121 md = EVP_get_digestbyname(
1122 (char *)string_data(XSYMBOL(digest)->name));
1123 ciph = EVP_get_cipherbyname(
1124 (char *)string_data(XSYMBOL(cipher)->name));
1128 error ("no such cipher");
1133 error ("no such digest");
1140 TO_EXTERNAL_FORMAT (LISP_STRING, salt,
1141 C_STRING_ALLOCA, salt_ext, OSSL_CODING);
1145 TO_EXTERNAL_FORMAT (LISP_STRING, password,
1146 C_STRING_ALLOCA, password_ext, OSSL_CODING);
1147 password_len = OSSL_STRING_LENGTH(password);
1149 EVP_BytesToKey(ciph, md, (const unsigned char *)salt_ext,
1150 (const unsigned char *)password_ext, password_len,
1152 (unsigned char *)key,
1153 (unsigned char *)iv);
1157 result = make_ext_string(key, EVP_CIPHER_key_length(ciph), OSSL_CODING);
1158 Fput(result, intern("iv"),
1159 make_ext_string(iv, EVP_CIPHER_iv_length(ciph), OSSL_CODING));
1165 DEFUN("ossl-encrypt", Fossl_encrypt, 3, 4, 0, /*
1166 Return the cipher of STRING computed by CIPHER under KEY.
1168 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1169 you have compiled. See `ossl-available-ciphers'.
1171 STRING is the text to be encrypted.
1173 KEY should be a key generated suitably for this cipher, for example
1174 by `ossl-bytes-to-key'.
1176 Optional fourth argument IV should be an initialisation vector
1177 suitable for this cipher. Normally the initialisation vector from
1178 KEY's property list is used. However, if IV is
1179 non-nil, use this IV instead.
1181 Note: You probably want to put a wrapping encoder function
1182 \(like `base16-encode-string'\) around it, since this returns
1185 (cipher, string, key, iv))
1187 /* buffer for the external string */
1189 unsigned int string_len;
1190 /* buffer for the ciphertext */
1193 Lisp_Object l_outbuf;
1194 /* buffer for key */
1199 /* declarations for the cipher */
1200 const EVP_CIPHER *ciph;
1201 EVP_CIPHER_CTX *ciphctx;
1204 int speccount = specpdl_depth();
1207 /* frob the IV from the plist of key maybe */
1209 iv = Fget(key, intern("iv"), Qnil);
1211 CHECK_SYMBOL(cipher);
1212 CHECK_STRING(string);
1216 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1217 C_STRING_ALLOCA, string_ext, OSSL_CODING);
1218 string_len = OSSL_STRING_LENGTH(string);
1220 if (string_len <= 0)
1221 error ("string must be of non-zero positive length.");
1223 OpenSSL_add_all_algorithms();
1224 /* ENGINE_load_builtin_engines(); */
1225 /* atm, no support for different engines */
1226 ciph = EVP_get_cipherbyname(
1227 (char *)string_data(XSYMBOL(cipher)->name));
1231 error ("no such cipher");
1234 /* now allocate some output buffer externally
1235 * this one has to be at least EVP_CIPHER_block_size bigger
1236 * since block algorithms merely operate blockwise
1238 alloclen = XSTRING_LENGTH(string) + EVP_CIPHER_block_size(ciph);
1239 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1241 TO_EXTERNAL_FORMAT(LISP_STRING, key,
1242 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1243 TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1244 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1246 ciphctx = xnew(EVP_CIPHER_CTX);
1247 EVP_CIPHER_CTX_init(ciphctx);
1248 if (!EVP_EncryptInit(ciphctx, ciph,
1249 (unsigned char *)key_ext,
1250 (unsigned char *)iv_ext)) {
1253 error ("error in EncryptInit");
1255 if (!EVP_EncryptUpdate(ciphctx,
1256 (unsigned char *)outbuf, &outlen,
1257 (unsigned char *)string_ext, string_len)) {
1260 error ("error in EncryptUpdate");
1262 /* Buffer passed to EVP_EncryptFinal() must be after data just
1263 * encrypted to avoid overwriting it.
1265 if (!EVP_EncryptFinal(ciphctx,
1266 (unsigned char *)outbuf+outlen, &tmplen)) {
1269 error ("error in EncryptFinal");
1271 /* added probable padding space to the length of the output buffer */
1273 EVP_CIPHER_CTX_cleanup(ciphctx);
1275 l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1276 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1284 DEFUN("ossl-encrypt-file", Fossl_encrypt_file, 3, 5, 0, /*
1285 Return the encrypted contents of FILE computed by CIPHER under KEY.
1287 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1288 you have compiled. See `ossl-available-ciphers'.
1290 FILE is the file to be encrypted.
1292 Third argument KEY should be a key generated suitably for this
1293 cipher, for example by `ossl-bytes-to-key'.
1295 Optional fourth argument IV should be an initialisation vector
1296 suitable for this cipher. Normally the initialisation vector from
1297 KEY's property list is used. However, if IV is
1298 non-nil, use this IV instead.
1300 Optional fifth argument OUTFILE may specify a file to have the
1301 encrypted data redirected.
1303 Note: You probably want to put a wrapping encoder function
1304 \(like `base16-encode-string'\) around it, since this returns
1307 (cipher, file, key, iv, outfile))
1309 /* buffer for the external string */
1310 unsigned char string_in[1024];
1312 unsigned int block_len;
1313 unsigned long file_size;
1314 /* buffer for the ciphertext */
1315 unsigned char *outbuf;
1318 Lisp_Object l_outbuf;
1319 /* buffer for key */
1329 /* declarations for the cipher */
1330 const EVP_CIPHER *ciph;
1331 EVP_CIPHER_CTX *ciphctx;
1334 int speccount = specpdl_depth();
1337 /* frob the IV from the plist of key maybe */
1339 iv = Fget(key, intern("iv"), Qnil);
1341 CHECK_SYMBOL(cipher);
1346 if (!NILP(outfile)) {
1347 CHECK_STRING(outfile);
1348 outfile = Fexpand_file_name(outfile, Qnil);
1349 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1350 return wrong_type_argument(Qfile_writable_p, outfile);
1355 file = Fexpand_file_name(file, Qnil);
1356 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1357 (fseek(fp, 0, SEEK_SET))) {
1362 return wrong_type_argument(Qfile_readable_p, file);
1365 fseek(fp, 0, SEEK_END);
1366 file_size = ftell(fp);
1367 fseek(fp, 0, SEEK_SET);
1370 OpenSSL_add_all_algorithms();
1371 /* ENGINE_load_builtin_engines(); */
1372 /* atm, no support for different engines */
1373 ciph = EVP_get_cipherbyname(
1374 (char *)string_data(XSYMBOL(cipher)->name));
1381 error ("no such cipher");
1384 /* now allocate some output buffer externally
1385 * this one has to be at least EVP_CIPHER_block_size bigger
1386 * since block algorithms merely operate blockwise
1388 block_len = EVP_CIPHER_block_size(ciph);
1389 if (UNLIKELY(of != NULL)) {
1392 alloclen = file_size + block_len;
1394 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1396 TO_EXTERNAL_FORMAT(LISP_STRING, key,
1397 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1398 TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1399 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1401 ciphctx = xnew(EVP_CIPHER_CTX);
1402 EVP_CIPHER_CTX_init(ciphctx);
1403 if (!EVP_EncryptInit(ciphctx, ciph,
1404 (unsigned char *)key_ext,
1405 (unsigned char *)iv_ext)) {
1411 error("error in EncryptInit");
1417 string_len = fread(string_in, 1, 1024, fp);
1418 if (string_len < 0) {
1424 error("file corrupted");
1429 if (string_len > 0 &&
1430 !EVP_EncryptUpdate(ciphctx,
1432 string_in, string_len)) {
1438 error("error in EncryptUpdate");
1442 fwrite(obp, 1, tmplen, of);
1447 } while (string_len > 0);
1449 /* Buffer passed to EVP_EncryptFinal() must be after data just
1450 * encrypted to avoid overwriting it.
1452 if (!EVP_EncryptFinal(ciphctx, obp, &tmplen)) {
1458 error("error in EncryptFinal");
1462 fwrite(obp, 1, tmplen, of);
1464 /* added probable padding space to the length of the output buffer */
1466 EVP_CIPHER_CTX_cleanup(ciphctx);
1468 if (UNLIKELY(of != NULL)) {
1471 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1473 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1484 (setq k (ossl-bytes-to-key 'AES-256-OFB 'SHA1 nil "password" 1))
1485 (ossl-encrypt-file 'AES-256-OFB "~/.gnus" k nil "/tmp/gnus-enc")
1486 (ossl-decrypt-file 'AES-256-OFB "/tmp/gnus-enc" k nil "/tmp/gnus-dec")
1490 DEFUN("ossl-decrypt", Fossl_decrypt, 3, 4, 0, /*
1491 Return the deciphered version of STRING computed by CIPHER under KEY.
1493 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1494 you have compiled. See `ossl-available-ciphers'.
1496 STRING is the text to be decrypted.
1498 KEY should be a key generated suitably for this
1499 cipher, for example by `ossl-bytes-to-key'.
1501 Optional fourth argument IV should be an initialisation vector
1502 suitable for this cipher. Normally the initialisation vector from
1503 KEY's property list is used. However, if IV is
1504 non-nil, use this IV instead.
1506 (cipher, string, key, iv))
1508 /* buffer for the external string */
1510 unsigned int string_len;
1511 /* buffer for the deciphered text */
1514 Lisp_Object l_outbuf;
1515 /* buffer for key */
1520 /* declarations for the decipher */
1521 const EVP_CIPHER *ciph;
1522 EVP_CIPHER_CTX *ciphctx;
1525 int speccount = specpdl_depth();
1528 /* frob the IV from the plist of key maybe */
1530 iv = Fget(key, intern("iv"), Qnil);
1532 CHECK_SYMBOL(cipher);
1533 CHECK_STRING(string);
1537 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1538 C_STRING_ALLOCA, string_ext, OSSL_CODING);
1539 string_len = OSSL_STRING_LENGTH(string);
1542 error ("string must be of non-zero positive length.");
1544 OpenSSL_add_all_algorithms();
1545 /* ENGINE_load_builtin_engines(); */
1546 /* atm, no support for different engines */
1547 ciph = EVP_get_cipherbyname(
1548 (char *)string_data(XSYMBOL(cipher)->name));
1552 error ("no such cipher");
1555 /* now allocate some output buffer externally */
1556 alloclen = XSTRING_LENGTH(string);
1557 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1559 TO_EXTERNAL_FORMAT (LISP_STRING, key,
1560 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1561 TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1562 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1564 ciphctx = xnew(EVP_CIPHER_CTX);
1565 EVP_CIPHER_CTX_init(ciphctx);
1566 if (!EVP_DecryptInit(ciphctx, ciph,
1567 (unsigned char *)key_ext,
1568 (unsigned char *)iv_ext)) {
1571 error ("error in DecryptInit");
1573 if (!EVP_DecryptUpdate(ciphctx,
1574 (unsigned char *)outbuf, &outlen,
1575 (unsigned char *)string_ext,string_len)) {
1578 error ("error in DecryptUpdate");
1580 /* Buffer passed to EVP_EncryptFinal() must be after data just
1581 * encrypted to avoid overwriting it.
1583 if (!EVP_DecryptFinal(ciphctx,
1584 (unsigned char *)outbuf+outlen, &tmplen)) {
1587 error ("error in DecryptFinal");
1589 /* added probable padding space to the length of the output buffer */
1591 EVP_CIPHER_CTX_cleanup(ciphctx);
1593 l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1594 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1602 DEFUN("ossl-decrypt-file", Fossl_decrypt_file, 3, 5, 0, /*
1603 Return the deciphered version of FILE computed by CIPHER under KEY.
1605 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1606 you have compiled. See `ossl-available-ciphers'.
1608 FILE is the file to be decrypted.
1610 Third argument KEY should be a key generated suitably for this
1611 cipher, for example by `ossl-bytes-to-key'.
1613 Optional fourth argument IV should be an initialisation vector
1614 suitable for this cipher. Normally the initialisation vector from
1615 KEY's property list is used. However, if IV is
1616 non-nil, use this IV instead.
1618 Optional fifth argument OUTFILE may specify a file to have the
1619 encrypted data redirected.
1621 (cipher, file, key, iv, outfile))
1623 /* buffer for the external string */
1624 unsigned char string_in[1024];
1626 unsigned int block_len;
1627 unsigned long file_size;
1628 /* buffer for the deciphered text */
1629 unsigned char *outbuf;
1632 Lisp_Object l_outbuf;
1633 /* buffer for key */
1643 /* declarations for the decipher */
1644 const EVP_CIPHER *ciph;
1645 EVP_CIPHER_CTX *ciphctx;
1648 int speccount = specpdl_depth();
1651 /* frob the IV from the plist of key maybe */
1653 iv = Fget(key, intern("iv"), Qnil);
1655 CHECK_SYMBOL(cipher);
1660 if (!NILP(outfile)) {
1661 CHECK_STRING(outfile);
1662 outfile = Fexpand_file_name(outfile, Qnil);
1663 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1664 return wrong_type_argument(Qfile_writable_p, outfile);
1669 file = Fexpand_file_name(file, Qnil);
1670 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1671 (fseek(fp, 0, SEEK_SET))) {
1676 return wrong_type_argument(Qfile_readable_p, file);
1679 fseek(fp, 0, SEEK_END);
1680 file_size = ftell(fp);
1681 fseek(fp, 0, SEEK_SET);
1684 OpenSSL_add_all_algorithms();
1685 /* ENGINE_load_builtin_engines(); */
1686 /* atm, no support for different engines */
1687 ciph = EVP_get_cipherbyname(
1688 (char *)string_data(XSYMBOL(cipher)->name));
1695 error ("no such cipher");
1698 /* now allocate some output buffer externally */
1699 block_len = EVP_CIPHER_block_size(ciph);
1700 if (UNLIKELY(of != NULL)) {
1703 alloclen = file_size + block_len;
1705 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1707 TO_EXTERNAL_FORMAT (LISP_STRING, key,
1708 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1709 TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1710 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1712 ciphctx = xnew(EVP_CIPHER_CTX);
1713 EVP_CIPHER_CTX_init(ciphctx);
1714 if (!EVP_DecryptInit(ciphctx, ciph,
1715 (unsigned char *)key_ext,
1716 (unsigned char *)iv_ext)) {
1722 error ("error in DecryptInit");
1728 string_len = fread(string_in, 1, 1024, fp);
1729 if (string_len < 0) {
1735 error("file corrupted");
1740 if (string_len > 0 &&
1741 !EVP_DecryptUpdate(ciphctx,
1743 string_in, string_len)) {
1749 error ("error in DecryptUpdate");
1753 fwrite(obp, 1, tmplen, of);
1758 } while (string_len > 0);
1760 /* Buffer passed to EVP_EncryptFinal() must be after data just
1761 * encrypted to avoid overwriting it.
1763 if (!EVP_DecryptFinal(ciphctx, obp, &tmplen)) {
1769 error ("error in DecryptFinal");
1773 fwrite(obp, 1, tmplen, of);
1775 /* added probable padding space to the length of the output buffer */
1777 EVP_CIPHER_CTX_cleanup(ciphctx);
1779 if (UNLIKELY(of != NULL)) {
1782 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1784 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1801 /* This is an opaque object for storing PKEYs in lisp */
1802 Lisp_Object Qevp_pkeyp;
1805 mark_evp_pkey(Lisp_Object obj)
1807 /* avoid some warning */
1813 print_evp_pkey(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1819 pkey = XEVPPKEY(obj)->evp_pkey;
1820 x509 = XEVPPKEY(obj)->x509;
1822 write_c_string("#<OpenSSL", printcharfun);
1825 X509_NAME *iss = X509_get_issuer_name(x509);
1826 X509_NAME *sub = X509_get_subject_name(x509);
1827 write_c_string(" X509 Certificate", printcharfun);
1828 write_c_string(" iss:", printcharfun);
1829 write_c_string(X509_NAME_oneline(sub, NULL, 0), printcharfun);
1830 write_c_string(" sub:", printcharfun);
1831 write_c_string(X509_NAME_oneline(iss, NULL, 0), printcharfun);
1836 write_c_string(";", printcharfun);
1838 if (rsa_pkey_p(pkey))
1839 write_c_string(" RSA", printcharfun);
1840 else if (dsa_pkey_p(pkey))
1841 write_c_string(" DSA", printcharfun);
1842 else if (ec_pkey_p(pkey))
1843 write_c_string(" EC", printcharfun);
1845 if (ossl_pkey_has_private_data(pkey))
1846 write_c_string(" private/public key", printcharfun);
1847 else if (ossl_pkey_has_public_data(pkey))
1848 write_c_string(" public key", printcharfun);
1850 write_c_string(" empty key", printcharfun);
1852 if (EVP_PKEY_size(pkey) > 0) {
1853 snprintf(buf, 256, ", size %d", EVP_PKEY_size(pkey)*8);
1854 write_c_string(buf, printcharfun);
1858 write_c_string(">", printcharfun);
1860 /* avoid some warning */
1864 static Lisp_EVP_PKEY *
1865 allocate_evp_pkey(void)
1867 Lisp_EVP_PKEY *evp_pkey =
1868 alloc_lcrecord_type(Lisp_EVP_PKEY, &lrecord_evp_pkey);
1869 evp_pkey->evp_pkey = NULL;
1870 evp_pkey->x509 = NULL;
1875 finalise_evp_pkey(void *header, int for_disksave)
1877 Lisp_EVP_PKEY *evp_pkey = (Lisp_EVP_PKEY *) header;
1879 if (evp_pkey->evp_pkey) {
1880 EVP_PKEY_free(evp_pkey->evp_pkey);
1881 evp_pkey->evp_pkey = NULL;
1883 if (evp_pkey->x509) {
1884 X509_free(evp_pkey->x509);
1885 evp_pkey->x509 = NULL;
1888 /* avoid some warning */
1892 DEFINE_LRECORD_IMPLEMENTATION("evp_pkey", evp_pkey,
1893 mark_evp_pkey, print_evp_pkey,
1899 make_evp_pkey(EVP_PKEY *pkey, X509 *x509)
1901 Lisp_EVP_PKEY *lisp_pkey = allocate_evp_pkey();
1903 lisp_pkey->evp_pkey = pkey;
1904 lisp_pkey->x509 = x509;
1906 return wrap_evppkey(lisp_pkey);
1910 make_evp_pkey_pk(EVP_PKEY *pkey)
1912 return make_evp_pkey(pkey, NULL);
1916 make_evp_pkey_x509(X509 *x509)
1918 return make_evp_pkey(X509_get_pubkey(x509), x509);
1921 DEFUN("ossl-pkey-p", Fossl_pkey_p, 1, 1, 0, /*
1922 Return t iff OBJECT is a pkey, nil otherwise.
1926 if (EVPPKEYP(object))
1932 DEFUN("ossl-pkey-size", Fossl_pkey_size, 1, 1, 0, /*
1933 Return the size a public key PKEY in bits.
1939 CHECK_EVPPKEY(pkey);
1941 pk = (XEVPPKEY(pkey))->evp_pkey;
1943 return make_int(EVP_PKEY_size(pk)*8);
1947 ossl_pkey_has_public_data(EVP_PKEY *pkey)
1949 if (rsa_pkey_p(pkey)) {
1950 #ifndef OPENSSL_NO_RSA
1951 return rsa_pkey_has_public_data((pkey->pkey).rsa);
1955 } else if (dsa_pkey_p(pkey)) {
1956 #ifndef OPENSSL_NO_DSA
1957 return dsa_pkey_has_public_data((pkey->pkey).dsa);
1961 } else if (ec_pkey_p(pkey)) {
1962 #ifndef OPENSSL_NO_EC
1963 return ec_pkey_has_public_data((pkey->pkey).ec);
1967 } else if (dh_pkey_p(pkey)) {
1968 #ifndef OPENSSL_NO_DH
1969 return dh_pkey_has_public_data((pkey->pkey).dh);
1977 ossl_pkey_has_private_data(EVP_PKEY *pkey)
1979 if (rsa_pkey_p(pkey)) {
1980 #ifndef OPENSSL_NO_RSA
1981 return rsa_pkey_has_private_data((pkey->pkey).rsa);
1985 } else if (dsa_pkey_p(pkey)) {
1986 #ifndef OPENSSL_NO_DSA
1987 return dsa_pkey_has_private_data((pkey->pkey).dsa);
1991 } else if (ec_pkey_p(pkey)) {
1992 #ifndef OPENSSL_NO_EC
1993 return ec_pkey_has_private_data((pkey->pkey).ec);
1997 } else if (dh_pkey_p(pkey)) {
1998 #ifndef OPENSSL_NO_DH
1999 return dh_pkey_has_private_data((pkey->pkey).dh);
2007 DEFUN("ossl-pkey-private-p", Fossl_pkey_private_p, 1, 1, 0, /*
2008 Return non-nil if PKEY contains private data.
2010 This function is not native OpenSSL.
2016 if (!(EVPPKEYP(pkey)))
2019 pk = (XEVPPKEY(pkey))->evp_pkey;
2021 if (ossl_pkey_has_private_data(pk))
2027 DEFUN("ossl-pkey-get-public", Fossl_pkey_get_public, 1, 1, 0, /*
2028 Return a copy of PKEY stripped by the private data.
2030 This function is not native OpenSSL.
2037 CHECK_EVPPKEY(pkey);
2039 pk = (XEVPPKEY(pkey))->evp_pkey;
2040 if (!(ossl_pkey_has_public_data(pk)))
2041 error ("key must have public data");
2043 pkout = EVP_PKEY_new();
2044 if (rsa_pkey_p(pk)) {
2045 #ifndef OPENSSL_NO_RSA
2046 EVP_PKEY_assign_RSA(pkout, RSAPublicKey_dup((pk->pkey).rsa));
2048 } else if (dsa_pkey_p(pk)) {
2049 #ifndef OPENSSL_NO_DSA
2050 EVP_PKEY_assign_DSA(pkout, dsa_get_public(pk));
2052 } else if (ec_pkey_p(pk)) {
2053 #ifndef OPENSSL_NO_EC
2054 EVP_PKEY_assign_EC_KEY(pkout, ec_get_public(pk));
2057 error ("no method to strip private data yet");
2059 return make_evp_pkey_pk(pkout);
2064 rsa_pkey_p(EVP_PKEY *pkey)
2068 type = EVP_PKEY_type(pkey->type);
2070 #ifndef OPENSSL_NO_RSA
2071 return ((type == EVP_PKEY_RSA) ||
2072 (type == EVP_PKEY_RSA2));
2077 #ifndef OPENSSL_NO_RSA
2079 rsa_pkey_has_public_data(RSA *rsakey)
2081 return (!(rsakey->n == NULL) &&
2082 !(rsakey->e == NULL));
2085 rsa_pkey_has_private_data(RSA *rsakey)
2087 return (rsa_pkey_has_public_data(rsakey) &&
2088 !(rsakey->d == NULL));
2091 DEFUN("ossl-rsa-generate-key", Fossl_rsa_generate_key, 2, 2, 0, /*
2092 Return an RSA public key with of length BITS and exponent EXPO.
2104 error ("modulus size must be a non-zero positive integer");
2105 if (!(XINT(expo) % 2))
2106 error ("exponent must be an odd positive integer");
2108 pkey = EVP_PKEY_new();
2109 rsakey = RSA_generate_key(XINT(bits), XINT(expo), NULL, NULL);
2110 EVP_PKEY_assign_RSA(pkey, rsakey);
2112 return make_evp_pkey_pk(pkey);
2115 DEFUN("ossl-rsa-pkey-p", Fossl_rsa_pkey_p, 1, 1, 0, /*
2116 Return t iff PKEY is of RSA type.
2122 if (!EVPPKEYP(pkey))
2125 pk = (XEVPPKEY(pkey))->evp_pkey;
2133 DEFUN("ossl-rsa-subkey-p", Fossl_rsa_subkey_p, 2, 2, 0, /*
2134 Return t iff PKEY1 is a subkey of PKEY2.
2135 I.e. if PKEY1 has the same public key data as PKEY2 and
2136 PKEY2 has all private data.
2138 This function is not native OpenSSL.
2147 CHECK_EVPPKEY(pkey1);
2148 CHECK_EVPPKEY(pkey2);
2150 pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2151 pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2153 /* perform a type check first */
2154 if (!rsa_pkey_p(pk1))
2155 error ("pkey1 must be of RSA type");
2156 if (!rsa_pkey_p(pk2))
2157 error ("pkey2 must be of RSA type");
2159 rk1 = (pk1->pkey).rsa;
2160 rk2 = (pk2->pkey).rsa;
2162 if (rsa_pkey_has_private_data(rk2) &&
2163 rsa_pkey_has_public_data(rk1) &&
2164 (!BN_cmp(rk1->n, rk2->n)) &&
2165 (!BN_cmp(rk1->e, rk2->e)))
2170 #endif /* OPENSSL_NO_RSA */
2175 dsa_pkey_p(EVP_PKEY *pkey)
2179 type = EVP_PKEY_type(pkey->type);
2181 #ifndef OPENSSL_NO_DSA
2182 return ((type == EVP_PKEY_DSA) ||
2183 (type == EVP_PKEY_DSA1) ||
2184 (type == EVP_PKEY_DSA2) ||
2185 (type == EVP_PKEY_DSA3) ||
2186 (type == EVP_PKEY_DSA4));
2191 #ifndef OPENSSL_NO_DSA
2193 dsa_pkey_has_public_data(DSA *dsakey)
2195 return (!(dsakey->p == NULL) &&
2196 !(dsakey->q == NULL) &&
2197 !(dsakey->g == NULL) &&
2198 !(dsakey->pub_key == NULL));
2201 dsa_pkey_has_private_data(DSA *dsakey)
2203 return (dsa_pkey_has_public_data(dsakey) &&
2204 !(dsakey->priv_key == NULL));
2207 DEFUN("ossl-dsa-generate-key", Fossl_dsa_generate_key, 1, 2, 0, /*
2208 Return a DSA public key with of length BITS seeded with (optional) SEED.
2217 unsigned_long h_ret;
2224 error ("prime number size must be a non-zero positive integer");
2231 TO_EXTERNAL_FORMAT (LISP_STRING, seed,
2232 C_STRING_ALLOCA, seed_ext, OSSL_CODING);
2233 seed_len = OSSL_STRING_LENGTH(seed);
2236 pkey = EVP_PKEY_new();
2237 dsakey = DSA_generate_parameters(XINT(bits),
2238 (unsigned char*)seed_ext, seed_len,
2239 &counter_ret, &h_ret,
2241 if (!DSA_generate_key(dsakey))
2242 error ("error during generation of DSA key");
2244 EVP_PKEY_assign_DSA(pkey, dsakey);
2246 return make_evp_pkey_pk(pkey);
2249 DEFUN("ossl-dsa-pkey-p", Fossl_dsa_pkey_p, 1, 1, 0, /*
2250 Return t iff PKEY is of DSA type.
2256 if (!EVPPKEYP(pkey))
2259 pk = (XEVPPKEY(pkey))->evp_pkey;
2267 dsa_get_public(EVP_PKEY *pk)
2272 memcpy(key, (pk->pkey).dsa, sizeof(DSA));
2274 /* now kill the private data */
2275 key->priv_key = NULL;
2280 DEFUN("ossl-dsa-subkey-p", Fossl_dsa_subkey_p, 2, 2, 0, /*
2281 Return t iff PKEY1 is a subkey of PKEY2.
2282 I.e. if PKEY1 has the same public key data as PKEY2 and
2283 PKEY2 has all private data.
2285 This function is not native OpenSSL.
2294 CHECK_EVPPKEY(pkey1);
2295 CHECK_EVPPKEY(pkey2);
2297 pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2298 pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2300 /* perform a type check first */
2301 if (!dsa_pkey_p(pk1))
2302 error ("pkey1 must be of DSA type");
2303 if (!dsa_pkey_p(pk2))
2304 error ("pkey2 must be of DSA type");
2306 dk1 = (pk1->pkey).dsa;
2307 dk2 = (pk2->pkey).dsa;
2309 if (dsa_pkey_has_private_data(dk2) &&
2310 dsa_pkey_has_public_data(dk1) &&
2311 (!BN_cmp(dk1->p, dk2->p)) &&
2312 (!BN_cmp(dk1->q, dk2->q)) &&
2313 (!BN_cmp(dk1->g, dk2->g)) &&
2314 (!BN_cmp(dk1->pub_key, dk2->pub_key)))
2319 #endif /* OPENSSL_NO_DSA */
2324 ec_pkey_p(EVP_PKEY *pkey)
2328 type = EVP_PKEY_type(pkey->type);
2330 #ifndef OPENSSL_NO_EC
2331 return (type == EVP_PKEY_EC);
2336 #ifndef OPENSSL_NO_EC
2338 ec_pkey_has_public_data(EC_KEY *ec_key)
2340 return (!(EC_KEY_get0_group(ec_key) == NULL) &&
2341 !(EC_KEY_get0_public_key(ec_key) == NULL));
2344 ec_pkey_has_private_data(EC_KEY *ec_key)
2346 return (ec_pkey_has_public_data(ec_key) &&
2347 !(EC_KEY_get0_private_key(ec_key) == NULL));
2350 DEFUN("ossl-ec-available-curves", Fossl_ec_available_curves, 0, 0, 0, /*
2351 Return a list of builtin elliptic curves.
2355 EC_builtin_curve *curves = NULL;
2356 size_t crv_len = 0, n = 0;
2357 Lisp_Object lcurves;
2361 crv_len = EC_get_builtin_curves(NULL, 0);
2362 curves = OPENSSL_malloc(sizeof(EC_builtin_curve) * crv_len);
2365 error ("no curves defined");
2367 if (!EC_get_builtin_curves(curves, crv_len)) {
2368 OPENSSL_free(curves);
2369 error ("error during initialisation of curves");
2372 for (n = 0; n < crv_len; n++) {
2373 int nid = curves[n].nid;
2374 lcurves = Fcons(intern(OBJ_nid2sn(nid)), lcurves);
2377 OPENSSL_free(curves);
2383 ec_curve_by_name(char *name)
2385 return OBJ_sn2nid(name);
2388 DEFUN("ossl-ec-generate-key", Fossl_ec_generate_key, 1, 1, 0, /*
2389 Return a EC public key on CURVE.
2390 CURVE may be any symbol from `ossl-ec-available-curves'.
2392 At the moment we do not support creating custom curves.
2399 CHECK_SYMBOL(curve);
2401 pkey = EVP_PKEY_new();
2402 eckey = EC_KEY_new_by_curve_name(
2403 ec_curve_by_name((char *)string_data(XSYMBOL(curve)->name)));
2405 if (eckey == NULL) {
2406 error ("no such curve");
2409 if (!EC_KEY_generate_key(eckey))
2410 error ("error during generation of EC key");
2412 EVP_PKEY_assign_EC_KEY(pkey, eckey);
2414 return make_evp_pkey_pk(pkey);
2417 DEFUN("ossl-ec-pkey-p", Fossl_ec_pkey_p, 1, 1, 0, /*
2418 Return t iff PKEY is of EC type.
2425 if (!EVPPKEYP(pkey))
2428 pk = (XEVPPKEY(pkey))->evp_pkey;
2429 type = EVP_PKEY_type(pk->type);
2430 if (type == EVP_PKEY_EC)
2437 ec_get_public(EVP_PKEY *pk)
2441 key = EC_KEY_dup((pk->pkey).ec);
2443 /* now kill the private data */
2444 EC_KEY_set_private_key(key, NULL);
2448 #endif /* OPENSSL_NO_EC */
2453 dh_pkey_p(EVP_PKEY *pkey)
2457 type = EVP_PKEY_type(pkey->type);
2459 #ifndef OPENSSL_NO_DH
2460 return (type == EVP_PKEY_DH);
2465 #ifndef OPENSSL_NO_DH
2467 dh_pkey_has_public_data(DH *dhkey)
2469 return (!(dhkey->p == NULL) &&
2470 !(dhkey->g == NULL) &&
2471 !(dhkey->pub_key == NULL));
2474 dh_pkey_has_private_data(DH *dhkey)
2476 return (dh_pkey_has_public_data(dhkey) &&
2477 !(dhkey->priv_key == NULL));
2480 DEFUN("ossl-dh-pkey-p", Fossl_dh_pkey_p, 1, 1, 0, /*
2481 Return t iff PKEY is of DH type.
2487 if (!EVPPKEYP(pkey))
2490 pk = (XEVPPKEY(pkey))->evp_pkey;
2498 #endif /* OPENSSL_NO_DH */
2501 /* more general access functions */
2502 DEFUN("ossl-seal", Fossl_seal, 3, 3, 0, /*
2503 Return an envelope derived from encrypting STRING by CIPHER under PKEY
2504 with the hybrid technique.
2506 That is, create a random key/iv pair for the symmetric encryption with
2507 CIPHER and encrypt that key/iv asymmetrically with the provided public
2510 The envelope returned is a list
2511 \(encrypted_string encrypted_key encrypted_iv\)
2513 `encrypted_string' is the (symmetrically) encrypted message
2514 `encrypted_key' is the (asymmetrically) encrypted random key
2515 `encrypted_iv' is the (asymmetrically) encrypted random iv
2517 Note: You probably want to put a wrapping encoder function
2518 (like `base16-encode-string') around it, since this function
2519 returns binary string data.
2521 (cipher, string, pkey))
2523 /* declarations for the cipher */
2524 const EVP_CIPHER *ciph;
2525 EVP_CIPHER_CTX ciphctx;
2526 /* declarations for the pkey */
2529 unsigned char *ekey;
2532 /* buffer for the generated IV */
2533 char iv[EVP_MAX_IV_LENGTH];
2535 /* buffer for output */
2536 unsigned char *outbuf;
2537 unsigned int outlen;
2538 Lisp_Object l_outbuf;
2539 /* buffer for external string data */
2546 CHECK_SYMBOL(cipher);
2547 CHECK_STRING(string);
2548 CHECK_EVPPKEY(pkey);
2551 pk[0] = (XEVPPKEY(pkey))->evp_pkey;
2552 if (!ossl_pkey_has_public_data(pk[0])) {
2553 error ("cannot seal, key has no public key data");
2557 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2558 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2559 string_len = OSSL_STRING_LENGTH(string);
2561 OpenSSL_add_all_algorithms();
2562 ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2566 error ("no such cipher");
2570 /* alloc ekey buffer */
2571 ekey = (unsigned char*)xmalloc_atomic(EVP_PKEY_size(pk[0]));
2573 /* now allocate some output buffer externally
2574 * this one has to be at least EVP_CIPHER_block_size bigger
2575 * since block algorithms merely operate blockwise
2577 outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string) +
2578 EVP_CIPHER_block_size(ciph));
2580 EVP_CIPHER_CTX_init(&ciphctx);
2581 if (!(EVP_SealInit(&ciphctx, ciph,
2583 (unsigned char *)&iv,
2584 (EVP_PKEY **)&pk, npubk)==npubk)) {
2588 error ("error in SealInit");
2591 if (!EVP_SealUpdate(&ciphctx, outbuf, (int *)&outlen,
2592 (unsigned char*)string_ext, string_len)) {
2596 error ("error in SealUpdate");
2599 if (!EVP_SealFinal(&ciphctx, (unsigned char*)outbuf+outlen, &tmplen)) {
2603 error ("error in SealFinal");
2606 /* added probable padding space to the length of the output buffer */
2608 EVP_CIPHER_CTX_cleanup(&ciphctx);
2610 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2611 l_ekey = make_ext_string((char *)ekey, ekey_len, OSSL_CODING);
2612 l_iv = make_ext_string(iv,EVP_CIPHER_iv_length(ciph), OSSL_CODING);
2617 return list3(l_outbuf, l_ekey, l_iv);
2621 DEFUN("ossl-open", Fossl_open, 4, 5, 0, /*
2622 Return the deciphered message STRING from an envelope
2623 obtained by `ossl-seal'.
2625 CIPHER is the cipher to use (the same as in `ossl-seal')
2626 STRING is the encrypted message
2627 PKEY is the private key
2628 EKEY is the encrypted random key
2629 EIV is the encrypted iv
2631 (cipher, string, pkey, ekey, eiv))
2633 /* declarations for the cipher */
2634 const EVP_CIPHER *ciph;
2635 EVP_CIPHER_CTX ciphctx;
2636 /* declarations for the pkey */
2638 /* buffer for external ekey data */
2641 /* buffer for external eiv data */
2643 /* buffer for output */
2644 unsigned char *outbuf;
2645 unsigned int outlen;
2646 Lisp_Object l_outbuf;
2647 /* buffer for external string data */
2654 CHECK_SYMBOL(cipher);
2655 CHECK_STRING(string);
2656 CHECK_EVPPKEY(pkey);
2660 pk = (XEVPPKEY(pkey))->evp_pkey;
2661 if (!ossl_pkey_has_private_data(pk))
2662 error ("cannot open, key has no private key data");
2664 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2665 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2666 string_len = OSSL_STRING_LENGTH(string);
2667 TO_EXTERNAL_FORMAT (LISP_STRING, ekey,
2668 C_STRING_ALLOCA, ekey_ext, OSSL_CODING);
2669 ekey_len = OSSL_STRING_LENGTH(ekey);
2671 OpenSSL_add_all_algorithms();
2672 ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2676 error ("no such cipher");
2684 TO_EXTERNAL_FORMAT (LISP_STRING, eiv,
2685 C_STRING_ALLOCA, eiv_ext, OSSL_CODING);
2688 /* now allocate some output buffer externally */
2689 outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string));
2691 EVP_CIPHER_CTX_init(&ciphctx);
2692 if (!EVP_OpenInit(&ciphctx, ciph,
2693 (unsigned char*)ekey_ext,
2694 (unsigned int)ekey_len,
2695 (unsigned char*)eiv_ext, pk)) {
2698 error ("error in OpenInit");
2701 if (!EVP_OpenUpdate(&ciphctx, outbuf, (int *)&outlen,
2702 (unsigned char*)string_ext,
2703 (unsigned int)string_len)) {
2706 error ("error in OpenUpdate");
2709 if (!EVP_OpenFinal(&ciphctx, outbuf+outlen, &tmplen)) {
2712 error ("error in OpenFinal");
2715 /* added probable padding space to the length of the output buffer */
2717 EVP_CIPHER_CTX_cleanup(&ciphctx);
2719 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2728 DEFUN("ossl-sign", Fossl_sign, 3, 3, 0, /*
2729 Return a signature obtained by signing STRING under DIGEST with PKEY.
2731 That is, hash the message STRING with the message digest DIGEST and
2732 encrypt the result with the private key PKEY.
2734 Note: Due to some relationship between the public key system and the
2735 message digest you cannot use every digest algorithm with every
2737 The most certain results will be achieved using
2738 RSA keys with RSA-* digests, DSA keys with DSA-* digests.
2740 See `ossl-available-digests'.
2742 Note: You probably want to put a wrapping encoder function
2743 (like `base16-encode-string') around it, since this returns
2746 (digest, string, pkey))
2748 /* declarations for the cipher */
2751 /* declarations for the pkey */
2753 /* buffer for output */
2754 unsigned char *outbuf;
2755 unsigned int outlen;
2756 Lisp_Object l_outbuf;
2757 /* buffer for external string data */
2762 CHECK_SYMBOL(digest);
2763 CHECK_STRING(string);
2764 CHECK_EVPPKEY(pkey);
2767 pk = (XEVPPKEY(pkey))->evp_pkey;
2768 if (!ossl_pkey_has_private_data(pk)) {
2769 error ("cannot sign, key has no private key data");
2772 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2773 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2774 string_len = OSSL_STRING_LENGTH(string);
2776 OpenSSL_add_all_algorithms();
2777 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2781 error ("no such digest");
2785 /* now allocate some output buffer externally */
2786 outbuf = (unsigned char *)xmalloc_atomic(EVP_PKEY_size(pk));
2788 EVP_MD_CTX_init(&mdctx);
2789 if (!(EVP_SignInit(&mdctx, md))) {
2792 error ("error in SignInit");
2795 if (!EVP_SignUpdate(&mdctx, string_ext, string_len)) {
2798 error ("error in SignUpdate");
2801 if (!EVP_SignFinal(&mdctx, outbuf, &outlen, pk)) {
2804 error ("error in SignFinal");
2807 EVP_MD_CTX_cleanup(&mdctx);
2809 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2817 DEFUN("ossl-verify", Fossl_verify, 4, 4, 0, /*
2818 Return t iff SIG is a valid signature of STRING under DIGEST obtained by PKEY.
2820 That is, hash the message STRING with the message digest DIGEST, then
2821 decrypt the signature SIG with the public key PKEY.
2822 Compare the results and return t iff both hashes are equal.
2824 DIGEST is the digest to use (the same as in `ossl-sign')
2825 STRING is the message
2826 SIG is the signature of message
2827 PKEY is the public key
2829 (digest, string, sig, pkey))
2831 /* declarations for the cipher */
2834 /* declarations for the pkey */
2836 /* buffer for external signature data */
2839 /* buffer for external string data */
2846 CHECK_SYMBOL(digest);
2847 CHECK_STRING(string);
2849 CHECK_EVPPKEY(pkey);
2852 pk = (XEVPPKEY(pkey))->evp_pkey;
2853 if (!ossl_pkey_has_public_data(pk))
2854 error ("cannot verify, key has no public key data");
2856 OpenSSL_add_all_algorithms();
2857 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2861 error ("no such digest");
2865 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2866 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2867 string_len = OSSL_STRING_LENGTH(string);
2868 TO_EXTERNAL_FORMAT (LISP_STRING, sig,
2869 C_STRING_ALLOCA, sig_ext, OSSL_CODING);
2870 sig_len = OSSL_STRING_LENGTH(sig);
2872 EVP_MD_CTX_init(&mdctx);
2873 if (!EVP_VerifyInit(&mdctx, md)) {
2875 error ("error in VerifyInit");
2878 if (!EVP_VerifyUpdate(&mdctx, string_ext, string_len)) {
2880 error ("error in VerifyUpdate");
2883 result = EVP_VerifyFinal(&mdctx, (unsigned char*)sig_ext, sig_len, pk);
2886 error ("error in VerifyFinal");
2889 EVP_MD_CTX_cleanup(&mdctx);
2893 return result ? Qt : Qnil;
2902 DEFUN("ossl-pem-read-public-key", Fossl_pem_read_public_key, 1, 1, 0, /*
2903 Return a key (the public part) stored in a PEM structure from FILE.
2907 /* declarations for the pkey */
2916 file = Fexpand_file_name(file, Qnil);
2918 if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2919 error ("error opening file.");
2921 pk509 = PEM_read_X509(fp, NULL, NULL, NULL);
2922 pk = PEM_read_PUBKEY(fp, NULL, NULL, NULL);
2926 return make_evp_pkey(pk, pk509);
2929 DEFUN("ossl-pem-read-key", Fossl_pem_read_key, 1, 2, 0, /*
2930 Return a key stored in a PEM structure from FILE.
2931 If the (private part of the) key is protected with a password
2932 provide (optional) PASSWORD.
2936 /* declarations for the pkey */
2940 /* password pointer */
2945 file = Fexpand_file_name(file, Qnil);
2947 if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2948 error ("error opening file.");
2950 if (NILP(password)) {
2953 CHECK_STRING(password);
2954 pass = (char *)XSTRING_DATA(password);
2957 pk = PEM_read_PrivateKey(fp, NULL, NULL, pass);
2960 /* now maybe it is a public key only */
2961 return Fossl_pem_read_public_key(file);
2964 return make_evp_pkey_pk(pk);
2967 DEFUN("ossl-pem-write-public-key", Fossl_pem_write_public_key, 2, 2, 0, /*
2968 Write PKEY (the public part) in a PEM structure to FILE.
2972 /* declarations for the pkey */
2979 CHECK_EVPPKEY(pkey);
2981 file = Fexpand_file_name(file, Qnil);
2983 pk = XEVPPKEY(pkey)->evp_pkey;
2984 pk509 = XEVPPKEY(pkey)->x509;
2986 if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL)
2987 error ("error opening file.");
2989 if (!PEM_write_PUBKEY(fp, pk)) {
2991 error ("error writing PEM file.");
2999 DEFUN("ossl-pem-write-key", Fossl_pem_write_key, 2, 4, 0, /*
3000 Write PKEY in a PEM structure to FILE. The key itself is
3001 protected by (optional) CIPHER with PASSWORD.
3003 CIPHER can be set to nil and the key will not be encrypted.
3004 PASSWORD is ignored in this case.
3006 (file, pkey, cipher, password))
3008 const EVP_CIPHER *ciph;
3009 /* declarations for the pkey */
3014 /* password pointer */
3018 CHECK_EVPPKEY(pkey);
3020 file = Fexpand_file_name(file, Qnil);
3022 pk = XEVPPKEY(pkey)->evp_pkey;
3023 pk509 = XEVPPKEY(pkey)->x509;
3025 if (!ossl_pkey_has_private_data(pk))
3026 return Fossl_pem_write_public_key(file, pkey);
3028 CHECK_SYMBOL(cipher);
3030 OpenSSL_add_all_algorithms();
3036 ciph = EVP_get_cipherbyname(
3037 (char *)string_data(XSYMBOL(cipher)->name));
3040 error ("no such cipher");
3044 if (NILP(password)) {
3048 CHECK_STRING(password);
3049 pass = (char *)XSTRING_DATA(password);
3052 if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL) {
3054 error ("error opening file.");
3057 if (!PEM_write_PKCS8PrivateKey(fp, pk, ciph, NULL, 0, NULL, pass)) {
3060 error ("error writing PEM file.");
3070 ossl_pem_pkey_cb(BIO *bio, int cmd, const char *argp,
3071 int argi, long argl, long ret)
3074 void *foo = BIO_get_callback_arg(bio);
3076 if (!(key = (Lisp_Object)foo)) {
3080 if (BIO_CB_RETURN & cmd) {
3086 key = concat2(key, make_ext_string(argp, argi, OSSL_CODING));
3087 BIO_set_callback_arg(bio, (void*)key);
3095 DEFUN("ossl-pem-public-key",Fossl_pem_public_key, 1, 1, 0, /*
3096 Return PKEY as PEM encoded string.
3100 /* This function can GC */
3101 /* declarations for the pkey */
3107 struct gcpro gcpro1;
3111 CHECK_EVPPKEY(pkey);
3113 pk = (XEVPPKEY(pkey))->evp_pkey;
3115 if (!(b = BIO_new(BIO_s_null()))) {
3117 error("cannot open memory buffer");
3121 result = build_string("");
3122 BIO_set_callback(b, ossl_pem_pkey_cb);
3123 BIO_set_callback_arg(b, (void*)result);
3125 if (!PEM_write_bio_PUBKEY(b, pk)) {
3129 error ("error creating PEM string");
3134 void *foo = BIO_get_callback_arg(b);
3135 if (!(result = (Lisp_Object)foo)) {
3146 DEFUN("ossl-pem-key",Fossl_pem_key, 1, 3, 0, /*
3147 Return PKEY as PEM encoded string. The key itself is
3148 protected by (optional) CIPHER with PASSWORD.
3150 CIPHER can be set to nil and the key will not be encrypted.
3151 PASSWORD is ignored in this case.
3153 (pkey, cipher, password))
3155 /* This function can GC */
3156 /* declarations for the pkey */
3159 const EVP_CIPHER *ciph;
3163 struct gcpro gcpro1, gcpro2, gcpro3;
3165 GCPRO3(pkey, cipher, password);
3167 CHECK_EVPPKEY(pkey);
3169 pk = (XEVPPKEY(pkey))->evp_pkey;
3171 if (!ossl_pkey_has_private_data(pk)) {
3173 return Fossl_pem_public_key(pkey);
3176 CHECK_SYMBOL(cipher);
3178 OpenSSL_add_all_algorithms();
3184 ciph = EVP_get_cipherbyname(
3185 (char *)string_data(XSYMBOL(cipher)->name));
3189 error ("no such cipher");
3194 if (NILP(password)) {
3198 CHECK_STRING(password);
3199 pass = (char *)XSTRING_DATA(password);
3202 if (!(b = BIO_new(BIO_s_null()))) {
3204 error("cannot open memory buffer");
3208 result = build_string("");
3209 BIO_set_callback(b, ossl_pem_pkey_cb);
3210 BIO_set_callback_arg(b, (void*)result);
3212 if (!PEM_write_bio_PKCS8PrivateKey(b, pk, ciph, NULL, 0, NULL, pass)) {
3216 error ("error creating PEM string");
3221 void *foo = BIO_get_callback_arg(b);
3223 if (!(result = (Lisp_Object)foo)) {
3238 * The SSL support in this API is sorta high level since having
3239 * server hellos, handshakes and stuff like that is not what you want
3243 /* This is an opaque object for storing PKEYs in lisp */
3244 Lisp_Object Qssl_connp;
3247 make_ssl_conn(Lisp_SSL_CONN *ssl_conn)
3249 Lisp_Object lisp_ssl_conn;
3250 XSETSSLCONN(lisp_ssl_conn, ssl_conn);
3251 return lisp_ssl_conn;
3255 mark_ssl_conn(Lisp_Object obj)
3257 mark_object(XSSLCONN(obj)->parent);
3258 mark_object(XSSLCONN(obj)->pipe_instream);
3259 mark_object(XSSLCONN(obj)->pipe_outstream);
3261 mark_object(XSSLCONN(obj)->coding_instream);
3262 mark_object(XSSLCONN(obj)->coding_outstream);
3269 print_ssl_conn(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3274 conn = XSSLCONN(obj)->ssl_conn;
3275 parent = XSSLCONN(obj)->parent;
3277 write_c_string("#<OpenSSL socket layer: ", printcharfun);
3279 write_c_string("dead", printcharfun);
3281 write_c_string(SSL_get_version(conn), printcharfun);
3284 if (PROCESSP(parent)) {
3285 write_c_string(" on top of ", printcharfun);
3286 print_internal(parent, printcharfun, escapeflag);
3288 #endif /* HAVE_SOCKETS */
3290 #ifdef HAVE_POSTGRESQL
3291 if (PGCONNP(parent) &&
3292 PQstatus(XPGCONN(parent)->pgconn) == CONNECTION_OK) {
3293 write_c_string(" on top of ", printcharfun);
3294 print_internal(parent, printcharfun, escapeflag);
3296 #endif /* HAVE_POSTGRESQL */
3297 write_c_string(">", printcharfun);
3301 allocate_ssl_conn(void)
3303 Lisp_SSL_CONN *ssl_conn =
3304 alloc_lcrecord_type(Lisp_SSL_CONN, &lrecord_ssl_conn);
3306 /* the network process stuff */
3307 ssl_conn->parent = Qnil;
3308 ssl_conn->infd = -1;
3309 ssl_conn->outfd = -1;
3311 ssl_conn->connected_p = 0;
3312 ssl_conn->protected_p = 0;
3314 ssl_conn->pipe_instream = Qnil;
3315 ssl_conn->pipe_outstream = Qnil;
3317 ssl_conn->coding_instream = Qnil;
3318 ssl_conn->coding_outstream = Qnil;
3325 finalise_ssl_conn(void *header, int for_disksave)
3327 Lisp_SSL_CONN *ssl_conn = (Lisp_SSL_CONN *) header;
3329 if (!(ssl_conn->ssl_conn == NULL)) {
3330 if (ssl_conn->connected_p)
3331 SSL_shutdown(ssl_conn->ssl_conn);
3332 SSL_free(ssl_conn->ssl_conn);
3333 ssl_conn->ssl_conn = NULL;
3335 if (!(ssl_conn->ssl_ctx == NULL)) {
3336 SSL_CTX_free(ssl_conn->ssl_ctx);
3337 ssl_conn->ssl_ctx = NULL;
3339 ssl_conn->ssl_bio = NULL;
3341 if (PROCESSP(ssl_conn->parent)) {
3342 XPROCESS(ssl_conn->parent)->process_type = PROCESS_TYPE_NETWORK;
3343 XPROCESS(ssl_conn->parent)->process_type_data = Qnil;
3345 /* we leave the process alive, it's not our fault, but
3346 * we nullify its pointer
3348 ssl_conn->parent = Qnil;
3349 ssl_conn->infd = -1;
3350 ssl_conn->outfd = -1;
3352 ssl_conn->connected_p = 0;
3353 ssl_conn->protected_p = 0;
3355 /* free the lstream resources */
3356 #if 0 /* will lead to problems */
3357 if (LSTREAMP(ssl_conn->pipe_instream))
3358 Lstream_delete(XLSTREAM(ssl_conn->pipe_instream));
3359 if (LSTREAMP(ssl_conn->pipe_outstream))
3360 Lstream_delete(XLSTREAM(ssl_conn->pipe_outstream));
3362 ssl_conn->pipe_instream = Qnil;
3363 ssl_conn->pipe_outstream = Qnil;
3365 #if 0 /* will lead to problems */
3366 if (LSTREAMP(ssl_conn->coding_instream))
3367 Lstream_delete(XLSTREAM(ssl_conn->coding_instream));
3368 if (LSTREAMP(ssl_conn->coding_outstream))
3369 Lstream_delete(XLSTREAM(ssl_conn->coding_outstream));
3371 ssl_conn->coding_instream = Qnil;
3372 ssl_conn->coding_outstream = Qnil;
3375 /* avoid some warning */
3379 DEFINE_LRECORD_IMPLEMENTATION("ssl_conn", ssl_conn,
3380 mark_ssl_conn, print_ssl_conn,
3382 NULL, NULL, 0, Lisp_SSL_CONN);
3385 ssl_conn_alive_p(Lisp_SSL_CONN *ssl_conn)
3387 return ssl_conn->connected_p;
3391 get_process_infd(Lisp_Process * p)
3393 Lisp_Object instr, outstr;
3394 get_process_streams(p, &instr, &outstr);
3395 return Lstream_get_fd(XLSTREAM(instr));
3398 get_process_outfd(Lisp_Process * p)
3400 Lisp_Object instr, outstr;
3401 get_process_streams(p, &instr, &outstr);
3402 return Lstream_get_fd(XLSTREAM(outstr));
3406 event_stream_ssl_create_stream_pair(
3408 Lisp_Object *instream, Lisp_Object *outstream, int flags)
3410 *instream = make_ssl_input_stream(conn, flags);
3411 *outstream = make_ssl_output_stream(conn, flags);
3417 init_ssl_io_handles(Lisp_SSL_CONN *s, int flags)
3419 event_stream_ssl_create_stream_pair(
3420 s->ssl_conn, &s->pipe_instream, &s->pipe_outstream, flags);
3423 s->coding_instream = make_decoding_input_stream(
3424 XLSTREAM(s->pipe_instream), Fget_coding_system(
3425 Vcoding_system_for_read));
3426 Lstream_set_character_mode(XLSTREAM(s->coding_instream));
3427 s->coding_outstream = make_encoding_output_stream(
3428 XLSTREAM(s->pipe_outstream), Fget_coding_system(
3429 Vcoding_system_for_write));
3430 #endif /* FILE_CODING */
3433 /* Advanced step-by-step initialisation */
3434 #define OSSL_CHECK_PROCESS(process) \
3436 /* Make sure the process is really alive. */ \
3437 if (!EQ(XPROCESS(process)->status_symbol, Qrun)) \
3438 error("Network stream %s not alive", \
3439 XSTRING_DATA(XPROCESS(process)->name)); \
3440 /* Make sure the process is a network stream. */ \
3441 if (!network_connection_p(process)) \
3442 error("Process %s is not a network stream", \
3443 XSTRING_DATA(XPROCESS(process)->name)); \
3446 #ifdef OSSL_DEBUG_FLAG
3448 ossl_bio_dump_callback(BIO *bio, int cmd, const char *argp,
3449 int argi, long argl, long ret)
3453 out=(BIO *)BIO_get_callback_arg(bio);
3454 if (out == NULL) return(ret);
3456 if (cmd == (BIO_CB_READ|BIO_CB_RETURN))
3458 BIO_printf(out,"read from %p [%p] (%d bytes => %ld (0x%lX))\n",
3459 (void *)bio,argp,argi,ret,ret);
3460 BIO_dump(out,argp,(int)ret);
3463 else if (cmd == (BIO_CB_WRITE|BIO_CB_RETURN))
3465 BIO_printf(out,"write to %p [%p] (%d bytes => %ld (0x%lX))\n",
3466 (void *)bio,argp,argi,ret,ret);
3467 BIO_dump(out,argp,(int)ret);
3474 ossl_ssl_prepare_cmeth(Lisp_Object method)
3476 SSL_METHOD *meth = NULL;
3477 Lisp_SSL_CONN *lisp_ssl_conn;
3479 /* start preparing the conn object */
3481 SSL_load_error_strings();
3484 else if (EQ(method, Qssl2))
3485 meth = (SSL_METHOD *)SSLv2_client_method();
3486 else if (EQ(method, Qssl3))
3487 meth = (SSL_METHOD *)SSLv3_client_method();
3488 else if (EQ(method, Qssl23))
3489 meth = (SSL_METHOD *)SSLv23_client_method();
3490 else if (EQ(method, Qtls1))
3491 meth = (SSL_METHOD *)TLSv1_client_method();
3493 meth = (SSL_METHOD *)TLSv1_client_method();
3496 error("OSSL: not enough random data");
3498 /* now allocate this stuff, pump it and return */
3499 lisp_ssl_conn = allocate_ssl_conn();
3500 lisp_ssl_conn->ssl_meth = meth;
3501 lisp_ssl_conn->ssl_ctx = NULL;
3502 lisp_ssl_conn->ssl_conn = NULL;
3503 lisp_ssl_conn->ssl_bio = NULL;
3505 return make_ssl_conn(lisp_ssl_conn);
3509 ossl_ssl_prepare_smeth(Lisp_Object method)
3511 SSL_METHOD *meth = NULL;
3512 Lisp_SSL_CONN *lisp_ssl_conn;
3514 /* start preparing the conn object */
3516 SSL_load_error_strings();
3519 else if (EQ(method, Qssl2))
3520 meth = (SSL_METHOD *)SSLv2_server_method();
3521 else if (EQ(method, Qssl3))
3522 meth = (SSL_METHOD *)SSLv3_server_method();
3523 else if (EQ(method, Qssl23))
3524 meth = (SSL_METHOD *)SSLv23_server_method();
3525 else if (EQ(method, Qtls1))
3526 meth = (SSL_METHOD *)TLSv1_server_method();
3528 meth = (SSL_METHOD *)SSLv23_server_method();
3531 error("OSSL: not enough random data");
3533 /* now allocate this stuff, pump it and return */
3534 lisp_ssl_conn = allocate_ssl_conn();
3535 lisp_ssl_conn->ssl_meth = meth;
3536 lisp_ssl_conn->ssl_ctx = NULL;
3537 lisp_ssl_conn->ssl_conn = NULL;
3538 lisp_ssl_conn->ssl_bio = NULL;
3540 return make_ssl_conn(lisp_ssl_conn);
3544 ossl_ssl_prepare_ctx(Lisp_Object ssl_conn)
3546 /* SSL connection stuff */
3547 SSL_CTX *ctx = NULL;
3548 Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3550 ctx = SSL_CTX_new(lisp_ssl_conn->ssl_meth);
3552 error("OSSL: context initialisation failed");
3554 /* OpenSSL contains code to work-around lots of bugs and flaws in
3555 * various SSL-implementations. SSL_CTX_set_options() is used to enabled
3556 * those work-arounds. The man page for this option states that
3557 * SSL_OP_ALL enables all the work-arounds and that "It is usually safe
3558 * to use SSL_OP_ALL to enable the bug workaround options if
3559 * compatibility with somewhat broken implementations is desired."
3561 SSL_CTX_set_options(ctx, SSL_OP_ALL);
3563 lisp_ssl_conn->ssl_ctx = ctx;
3569 ossl_ssl_prepare(Lisp_Object ssl_conn, void(*fun)(SSL*))
3571 /* SSL connection stuff */
3574 #ifdef OSSL_DEBUG_FLAG
3575 BIO *bio_c_out = NULL;
3577 Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3579 /* now initialise a new connection context */
3580 conn = SSL_new(lisp_ssl_conn->ssl_ctx);
3581 if (conn == NULL || fun == NULL)
3582 error("OSSL: connection initialisation failed");
3584 /* always renegotiate */
3585 SSL_set_mode(conn, SSL_MODE_AUTO_RETRY);
3587 /* initialise the main connection BIO */
3588 bio = BIO_new(BIO_s_socket());
3590 #ifdef OSSL_DEBUG_FLAG
3591 /* this is a debug BIO which pukes tons of stuff to stderr */
3592 bio_c_out = BIO_new_fp(stderr, BIO_NOCLOSE);
3593 BIO_set_callback(bio, ossl_bio_dump_callback);
3594 BIO_set_callback_arg(bio, bio_c_out);
3597 /* connect SSL with the bio */
3598 SSL_set_bio(conn, bio, bio);
3599 /* turn into client or server */
3602 /* now allocate this stuff, pump it and return */
3603 lisp_ssl_conn->ssl_conn = conn;
3604 lisp_ssl_conn->ssl_bio = bio;
3606 /* create lstream handles */
3607 init_ssl_io_handles(lisp_ssl_conn, STREAM_NETWORK_CONNECTION);
3612 /* Injection of CA certificates */
3613 int ossl_ssl_inject_ca(Lisp_Object ssl_conn, Lisp_Object cacert)
3619 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3620 cert = XEVPPKEY(cacert)->evp_pkey;
3621 xc509 = XEVPPKEY(cacert)->x509;
3623 if (cert && !xc509) {
3625 X509_set_pubkey(xc509, cert);
3626 XEVPPKEY(cacert)->x509 = xc509;
3631 /* what about coding system issues? */
3632 if (!SSL_CTX_add_client_CA(ctx, xc509))
3638 int ossl_ssl_inject_ca_file(Lisp_Object ssl_conn, Lisp_Object cafile)
3642 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3644 /* what about coding system issues? */
3645 if (!SSL_CTX_load_verify_locations(
3646 ctx, (char*)XSTRING_DATA(cafile), NULL))
3652 int ossl_ssl_inject_ca_path(Lisp_Object ssl_conn, Lisp_Object capath)
3656 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3658 /* what about coding system issues? */
3659 if (!SSL_CTX_load_verify_locations(
3660 ctx, NULL, (char*)XSTRING_DATA(capath)))
3666 int ossl_ssl_inject_cert(Lisp_Object ssl_conn,
3667 Lisp_Object cert, Lisp_Object key)
3674 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3675 pkey = XEVPPKEY(key)->evp_pkey;
3676 xcert = XEVPPKEY(cert)->evp_pkey;
3677 xc509 = XEVPPKEY(cert)->x509;
3679 if (xcert && !xc509) {
3681 X509_set_pubkey(xc509, xcert);
3682 XEVPPKEY(cert)->x509 = xc509;
3687 if (SSL_CTX_use_certificate(ctx, xc509) <= 0)
3690 if (SSL_CTX_use_PrivateKey(ctx, pkey) <= 0)
3692 if (!SSL_CTX_check_private_key(ctx))
3698 int ossl_ssl_inject_cert_file(Lisp_Object ssl_conn,
3699 Lisp_Object cert, Lisp_Object key)
3703 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3705 if (SSL_CTX_use_certificate_file(
3706 ctx, (char*)XSTRING_DATA(cert), SSL_FILETYPE_PEM) <= 0)
3708 if (SSL_CTX_use_PrivateKey_file(
3709 ctx, (char*)XSTRING_DATA(key), SSL_FILETYPE_PEM) <= 0)
3711 if (!SSL_CTX_check_private_key(ctx))
3717 Lisp_Object ossl_ssl_handshake(Lisp_Object ssl_conn, Lisp_Object process)
3719 /* This function can GC */
3720 /* SSL connection stuff */
3723 #if 0 && defined(OSSL_DEBUG_FLAG)
3724 BIO *bio_c_out = NULL;
3726 int ret, err, infd, outfd;
3728 struct gcpro gcpro1, gcpro2;
3730 /* Make sure we have a process, the alive check should be done in the
3731 function calling this here */
3732 CHECK_PROCESS(process);
3734 GCPRO2(ssl_conn, process);
3736 /* set the alternate one */
3737 event_stream_unselect_process(XPROCESS(process));
3740 /* just announce that we are very binary */
3741 Fset_process_coding_system(process, Qbinary, Qbinary);
3744 /* initialise the process' buffer for type-specific data,
3745 * we will store process input there */
3746 XPROCESS(process)->process_type_data = Qnil;
3748 /* retrieve the sockets of the process */
3749 infd = get_process_infd(XPROCESS(process));
3750 outfd = get_process_outfd(XPROCESS(process));
3752 /* push data to ssl_conn */
3753 XSSLCONN(ssl_conn)->parent = process;
3754 XSSLCONN(ssl_conn)->infd = infd;
3755 XSSLCONN(ssl_conn)->outfd = outfd;
3757 /* frob vars from ssl_conn */
3758 conn = XSSLCONN(ssl_conn)->ssl_conn;
3759 bio = XSSLCONN(ssl_conn)->ssl_bio;
3761 /* initialise the main connection BIO */
3762 BIO_set_fd(bio, infd, 0);
3764 /* now perform the actual handshake
3765 * this is a loop because of the genuine openssl concept to not handle
3766 * non-blocking I/O correctly */
3770 ret = SSL_do_handshake(conn);
3771 err = SSL_get_error(conn, ret);
3773 /* perform select() with timeout
3774 * 1 second at the moment */
3778 if (err == SSL_ERROR_NONE) {
3780 } else if (err == SSL_ERROR_WANT_READ) {
3782 OSSL_DEBUG("WANT_READ\n");
3785 FD_SET(infd, &read_fds);
3787 /* wait for socket to be readable */
3788 if (!(ret = select(infd+1, &read_fds, 0, NULL, &to))) {
3790 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3791 error("timeout during handshake");
3794 } else if (err == SSL_ERROR_WANT_WRITE) {
3796 OSSL_DEBUG("WANT_WRITE\n");
3797 FD_ZERO(&write_fds);
3798 FD_SET(outfd, &write_fds);
3800 /* wait for socket to be writable */
3801 if (!(ret = select(infd+1, &write_fds, 0, NULL, &to))) {
3803 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3804 error("timeout during handshake");
3807 } else if (err == SSL_ERROR_SSL) {
3808 /* close down the process object */
3809 Fdelete_process(process);
3812 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3813 error("handshake failed");
3816 OSSL_CRITICAL("\nUnknown error: %d\n"
3818 "sxemacs-devel@sxemacs.org\n\n", err);
3821 /* we used to check whether the connection is
3822 still alive, but this was perhaps a bad idea */
3823 try = BIO_read(bio, buf, 2);
3825 (try < 0 && !BIO_should_retry(bio))) {
3826 /* Handle closed connection */
3827 XPROCESS(process)->exit_code = 256;
3828 XPROCESS(process)->status_symbol = Qexit;
3831 /* close down the process object */
3832 Fdelete_process(process);
3836 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3837 error("unknown handshake error");
3842 /* marry the socket layer now */
3843 ossl_ssl_proselytise_process(ssl_conn, process);
3845 /* declare the whole pig connected */
3846 XSSLCONN(ssl_conn)->connected_p = 1;
3848 event_stream_select_process(XPROCESS(process));
3854 DEFUN("ossl-ssl-inject-cert", Fossl_ssl_inject_cert, 2, 3, 0, /*
3855 Add CERT as the local certificate of SSL-CONN.
3856 Optional argument KEY specifies a key file or evp-pkey, if
3857 CERT does not contain it.
3859 Both, CERT and KEY may be either a filename pointing to a
3860 PEM-encoded certificate and key respectively, or may be an
3863 (ssl_conn, cert, key))
3865 /* This function can GC */
3866 int (*fun)(Lisp_Object, Lisp_Object, Lisp_Object) = NULL;
3867 struct gcpro gcpro1, gcpro2, gcpro3;
3869 GCPRO3(ssl_conn, cert, key);
3871 CHECK_SSLCONN(ssl_conn);
3874 CHECK_EVPPKEY(cert);
3879 /* certificate and key preparation */
3880 if (STRINGP(cert)) {
3881 cert = Fexpand_file_name(cert, Qnil);
3882 if (NILP(Ffile_readable_p(cert)))
3887 key = Fexpand_file_name(key, Qnil);
3888 if (NILP(Ffile_readable_p(key)))
3892 if (STRINGP(cert) && NILP(key))
3894 else if (EVPPKEYP(cert) && NILP(key))
3897 /* certificate and key injection */
3898 if (!NILP(cert) && !NILP(key) &&
3899 STRINGP(cert) && STRINGP(key))
3900 fun = ossl_ssl_inject_cert_file;
3901 else if (!NILP(cert) && !NILP(key) &&
3902 EVPPKEYP(cert) && EVPPKEYP(key))
3903 fun = ossl_ssl_inject_cert;
3905 if (fun && fun(ssl_conn, cert, key)) {
3914 DEFUN("ossl-ssl-inject-ca", Fossl_ssl_inject_ca, 2, 2, 0, /*
3915 Add CA to the pile of certificate authorities of SSL-CONN.
3916 Also force a \(re\)verification of the remote peer certificate
3917 against CA. Return `t' if the injection was successful,
3920 CA may be either a file name pointing to a PEM-encoded
3921 CA certificate, or may be a directory containing a valid
3922 bunch of CA certificates according to OpenSSL's CA path
3923 layout, or may also be an evp-pkey object.
3927 /* This function can GC */
3928 int (*fun)(Lisp_Object, Lisp_Object) = NULL;
3930 struct gcpro gcpro1, gcpro2;
3932 GCPRO2(ssl_conn, ca);
3934 CHECK_SSLCONN(ssl_conn);
3940 ca = Fexpand_file_name(ca, Qnil);
3941 if (NILP(Ffile_readable_p(ca)))
3945 if (!NILP(ca) && STRINGP(ca)) {
3946 if (NILP(Ffile_directory_p(ca)))
3947 fun = ossl_ssl_inject_ca_file;
3949 fun = ossl_ssl_inject_ca_path;
3950 } else if (!NILP(ca) && EVPPKEYP(ca))
3951 fun = ossl_ssl_inject_ca;
3953 if (fun && fun(ssl_conn, ca) &&
3954 (conn = XSSLCONN(ssl_conn)->ssl_conn)) {
3955 ssl_verify_cert_chain(conn, SSL_get_peer_cert_chain(conn));
3964 DEFUN("ossl-ssl-handshake", Fossl_ssl_handshake, 1, 6, 0, /*
3965 Perform a handshake on the network connection PROCESS.
3967 Return a ssl-conn object, or `nil' if the handshake failed.
3968 In the latter case, most likely the remote site cannot handle
3969 the specified method, requires a client certificate, or cannot
3972 Optional argument METHOD indicates the SSL connection method,
3973 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
3975 Optional argument CA indicates a CA certificate.
3976 See `ossl-ssl-inject-ca'.
3978 Optional arguments CERT and KEY indicate a peer certificate
3979 and possibly a separate key file respectively.
3980 See `ossl-ssl-inject-peer-cert'.
3982 Optional argument SERVERP indicates whether to perform the
3983 handshake as a server if non-nil, and as a client otherwise.
3984 Note: In case of a handshake as server it is mandatory to provide
3985 a valid certificate and a corresponding key.
3987 (process, method, ca, cert, key, serverp))
3989 /* This function can GC */
3991 Lisp_Object ssl_conn, result;
3993 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
3995 GCPRO6(process, method, ca, cert, key, serverp);
3997 /* Make sure the process is really alive. */
3998 CHECK_PROCESS(process);
3999 OSSL_CHECK_PROCESS(process);
4001 /* create a ssl_conn object first */
4003 ssl_conn = ossl_ssl_prepare_cmeth(method);
4005 ssl_conn = ossl_ssl_prepare_smeth(method);
4007 /* create the context */
4008 ossl_ssl_prepare_ctx(ssl_conn);
4010 /* certificate and key preparation */
4011 Fossl_ssl_inject_cert(ssl_conn, cert, key);
4012 /* certificate authority preparation */
4013 Fossl_ssl_inject_ca(ssl_conn, ca);
4015 /* prepare for handshake */
4017 ossl_ssl_prepare(ssl_conn, SSL_set_connect_state);
4019 ossl_ssl_prepare(ssl_conn, SSL_set_accept_state);
4021 result = ossl_ssl_handshake(ssl_conn, process);
4027 DEFUN("ossl-ssl-connect", Fossl_ssl_connect, 0, MANY, 0, /*
4028 Perform a TLS or SSL handshake, return a ssl-conn object on
4029 success, or `nil' if the handshake failed.
4030 In the latter case, most likely the remote site cannot handle
4031 the specified method, requires a client certificate, or cannot
4042 Optional argument METHOD indicates the SSL connection method,
4043 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
4045 (int nargs, Lisp_Object *args))
4049 for (i = 0; i < nargs; i++);
4055 ossl_swap_process_streams(Lisp_SSL_CONN *s, Lisp_Process *p)
4057 Lisp_Object in, out;
4059 in = p->pipe_instream;
4060 out = p->pipe_outstream;
4062 p->pipe_instream = s->pipe_instream;
4063 p->pipe_outstream = s->pipe_outstream;
4065 s->pipe_instream = in;
4066 s->pipe_outstream = out;
4069 in = p->coding_instream;
4070 out = p->coding_outstream;
4072 p->coding_instream = s->coding_instream;
4073 p->coding_outstream = s->coding_outstream;
4075 s->coding_instream = in;
4076 s->coding_outstream = out;
4081 ossl_ssl_proselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4083 Lisp_Process *p = XPROCESS(process);
4084 Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4086 event_stream_unselect_process(p);
4088 /* put the streams we have in the ssl-conn object into the process
4089 object; actually these swap their places */
4090 if (p->process_type != PROCESS_TYPE_SSL)
4091 ossl_swap_process_streams(s, p);
4093 /* somehow we gotta link the network-process with the ss-layer
4094 * otherwise it'd be easy to open a network stream then
4095 * a ss-layer on top of it and then via `delete-process'
4096 * all the work is void while the ss-layer still exists
4098 p->process_type = PROCESS_TYPE_SSL;
4099 p->process_type_data = ssl_conn;
4101 event_stream_select_process(p);
4107 ossl_ssl_unproselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4109 Lisp_Process *p = XPROCESS(process);
4110 Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4112 /* put the streams we have in the ssl-conn object into the process
4113 object (they should be the former process streams) */
4114 if (p->process_type == PROCESS_TYPE_SSL)
4115 ossl_swap_process_streams(s, p);
4117 /* somehow we gotta link the network-process with the ss-layer
4118 * otherwise it'd be easy to open a network stream then
4119 * a ss-layer on top of it and then via `delete-process'
4120 * all the work is void while the ss-layer still exists
4122 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
4123 XPROCESS(process)->process_type_data = Qnil;
4128 DEFUN("ossl-ssl-proselytise-process", Fossl_ssl_proselytise_process,
4130 Convert the underlying process of SSL-CONN into a secure
4131 network connection object.
4135 Lisp_Object process;
4137 CHECK_SSLCONN(ssl_conn);
4139 process = XSSLCONN(ssl_conn)->parent;
4140 if (!PROCESSP(process)) {
4141 error("no process associated with this connection");
4145 /* Make sure the process is really alive. */
4146 OSSL_CHECK_PROCESS(process);
4148 ossl_ssl_proselytise_process(ssl_conn, process);
4153 DEFUN("ossl-ssl-unproselytise-process", Fossl_ssl_unproselytise_process,
4155 Convert the underlying process of SSL-CONN into an ordinary
4156 network connection object.
4160 Lisp_Object process;
4162 CHECK_SSLCONN(ssl_conn);
4164 process = XSSLCONN(ssl_conn)->parent;
4165 if (!PROCESSP(process)) {
4166 error("no process associated with this connection");
4170 /* Make sure the process is really alive. */
4171 OSSL_CHECK_PROCESS(process);
4173 /* Castrate the process and make it a network process again */
4174 ossl_ssl_unproselytise_process(ssl_conn, process);
4179 DEFUN("ossl-ssl-finish", Fossl_ssl_finish, 1, 1, 0, /*
4180 Finish an SSL connection SSL-CONN.
4182 Note: This may also finish the network connection.
4186 Lisp_Object process;
4188 CHECK_SSLCONN(ssl_conn);
4190 if (XSSLCONN(ssl_conn)->protected_p)
4191 error ("Cannot finish protected SSL connection");
4193 process = XSSLCONN(ssl_conn)->parent;
4194 if (PROCESSP(process))
4195 ossl_ssl_unproselytise_process(ssl_conn, process);
4197 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
4201 DEFUN("ossl-ssl-read", Fossl_ssl_read, 2, 2, 0, /*
4202 Return the cleartext of STRING which is assumed to be a complete
4203 block of data sent through SSL-CONN.
4207 /* network stream stuff */
4209 Lisp_Object process;
4211 Lisp_Object result = Qnil;
4213 CHECK_SSLCONN(ssl_conn);
4214 CHECK_STRING(string);
4216 if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4217 error("SSL connection dead");
4219 conn = XSSLCONN(ssl_conn)->ssl_conn;
4220 process = XSSLCONN(ssl_conn)->parent;
4222 /* Make sure the process is really alive. */
4223 OSSL_CHECK_PROCESS(process);
4228 DEFUN("ossl-ssl-write", Fossl_ssl_write, 2, 2, 0, /*
4229 Send STRING to the tunnel SSL-CONN.
4233 /* network stream stuff */
4235 Lisp_Object process, proc_filter;
4240 CHECK_SSLCONN(ssl_conn);
4241 CHECK_STRING(string);
4243 if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4244 error("SSL connection dead");
4246 conn = XSSLCONN(ssl_conn)->ssl_conn;
4247 process = XSSLCONN(ssl_conn)->parent;
4249 /* Make sure the process is really alive. */
4250 OSSL_CHECK_PROCESS(process);
4252 switch (XPROCESS(process)->process_type) {
4253 case PROCESS_TYPE_NETWORK:
4254 /* ssl streams reside in ssl-conn object atm */
4255 out = XLSTREAM(DATA_OUTSTREAM(XSSLCONN(ssl_conn)));
4257 case PROCESS_TYPE_SSL:
4258 /* ssl streams reside in process object, snarf from there */
4259 out = XLSTREAM(DATA_OUTSTREAM(XPROCESS(process)));
4263 error("unable to write");
4266 /* store the original process filter */
4267 proc_filter = XPROCESS(process)->filter;
4269 ret = Lstream_write(out, XSTRING_DATA(string), XSTRING_LENGTH(string));
4272 switch (SSL_get_error(conn, ret)) {
4273 case SSL_ERROR_NONE:
4275 case SSL_ERROR_WANT_WRITE:
4276 error("Connection wants write");
4277 case SSL_ERROR_WANT_READ:
4278 error("Connection wants read");
4280 error("Severe SSL connection error");
4283 /* restore the original process filter */
4284 return (SSL_pending(conn) == 0) ? Qt : Qnil;
4287 /* convenience functions */
4288 DEFUN("ossl-ssl-parent", Fossl_ssl_parent, 1, 1, 0, /*
4289 Return the underlying parent layer of SSL-CONN.
4293 CHECK_SSLCONN(ssl_conn);
4295 return XSSLCONN(ssl_conn)->parent;
4298 DEFUN("ossl-ssl-cert", Fossl_ssl_cert, 1, 1, 0, /*
4299 Return the local peer's certificate of SSL-CONN if present,
4304 /* SSL connection stuff */
4308 CHECK_SSLCONN(ssl_conn);
4310 conn = XSSLCONN(ssl_conn)->ssl_conn;
4311 cert = SSL_get_certificate(conn);
4314 return make_evp_pkey_x509(cert);
4319 DEFUN("ossl-ssl-peer-cert", Fossl_ssl_peer_cert, 1, 1, 0, /*
4320 Return the remote peer's certificate of SSL-CONN if present,
4325 /* SSL connection stuff */
4329 CHECK_SSLCONN(ssl_conn);
4331 conn = XSSLCONN(ssl_conn)->ssl_conn;
4332 cert = SSL_get_peer_certificate(conn);
4335 return make_evp_pkey_x509(cert);
4340 DEFUN("ossl-ssl-peer-cert-chain", Fossl_ssl_peer_cert_chain, 1, 1, 0, /*
4341 Return the certificate chain of SSL-CONN as a list of
4347 /* SSL connection stuff */
4351 Lisp_Object result = Qnil;
4353 CHECK_SSLCONN(ssl_conn);
4355 conn = XSSLCONN(ssl_conn)->ssl_conn;
4356 sk = SSL_get_peer_cert_chain(conn);
4361 for (i=0; i<sk_X509_num(sk); i++) {
4362 X509 *cert = sk_X509_value(sk, i);
4364 result = Fcons(make_evp_pkey_x509(cert), result);
4371 DEFUN("ossl-ssl-cert-store", Fossl_ssl_cert_store, 1, 1, 0, /*
4372 Return the X509 cert store of SSL-CONN.
4376 X509_STORE *sto = NULL;
4382 #if 0 /* just thoughts */
4383 int SSL_get_verify_mode(const SSL *s);
4384 int SSL_get_verify_depth(const SSL *s);
4387 DEFUN("ossl-ssl-verify-certificate", Fossl_ssl_verify_certificate,
4389 Return a verify code of SSL-CONN.
4391 The result is a cons cell with the numeric verify code in
4392 the car and a verbose string in the cdr.
4397 /* SSL connection stuff */
4400 Lisp_Object result = Qnil;
4402 CHECK_SSLCONN(ssl_conn);
4404 conn = XSSLCONN(ssl_conn)->ssl_conn;
4405 vrc = SSL_get_verify_result(conn);
4409 build_string(X509_verify_cert_error_string(vrc)));
4414 DEFUN("ossl-ssl-cipher-version", Fossl_ssl_cipher_version, 1, 1, 0, /*
4415 Return the protocol version of the tunnel SSL-CONN.
4419 /* SSL connection stuff */
4421 const SSL_CIPHER *ciph;
4422 /* network stream stuff */
4423 Lisp_SSL_CONN *lisp_ssl_conn;
4425 CHECK_SSLCONN(ssl_conn);
4426 lisp_ssl_conn = XSSLCONN(ssl_conn);
4428 conn = lisp_ssl_conn->ssl_conn;
4432 ciph = SSL_get_current_cipher(conn);
4434 if (!(ciph == NULL))
4435 return Fmake_symbol(
4436 build_string(SSL_CIPHER_get_version(ciph)));
4441 DEFUN("ossl-ssl-cipher-name", Fossl_ssl_cipher_name, 1, 1, 0, /*
4442 Return the name of the current cipher used in the tunnel SSL-CONN.
4446 /* SSL connection stuff */
4448 const SSL_CIPHER *ciph;
4449 /* network stream stuff */
4450 Lisp_SSL_CONN *lisp_ssl_conn;
4452 CHECK_SSLCONN(ssl_conn);
4453 lisp_ssl_conn = XSSLCONN(ssl_conn);
4455 conn = lisp_ssl_conn->ssl_conn;
4459 ciph = SSL_get_current_cipher(conn);
4461 if (!(ciph == NULL))
4462 return intern(SSL_CIPHER_get_name(ciph));
4467 DEFUN("ossl-ssl-cipher-names", Fossl_ssl_cipher_names, 1, 1, 0, /*
4468 Return the names of all supported ciphers in the tunnel SSL-CONN.
4473 /* SSL connection stuff */
4475 STACK_OF(SSL_CIPHER) *ciphs;
4476 Lisp_Object result = Qnil;
4478 CHECK_SSLCONN(ssl_conn);
4480 conn = XSSLCONN(ssl_conn)->ssl_conn;
4484 ciphs = SSL_get_ciphers(conn);
4486 for (i=sk_SSL_CIPHER_num(ciphs)-1; i>=0; i--) {
4487 SSL_CIPHER *ciph = sk_SSL_CIPHER_value(ciphs, i);
4489 result = Fcons(intern(SSL_CIPHER_get_name(ciph)), result);
4495 DEFUN("ossl-ssl-cipher-bits", Fossl_ssl_cipher_bits, 1, 1, 0, /*
4496 Return the number of effective bits of the current cipher in SSL-CONN.
4500 /* SSL connection stuff */
4502 const SSL_CIPHER *ciph;
4503 int alg_bits, strength_bits;
4504 /* network stream stuff */
4505 Lisp_SSL_CONN *lisp_ssl_conn;
4507 CHECK_SSLCONN(ssl_conn);
4508 lisp_ssl_conn = XSSLCONN(ssl_conn);
4510 conn = lisp_ssl_conn->ssl_conn;
4514 ciph = SSL_get_current_cipher(conn);
4516 if (!(ciph == NULL)) {
4517 strength_bits = SSL_CIPHER_get_bits(ciph, &alg_bits);
4518 /* what do we want to do with alg_bits? */
4519 return make_int(strength_bits);
4524 DEFUN("ossl-ssl-cipher-description", Fossl_ssl_cipher_description, 1, 1, 0, /*
4525 Return a description of the current cipher used in the tunnel SSL-CONN.
4529 /* SSL connection stuff */
4531 const SSL_CIPHER *ciph;
4532 /* network stream stuff */
4533 Lisp_SSL_CONN *lisp_ssl_conn;
4535 CHECK_SSLCONN(ssl_conn);
4536 lisp_ssl_conn = XSSLCONN(ssl_conn);
4538 conn = lisp_ssl_conn->ssl_conn;
4542 ciph = SSL_get_current_cipher(conn);
4544 if (!(ciph == NULL))
4545 return build_string(SSL_CIPHER_description(ciph, NULL, 0));
4551 /* X509 cert handling */
4552 DEFUN("ossl-x509-subject", Fossl_x509_subject, 1, 1, 0, /*
4553 Return the certificate subject of CERT (an evp-pkey object).
4555 This will return a string in LDAP syntax.
4561 CHECK_EVPPKEY(cert);
4563 pk509 = XEVPPKEY(cert)->x509;
4566 X509_NAME *sub = X509_get_subject_name(pk509);
4567 return build_string(X509_NAME_oneline(sub, NULL, 0));
4572 DEFUN("ossl-x509-issuer", Fossl_x509_issuer, 1, 1, 0, /*
4573 Return the certificate issuer of CERT (an evp-pkey object),
4574 that is the organisation which signed the certificate.
4576 This will return a string in LDAP syntax.
4582 CHECK_EVPPKEY(cert);
4584 pk509 = XEVPPKEY(cert)->x509;
4587 X509_NAME *iss = X509_get_issuer_name(pk509);
4588 return build_string(X509_NAME_oneline(iss, NULL, 0));
4593 DEFUN("ossl-x509-serial", Fossl_x509_serial, 1, 1, 0, /*
4594 Return the certificate serial of CERT (an evp-pkey object).
4600 CHECK_EVPPKEY(cert);
4602 pk509 = XEVPPKEY(cert)->x509;
4605 ASN1_INTEGER *ser = X509_get_serialNumber(pk509);
4606 return make_integer(ASN1_INTEGER_get(ser));
4611 DEFUN("ossl-x509-not-before", Fossl_x509_not_before, 1, 1, 0, /*
4612 Return the certificate valid-not-before time of CERT.
4618 CHECK_EVPPKEY(cert);
4620 pk509 = XEVPPKEY(cert)->x509;
4623 ASN1_TIME *nbf = X509_get_notBefore(pk509);
4624 return build_string((char*)nbf->data);
4629 DEFUN("ossl-x509-not-after", Fossl_x509_not_after, 1, 1, 0, /*
4630 Return the certificate valid-not-after time of CERT.
4636 CHECK_EVPPKEY(cert);
4638 pk509 = XEVPPKEY(cert)->x509;
4641 ASN1_TIME *nbf = X509_get_notAfter(pk509);
4642 return build_string((char*)nbf->data);
4647 DEFUN("ossl-x509-signature-type", Fossl_x509_signature_type, 1, 1, 0, /*
4648 Return the signature type of CERT.
4654 CHECK_EVPPKEY(cert);
4656 pk509 = XEVPPKEY(cert)->x509;
4659 int ty = X509_get_signature_type(pk509);
4660 Lisp_Object result = Qnil;
4664 result = intern("none");
4666 #ifndef OPENSSL_NO_RSA
4668 result = intern("rsa");
4671 result = intern("rsa2");
4674 #ifndef OPENSSL_NO_DSA
4676 result = intern("dsa");
4679 result = intern("dsa1");
4682 result = intern("dsa2");
4685 result = intern("dsa3");
4688 result = intern("dsa4");
4691 #ifndef OPENSSL_NO_DH
4693 result = intern("dh");
4696 #ifndef OPENSSL_NO_EC
4698 result = intern("ec");
4702 result = intern("unknown");
4717 * Initialisation stuff
4720 void syms_of_openssl(void)
4722 INIT_LRECORD_IMPLEMENTATION(evp_pkey);
4723 INIT_LRECORD_IMPLEMENTATION(ssl_conn);
4725 defsymbol(&Qopenssl, "openssl");
4726 defsymbol(&Qevp_pkeyp, "ossl-pkey-p");
4728 DEFSUBR(Fossl_version);
4729 DEFSUBR(Fossl_available_digests);
4730 DEFSUBR(Fossl_available_ciphers);
4731 DEFSUBR(Fossl_digest_size);
4732 DEFSUBR(Fossl_digest_bits);
4733 DEFSUBR(Fossl_digest_block_size);
4734 DEFSUBR(Fossl_cipher_key_length);
4735 DEFSUBR(Fossl_cipher_bits);
4736 DEFSUBR(Fossl_cipher_iv_length);
4737 DEFSUBR(Fossl_cipher_block_size);
4738 DEFSUBR(Fossl_cipher_mode);
4740 DEFSUBR(Fossl_rand_bytes);
4741 DEFSUBR(Fossl_rand_bytes_egd);
4743 DEFSUBR(Fossl_digest);
4744 DEFSUBR(Fossl_digest_file);
4746 DEFSUBR(Fossl_hmac);
4747 DEFSUBR(Fossl_hmac_file);
4749 DEFSUBR(Fossl_bytes_to_key);
4750 DEFSUBR(Fossl_encrypt);
4751 DEFSUBR(Fossl_encrypt_file);
4752 DEFSUBR(Fossl_decrypt);
4753 DEFSUBR(Fossl_decrypt_file);
4756 DEFSUBR(Fossl_pkey_p);
4757 DEFSUBR(Fossl_pkey_size);
4758 DEFSUBR(Fossl_pkey_private_p);
4759 DEFSUBR(Fossl_pkey_get_public);
4761 #ifndef OPENSSL_NO_RSA
4763 DEFSUBR(Fossl_rsa_generate_key);
4764 DEFSUBR(Fossl_rsa_pkey_p);
4765 DEFSUBR(Fossl_rsa_subkey_p);
4766 #endif /* OPENSSL_NO_RSA */
4767 #ifndef OPENSSL_NO_DSA
4769 DEFSUBR(Fossl_dsa_generate_key);
4770 DEFSUBR(Fossl_dsa_pkey_p);
4771 DEFSUBR(Fossl_dsa_subkey_p);
4772 #endif /* OPENSSL_NO_DSA */
4773 #ifndef OPENSSL_NO_EC
4775 DEFSUBR(Fossl_ec_available_curves);
4776 DEFSUBR(Fossl_ec_generate_key);
4777 DEFSUBR(Fossl_ec_pkey_p);
4778 #endif /* OPENSSL_NO_EC */
4779 #ifndef OPENSSL_NO_DH
4781 /* DEFSUBR(Fossl_ec_generate_key); */
4782 DEFSUBR(Fossl_dh_pkey_p);
4784 DEFSUBR(Fossl_seal);
4785 DEFSUBR(Fossl_open);
4787 DEFSUBR(Fossl_sign);
4788 DEFSUBR(Fossl_verify);
4791 DEFSUBR(Fossl_pem_read_public_key);
4792 DEFSUBR(Fossl_pem_read_key);
4793 DEFSUBR(Fossl_pem_write_public_key);
4794 DEFSUBR(Fossl_pem_write_key);
4795 DEFSUBR(Fossl_pem_public_key);
4796 DEFSUBR(Fossl_pem_key);
4799 defsymbol(&Qssl_connp, "ossl-ssl-conn-p");
4800 defsymbol(&Qssl2, "ssl2");
4801 defsymbol(&Qssl23, "ssl23");
4802 defsymbol(&Qssl3, "ssl3");
4803 defsymbol(&Qtls1, "tls1");
4805 DEFSUBR(Fossl_ssl_handshake);
4806 DEFSUBR(Fossl_ssl_inject_ca);
4807 DEFSUBR(Fossl_ssl_inject_cert);
4808 DEFSUBR(Fossl_ssl_proselytise_process);
4809 DEFSUBR(Fossl_ssl_unproselytise_process);
4810 DEFSUBR(Fossl_ssl_connect);
4811 DEFSUBR(Fossl_ssl_finish);
4812 DEFSUBR(Fossl_ssl_read);
4813 DEFSUBR(Fossl_ssl_write);
4814 DEFSUBR(Fossl_ssl_parent);
4815 DEFSUBR(Fossl_ssl_cert);
4816 DEFSUBR(Fossl_ssl_peer_cert);
4817 DEFSUBR(Fossl_ssl_peer_cert_chain);
4818 DEFSUBR(Fossl_ssl_verify_certificate);
4819 DEFSUBR(Fossl_ssl_cipher_version);
4820 DEFSUBR(Fossl_ssl_cipher_name);
4821 DEFSUBR(Fossl_ssl_cipher_names);
4822 DEFSUBR(Fossl_ssl_cipher_bits);
4823 DEFSUBR(Fossl_ssl_cipher_description);
4826 DEFSUBR(Fossl_x509_subject);
4827 DEFSUBR(Fossl_x509_issuer);
4828 DEFSUBR(Fossl_x509_serial);
4829 DEFSUBR(Fossl_x509_not_before);
4830 DEFSUBR(Fossl_x509_not_after);
4831 DEFSUBR(Fossl_x509_signature_type);
4834 void vars_of_openssl(void)
4838 #ifndef OPENSSL_NO_RSA
4839 Fprovide(intern("openssl-rsa"));
4841 #ifndef OPENSSL_NO_DSA
4842 Fprovide(intern("openssl-dsa"));
4844 #ifndef OPENSSL_NO_EC
4845 Fprovide(intern("openssl-ec"));
4847 #ifndef OPENSSL_NO_DH
4848 Fprovide(intern("openssl-dh"));
4851 Fprovide(intern("openssl-ssl"));