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);
898 SXE_SET_UNUSED(md_blocksize);
900 EVP_DigestInit_ex(mdctx, md, NULL);
902 /* we reuse md_value here for streaming over fp */
904 n = fread(md_value, 1, EVP_MAX_MD_SIZE, fp);
909 error("file corrupted");
912 EVP_DigestUpdate(mdctx, md_value, n);
915 EVP_DigestFinal_ex(mdctx, md_value, &md_len);
916 EVP_MD_CTX_cleanup(mdctx);
922 return make_ext_string((char *)md_value, md_len, OSSL_CODING);
928 * HMAC (aka keyed hashes)
931 DEFUN("ossl-hmac", Fossl_hmac, 3, 3, 0, /*
932 Return the message authentication code of MSG
933 using the hash function DIGEST and the key PASSWORD.
935 Note: You probably want to put a wrapping encoder function
936 \(like `base16-encode-string'\) around it, since this returns
939 (digest, msg, password))
944 /* buffer for the ciphertext */
945 unsigned char outbuf[EVP_MAX_MD_SIZE];
947 /* buffer for external password */
949 unsigned int password_len;
951 /* buffer for external message */
953 unsigned int msg_len;
956 CHECK_SYMBOL(digest);
958 CHECK_STRING(password);
960 OpenSSL_add_all_digests();
961 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
965 error ("no such digest");
968 TO_EXTERNAL_FORMAT (LISP_STRING, password,
969 C_STRING_ALLOCA, password_ext, OSSL_CODING);
970 password_len = OSSL_STRING_LENGTH(password);
972 #if 0 /* i wonder why */
973 TO_EXTERNAL_FORMAT (LISP_STRING, msg,
974 C_STRING_ALLOCA, msg_ext, OSSL_CODING);
975 msg_len = OSSL_STRING_LENGTH(msg);
978 hmacctx = xnew(HMAC_CTX);
979 HMAC_CTX_init(hmacctx);
980 HMAC_Init(hmacctx, password_ext, password_len, md);
981 HMAC_Update(hmacctx, (unsigned char*)XSTRING_DATA(msg),
982 XSTRING_LENGTH(msg));
983 HMAC_Final(hmacctx, outbuf, &outlen);
984 HMAC_CTX_cleanup(hmacctx);
989 return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
992 DEFUN("ossl-hmac-file", Fossl_hmac_file, 3, 3, 0, /*
993 Return the message authentication code of the contents of FILE
994 using the hash function DIGEST and the key PASSWORD.
996 Note: You probably want to put a wrapping encoder function
997 \(like `base16-encode-string'\) around it, since this returns
1000 (digest, file, password))
1005 /* buffer for the ciphertext */
1006 unsigned char outbuf[EVP_MAX_MD_SIZE];
1007 unsigned int outlen;
1009 /* buffer for external password */
1011 unsigned int password_len;
1015 CHECK_SYMBOL(digest);
1017 CHECK_STRING(password);
1019 file = Fexpand_file_name(file, Qnil);
1021 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1022 (fseek(fp, 0, SEEK_SET))) {
1025 return wrong_type_argument(Qfile_readable_p, file);
1029 OpenSSL_add_all_digests();
1030 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
1034 error ("no such digest");
1037 TO_EXTERNAL_FORMAT (LISP_STRING, password,
1038 C_STRING_ALLOCA, password_ext, OSSL_CODING);
1039 password_len = OSSL_STRING_LENGTH(password);
1041 hmacctx = xnew(HMAC_CTX);
1042 HMAC_CTX_init(hmacctx);
1043 HMAC_Init(hmacctx, password_ext, password_len, md);
1045 /* we reuse md_value here for streaming over fp */
1047 n = fread(outbuf, 1, EVP_MAX_MD_SIZE, fp);
1052 error("file corrupted");
1055 HMAC_Update(hmacctx, outbuf, n);
1058 HMAC_Final(hmacctx, outbuf, &outlen);
1059 HMAC_CTX_cleanup(hmacctx);
1065 return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1074 DEFUN("ossl-bytes-to-key", Fossl_bytes_to_key, 5, 5, 0, /*
1075 Derive a key and initialisation vector (iv) suitable for a cipher.
1076 Return a string KEY being the key. The initialisation vector is
1077 put into KEY's property list as 'iv.
1079 CIPHER \(a symbol\) is the cipher to derive the key and IV for.
1080 Valid ciphers can be obtained by `ossl-available-ciphers'.
1082 DIGEST \(a symbol\) is the message digest to use.
1083 Valid digests can be obtained by `ossl-available-digests'.
1085 SALT \(string or `nil'\) is used as a salt in the derivation.
1086 Use `nil' here to indicate that no salt is used.
1088 PASSWORD is an arbitrary string which is processed to derive a
1091 COUNT \(a positive integer\) is the iteration count to use. This
1092 indicates how often the hash algorithm is called recursively.
1094 Note: You probably want to put a wrapping encoder function
1095 \(like `base16-encode-string'\) around it, since this returns
1098 (cipher, digest, salt, password, count))
1101 const EVP_CIPHER *ciph;
1102 const char *salt_ext;
1105 unsigned int password_len;
1107 char key[EVP_MAX_KEY_LENGTH];
1108 char iv[EVP_MAX_IV_LENGTH];
1112 CHECK_STRING(password);
1113 CHECK_SYMBOL(cipher);
1114 CHECK_SYMBOL(digest);
1115 CHECK_NATNUM(count);
1119 error ("count has to be a non-zero positive integer");
1121 OpenSSL_add_all_algorithms();
1122 md = EVP_get_digestbyname(
1123 (char *)string_data(XSYMBOL(digest)->name));
1124 ciph = EVP_get_cipherbyname(
1125 (char *)string_data(XSYMBOL(cipher)->name));
1129 error ("no such cipher");
1134 error ("no such digest");
1141 TO_EXTERNAL_FORMAT (LISP_STRING, salt,
1142 C_STRING_ALLOCA, salt_ext, OSSL_CODING);
1146 TO_EXTERNAL_FORMAT (LISP_STRING, password,
1147 C_STRING_ALLOCA, password_ext, OSSL_CODING);
1148 password_len = OSSL_STRING_LENGTH(password);
1150 EVP_BytesToKey(ciph, md, (const unsigned char *)salt_ext,
1151 (const unsigned char *)password_ext, password_len,
1153 (unsigned char *)key,
1154 (unsigned char *)iv);
1158 result = make_ext_string(key, EVP_CIPHER_key_length(ciph), OSSL_CODING);
1159 Fput(result, intern("iv"),
1160 make_ext_string(iv, EVP_CIPHER_iv_length(ciph), OSSL_CODING));
1166 DEFUN("ossl-encrypt", Fossl_encrypt, 3, 4, 0, /*
1167 Return the cipher of STRING computed by CIPHER under KEY.
1169 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1170 you have compiled. See `ossl-available-ciphers'.
1172 STRING is the text to be encrypted.
1174 KEY should be a key generated suitably for this cipher, for example
1175 by `ossl-bytes-to-key'.
1177 Optional fourth argument IV should be an initialisation vector
1178 suitable for this cipher. Normally the initialisation vector from
1179 KEY's property list is used. However, if IV is
1180 non-nil, use this IV instead.
1182 Note: You probably want to put a wrapping encoder function
1183 \(like `base16-encode-string'\) around it, since this returns
1186 (cipher, string, key, iv))
1188 /* buffer for the external string */
1190 unsigned int string_len;
1191 /* buffer for the ciphertext */
1194 Lisp_Object l_outbuf;
1195 /* buffer for key */
1200 /* declarations for the cipher */
1201 const EVP_CIPHER *ciph;
1202 EVP_CIPHER_CTX *ciphctx;
1205 int speccount = specpdl_depth();
1208 /* frob the IV from the plist of key maybe */
1210 iv = Fget(key, intern("iv"), Qnil);
1212 CHECK_SYMBOL(cipher);
1213 CHECK_STRING(string);
1217 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1218 C_STRING_ALLOCA, string_ext, OSSL_CODING);
1219 string_len = OSSL_STRING_LENGTH(string);
1221 if (string_len <= 0)
1222 error ("string must be of non-zero positive length.");
1224 OpenSSL_add_all_algorithms();
1225 /* ENGINE_load_builtin_engines(); */
1226 /* atm, no support for different engines */
1227 ciph = EVP_get_cipherbyname(
1228 (char *)string_data(XSYMBOL(cipher)->name));
1232 error ("no such cipher");
1235 /* now allocate some output buffer externally
1236 * this one has to be at least EVP_CIPHER_block_size bigger
1237 * since block algorithms merely operate blockwise
1239 alloclen = XSTRING_LENGTH(string) + EVP_CIPHER_block_size(ciph);
1240 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1242 TO_EXTERNAL_FORMAT(LISP_STRING, key,
1243 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1244 TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1245 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1247 ciphctx = xnew(EVP_CIPHER_CTX);
1248 EVP_CIPHER_CTX_init(ciphctx);
1249 if (!EVP_EncryptInit(ciphctx, ciph,
1250 (unsigned char *)key_ext,
1251 (unsigned char *)iv_ext)) {
1254 error ("error in EncryptInit");
1256 if (!EVP_EncryptUpdate(ciphctx,
1257 (unsigned char *)outbuf, &outlen,
1258 (unsigned char *)string_ext, string_len)) {
1261 error ("error in EncryptUpdate");
1263 /* Buffer passed to EVP_EncryptFinal() must be after data just
1264 * encrypted to avoid overwriting it.
1266 if (!EVP_EncryptFinal(ciphctx,
1267 (unsigned char *)outbuf+outlen, &tmplen)) {
1270 error ("error in EncryptFinal");
1272 /* added probable padding space to the length of the output buffer */
1274 EVP_CIPHER_CTX_cleanup(ciphctx);
1276 l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1277 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1285 DEFUN("ossl-encrypt-file", Fossl_encrypt_file, 3, 5, 0, /*
1286 Return the encrypted contents of FILE computed by CIPHER under KEY.
1288 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1289 you have compiled. See `ossl-available-ciphers'.
1291 FILE is the file to be encrypted.
1293 Third argument KEY should be a key generated suitably for this
1294 cipher, for example by `ossl-bytes-to-key'.
1296 Optional fourth argument IV should be an initialisation vector
1297 suitable for this cipher. Normally the initialisation vector from
1298 KEY's property list is used. However, if IV is
1299 non-nil, use this IV instead.
1301 Optional fifth argument OUTFILE may specify a file to have the
1302 encrypted data redirected.
1304 Note: You probably want to put a wrapping encoder function
1305 \(like `base16-encode-string'\) around it, since this returns
1308 (cipher, file, key, iv, outfile))
1310 /* buffer for the external string */
1311 unsigned char string_in[1024];
1313 unsigned int block_len;
1314 unsigned long file_size;
1315 /* buffer for the ciphertext */
1316 unsigned char *outbuf;
1319 Lisp_Object l_outbuf;
1320 /* buffer for key */
1330 /* declarations for the cipher */
1331 const EVP_CIPHER *ciph;
1332 EVP_CIPHER_CTX *ciphctx;
1335 int speccount = specpdl_depth();
1338 /* frob the IV from the plist of key maybe */
1340 iv = Fget(key, intern("iv"), Qnil);
1342 CHECK_SYMBOL(cipher);
1347 if (!NILP(outfile)) {
1348 CHECK_STRING(outfile);
1349 outfile = Fexpand_file_name(outfile, Qnil);
1350 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1351 return wrong_type_argument(Qfile_writable_p, outfile);
1356 file = Fexpand_file_name(file, Qnil);
1357 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1358 (fseek(fp, 0, SEEK_SET))) {
1363 return wrong_type_argument(Qfile_readable_p, file);
1366 fseek(fp, 0, SEEK_END);
1367 file_size = ftell(fp);
1368 fseek(fp, 0, SEEK_SET);
1371 OpenSSL_add_all_algorithms();
1372 /* ENGINE_load_builtin_engines(); */
1373 /* atm, no support for different engines */
1374 ciph = EVP_get_cipherbyname(
1375 (char *)string_data(XSYMBOL(cipher)->name));
1382 error ("no such cipher");
1385 /* now allocate some output buffer externally
1386 * this one has to be at least EVP_CIPHER_block_size bigger
1387 * since block algorithms merely operate blockwise
1389 block_len = EVP_CIPHER_block_size(ciph);
1390 if (UNLIKELY(of != NULL)) {
1393 alloclen = file_size + block_len;
1395 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1397 TO_EXTERNAL_FORMAT(LISP_STRING, key,
1398 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1399 TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1400 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1402 ciphctx = xnew(EVP_CIPHER_CTX);
1403 EVP_CIPHER_CTX_init(ciphctx);
1404 if (!EVP_EncryptInit(ciphctx, ciph,
1405 (unsigned char *)key_ext,
1406 (unsigned char *)iv_ext)) {
1412 error("error in EncryptInit");
1418 string_len = fread(string_in, 1, 1024, fp);
1419 if (string_len < 0) {
1425 error("file corrupted");
1430 if (string_len > 0 &&
1431 !EVP_EncryptUpdate(ciphctx,
1433 string_in, string_len)) {
1439 error("error in EncryptUpdate");
1443 fwrite(obp, 1, tmplen, of);
1448 } while (string_len > 0);
1450 /* Buffer passed to EVP_EncryptFinal() must be after data just
1451 * encrypted to avoid overwriting it.
1453 if (!EVP_EncryptFinal(ciphctx, obp, &tmplen)) {
1459 error("error in EncryptFinal");
1463 fwrite(obp, 1, tmplen, of);
1465 /* added probable padding space to the length of the output buffer */
1467 EVP_CIPHER_CTX_cleanup(ciphctx);
1469 if (UNLIKELY(of != NULL)) {
1472 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1474 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1485 (setq k (ossl-bytes-to-key 'AES-256-OFB 'SHA1 nil "password" 1))
1486 (ossl-encrypt-file 'AES-256-OFB "~/.gnus" k nil "/tmp/gnus-enc")
1487 (ossl-decrypt-file 'AES-256-OFB "/tmp/gnus-enc" k nil "/tmp/gnus-dec")
1491 DEFUN("ossl-decrypt", Fossl_decrypt, 3, 4, 0, /*
1492 Return the deciphered version of STRING computed by CIPHER under KEY.
1494 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1495 you have compiled. See `ossl-available-ciphers'.
1497 STRING is the text to be decrypted.
1499 KEY should be a key generated suitably for this
1500 cipher, for example by `ossl-bytes-to-key'.
1502 Optional fourth argument IV should be an initialisation vector
1503 suitable for this cipher. Normally the initialisation vector from
1504 KEY's property list is used. However, if IV is
1505 non-nil, use this IV instead.
1507 (cipher, string, key, iv))
1509 /* buffer for the external string */
1511 unsigned int string_len;
1512 /* buffer for the deciphered text */
1515 Lisp_Object l_outbuf;
1516 /* buffer for key */
1521 /* declarations for the decipher */
1522 const EVP_CIPHER *ciph;
1523 EVP_CIPHER_CTX *ciphctx;
1526 int speccount = specpdl_depth();
1529 /* frob the IV from the plist of key maybe */
1531 iv = Fget(key, intern("iv"), Qnil);
1533 CHECK_SYMBOL(cipher);
1534 CHECK_STRING(string);
1538 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1539 C_STRING_ALLOCA, string_ext, OSSL_CODING);
1540 string_len = OSSL_STRING_LENGTH(string);
1543 error ("string must be of non-zero positive length.");
1545 OpenSSL_add_all_algorithms();
1546 /* ENGINE_load_builtin_engines(); */
1547 /* atm, no support for different engines */
1548 ciph = EVP_get_cipherbyname(
1549 (char *)string_data(XSYMBOL(cipher)->name));
1553 error ("no such cipher");
1556 /* now allocate some output buffer externally */
1557 alloclen = XSTRING_LENGTH(string);
1558 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1560 TO_EXTERNAL_FORMAT (LISP_STRING, key,
1561 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1562 TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1563 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1565 ciphctx = xnew(EVP_CIPHER_CTX);
1566 EVP_CIPHER_CTX_init(ciphctx);
1567 if (!EVP_DecryptInit(ciphctx, ciph,
1568 (unsigned char *)key_ext,
1569 (unsigned char *)iv_ext)) {
1572 error ("error in DecryptInit");
1574 if (!EVP_DecryptUpdate(ciphctx,
1575 (unsigned char *)outbuf, &outlen,
1576 (unsigned char *)string_ext,string_len)) {
1579 error ("error in DecryptUpdate");
1581 /* Buffer passed to EVP_EncryptFinal() must be after data just
1582 * encrypted to avoid overwriting it.
1584 if (!EVP_DecryptFinal(ciphctx,
1585 (unsigned char *)outbuf+outlen, &tmplen)) {
1588 error ("error in DecryptFinal");
1590 /* added probable padding space to the length of the output buffer */
1592 EVP_CIPHER_CTX_cleanup(ciphctx);
1594 l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1595 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1603 DEFUN("ossl-decrypt-file", Fossl_decrypt_file, 3, 5, 0, /*
1604 Return the deciphered version of FILE computed by CIPHER under KEY.
1606 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1607 you have compiled. See `ossl-available-ciphers'.
1609 FILE is the file to be decrypted.
1611 Third argument KEY should be a key generated suitably for this
1612 cipher, for example by `ossl-bytes-to-key'.
1614 Optional fourth argument IV should be an initialisation vector
1615 suitable for this cipher. Normally the initialisation vector from
1616 KEY's property list is used. However, if IV is
1617 non-nil, use this IV instead.
1619 Optional fifth argument OUTFILE may specify a file to have the
1620 encrypted data redirected.
1622 (cipher, file, key, iv, outfile))
1624 /* buffer for the external string */
1625 unsigned char string_in[1024];
1627 unsigned int block_len;
1628 unsigned long file_size;
1629 /* buffer for the deciphered text */
1630 unsigned char *outbuf;
1633 Lisp_Object l_outbuf;
1634 /* buffer for key */
1644 /* declarations for the decipher */
1645 const EVP_CIPHER *ciph;
1646 EVP_CIPHER_CTX *ciphctx;
1649 int speccount = specpdl_depth();
1652 /* frob the IV from the plist of key maybe */
1654 iv = Fget(key, intern("iv"), Qnil);
1656 CHECK_SYMBOL(cipher);
1661 if (!NILP(outfile)) {
1662 CHECK_STRING(outfile);
1663 outfile = Fexpand_file_name(outfile, Qnil);
1664 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1665 return wrong_type_argument(Qfile_writable_p, outfile);
1670 file = Fexpand_file_name(file, Qnil);
1671 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1672 (fseek(fp, 0, SEEK_SET))) {
1677 return wrong_type_argument(Qfile_readable_p, file);
1680 fseek(fp, 0, SEEK_END);
1681 file_size = ftell(fp);
1682 fseek(fp, 0, SEEK_SET);
1685 OpenSSL_add_all_algorithms();
1686 /* ENGINE_load_builtin_engines(); */
1687 /* atm, no support for different engines */
1688 ciph = EVP_get_cipherbyname(
1689 (char *)string_data(XSYMBOL(cipher)->name));
1696 error ("no such cipher");
1699 /* now allocate some output buffer externally */
1700 block_len = EVP_CIPHER_block_size(ciph);
1701 if (UNLIKELY(of != NULL)) {
1704 alloclen = file_size + block_len;
1706 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1708 TO_EXTERNAL_FORMAT (LISP_STRING, key,
1709 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1710 TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1711 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1713 ciphctx = xnew(EVP_CIPHER_CTX);
1714 EVP_CIPHER_CTX_init(ciphctx);
1715 if (!EVP_DecryptInit(ciphctx, ciph,
1716 (unsigned char *)key_ext,
1717 (unsigned char *)iv_ext)) {
1723 error ("error in DecryptInit");
1729 string_len = fread(string_in, 1, 1024, fp);
1730 if (string_len < 0) {
1736 error("file corrupted");
1741 if (string_len > 0 &&
1742 !EVP_DecryptUpdate(ciphctx,
1744 string_in, string_len)) {
1750 error ("error in DecryptUpdate");
1754 fwrite(obp, 1, tmplen, of);
1759 } while (string_len > 0);
1761 /* Buffer passed to EVP_EncryptFinal() must be after data just
1762 * encrypted to avoid overwriting it.
1764 if (!EVP_DecryptFinal(ciphctx, obp, &tmplen)) {
1770 error ("error in DecryptFinal");
1774 fwrite(obp, 1, tmplen, of);
1776 /* added probable padding space to the length of the output buffer */
1778 EVP_CIPHER_CTX_cleanup(ciphctx);
1780 if (UNLIKELY(of != NULL)) {
1783 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1785 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1802 /* This is an opaque object for storing PKEYs in lisp */
1803 Lisp_Object Qevp_pkeyp;
1806 mark_evp_pkey(Lisp_Object obj)
1808 /* avoid some warning */
1814 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 write_fmt_str(printcharfun, ", size %d", EVP_PKEY_size(pkey)*8);
1857 write_c_string(">", printcharfun);
1859 /* avoid some warning */
1863 static Lisp_EVP_PKEY *
1864 allocate_evp_pkey(void)
1866 Lisp_EVP_PKEY *evp_pkey =
1867 alloc_lcrecord_type(Lisp_EVP_PKEY, &lrecord_evp_pkey);
1868 evp_pkey->evp_pkey = NULL;
1869 evp_pkey->x509 = NULL;
1874 finalise_evp_pkey(void *header, int for_disksave)
1876 Lisp_EVP_PKEY *evp_pkey = (Lisp_EVP_PKEY *) header;
1878 if (evp_pkey->evp_pkey) {
1879 EVP_PKEY_free(evp_pkey->evp_pkey);
1880 evp_pkey->evp_pkey = NULL;
1882 if (evp_pkey->x509) {
1883 X509_free(evp_pkey->x509);
1884 evp_pkey->x509 = NULL;
1887 /* avoid some warning */
1891 DEFINE_LRECORD_IMPLEMENTATION("evp_pkey", evp_pkey,
1892 mark_evp_pkey, print_evp_pkey,
1898 make_evp_pkey(EVP_PKEY *pkey, X509 *x509)
1900 Lisp_EVP_PKEY *lisp_pkey = allocate_evp_pkey();
1902 lisp_pkey->evp_pkey = pkey;
1903 lisp_pkey->x509 = x509;
1905 return wrap_evppkey(lisp_pkey);
1909 make_evp_pkey_pk(EVP_PKEY *pkey)
1911 return make_evp_pkey(pkey, NULL);
1915 make_evp_pkey_x509(X509 *x509)
1917 return make_evp_pkey(X509_get_pubkey(x509), x509);
1920 DEFUN("ossl-pkey-p", Fossl_pkey_p, 1, 1, 0, /*
1921 Return t iff OBJECT is a pkey, nil otherwise.
1925 if (EVPPKEYP(object))
1931 DEFUN("ossl-pkey-size", Fossl_pkey_size, 1, 1, 0, /*
1932 Return the size a public key PKEY in bits.
1938 CHECK_EVPPKEY(pkey);
1940 pk = (XEVPPKEY(pkey))->evp_pkey;
1942 return make_int(EVP_PKEY_size(pk)*8);
1946 ossl_pkey_has_public_data(EVP_PKEY *pkey)
1948 if (rsa_pkey_p(pkey)) {
1949 #ifndef OPENSSL_NO_RSA
1950 return rsa_pkey_has_public_data((pkey->pkey).rsa);
1954 } else if (dsa_pkey_p(pkey)) {
1955 #ifndef OPENSSL_NO_DSA
1956 return dsa_pkey_has_public_data((pkey->pkey).dsa);
1960 } else if (ec_pkey_p(pkey)) {
1961 #ifndef OPENSSL_NO_EC
1962 return ec_pkey_has_public_data((pkey->pkey).ec);
1966 } else if (dh_pkey_p(pkey)) {
1967 #ifndef OPENSSL_NO_DH
1968 return dh_pkey_has_public_data((pkey->pkey).dh);
1976 ossl_pkey_has_private_data(EVP_PKEY *pkey)
1978 if (rsa_pkey_p(pkey)) {
1979 #ifndef OPENSSL_NO_RSA
1980 return rsa_pkey_has_private_data((pkey->pkey).rsa);
1984 } else if (dsa_pkey_p(pkey)) {
1985 #ifndef OPENSSL_NO_DSA
1986 return dsa_pkey_has_private_data((pkey->pkey).dsa);
1990 } else if (ec_pkey_p(pkey)) {
1991 #ifndef OPENSSL_NO_EC
1992 return ec_pkey_has_private_data((pkey->pkey).ec);
1996 } else if (dh_pkey_p(pkey)) {
1997 #ifndef OPENSSL_NO_DH
1998 return dh_pkey_has_private_data((pkey->pkey).dh);
2006 DEFUN("ossl-pkey-private-p", Fossl_pkey_private_p, 1, 1, 0, /*
2007 Return non-nil if PKEY contains private data.
2009 This function is not native OpenSSL.
2015 if (!(EVPPKEYP(pkey)))
2018 pk = (XEVPPKEY(pkey))->evp_pkey;
2020 if (ossl_pkey_has_private_data(pk))
2026 DEFUN("ossl-pkey-get-public", Fossl_pkey_get_public, 1, 1, 0, /*
2027 Return a copy of PKEY stripped by the private data.
2029 This function is not native OpenSSL.
2036 CHECK_EVPPKEY(pkey);
2038 pk = (XEVPPKEY(pkey))->evp_pkey;
2039 if (!(ossl_pkey_has_public_data(pk)))
2040 error ("key must have public data");
2042 pkout = EVP_PKEY_new();
2043 if (rsa_pkey_p(pk)) {
2044 #ifndef OPENSSL_NO_RSA
2045 EVP_PKEY_assign_RSA(pkout, RSAPublicKey_dup((pk->pkey).rsa));
2047 } else if (dsa_pkey_p(pk)) {
2048 #ifndef OPENSSL_NO_DSA
2049 EVP_PKEY_assign_DSA(pkout, dsa_get_public(pk));
2051 } else if (ec_pkey_p(pk)) {
2052 #ifndef OPENSSL_NO_EC
2053 EVP_PKEY_assign_EC_KEY(pkout, ec_get_public(pk));
2056 error ("no method to strip private data yet");
2058 return make_evp_pkey_pk(pkout);
2063 rsa_pkey_p(EVP_PKEY *pkey)
2067 type = EVP_PKEY_type(pkey->type);
2069 #ifndef OPENSSL_NO_RSA
2070 return ((type == EVP_PKEY_RSA) ||
2071 (type == EVP_PKEY_RSA2));
2076 #ifndef OPENSSL_NO_RSA
2078 rsa_pkey_has_public_data(RSA *rsakey)
2080 return (!(rsakey->n == NULL) &&
2081 !(rsakey->e == NULL));
2084 rsa_pkey_has_private_data(RSA *rsakey)
2086 return (rsa_pkey_has_public_data(rsakey) &&
2087 !(rsakey->d == NULL));
2090 DEFUN("ossl-rsa-generate-key", Fossl_rsa_generate_key, 2, 2, 0, /*
2091 Return an RSA public key with of length BITS and exponent EXPO.
2103 error ("modulus size must be a non-zero positive integer");
2104 if (!(XINT(expo) % 2))
2105 error ("exponent must be an odd positive integer");
2107 pkey = EVP_PKEY_new();
2108 rsakey = RSA_generate_key(XINT(bits), XINT(expo), NULL, NULL);
2109 EVP_PKEY_assign_RSA(pkey, rsakey);
2111 return make_evp_pkey_pk(pkey);
2114 DEFUN("ossl-rsa-pkey-p", Fossl_rsa_pkey_p, 1, 1, 0, /*
2115 Return t iff PKEY is of RSA type.
2121 if (!EVPPKEYP(pkey))
2124 pk = (XEVPPKEY(pkey))->evp_pkey;
2132 DEFUN("ossl-rsa-subkey-p", Fossl_rsa_subkey_p, 2, 2, 0, /*
2133 Return t iff PKEY1 is a subkey of PKEY2.
2134 I.e. if PKEY1 has the same public key data as PKEY2 and
2135 PKEY2 has all private data.
2137 This function is not native OpenSSL.
2146 CHECK_EVPPKEY(pkey1);
2147 CHECK_EVPPKEY(pkey2);
2149 pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2150 pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2152 /* perform a type check first */
2153 if (!rsa_pkey_p(pk1))
2154 error ("pkey1 must be of RSA type");
2155 if (!rsa_pkey_p(pk2))
2156 error ("pkey2 must be of RSA type");
2158 rk1 = (pk1->pkey).rsa;
2159 rk2 = (pk2->pkey).rsa;
2161 if (rsa_pkey_has_private_data(rk2) &&
2162 rsa_pkey_has_public_data(rk1) &&
2163 (!BN_cmp(rk1->n, rk2->n)) &&
2164 (!BN_cmp(rk1->e, rk2->e)))
2169 #endif /* OPENSSL_NO_RSA */
2174 dsa_pkey_p(EVP_PKEY *pkey)
2178 type = EVP_PKEY_type(pkey->type);
2180 #ifndef OPENSSL_NO_DSA
2181 return ((type == EVP_PKEY_DSA) ||
2182 (type == EVP_PKEY_DSA1) ||
2183 (type == EVP_PKEY_DSA2) ||
2184 (type == EVP_PKEY_DSA3) ||
2185 (type == EVP_PKEY_DSA4));
2190 #ifndef OPENSSL_NO_DSA
2192 dsa_pkey_has_public_data(DSA *dsakey)
2194 return (!(dsakey->p == NULL) &&
2195 !(dsakey->q == NULL) &&
2196 !(dsakey->g == NULL) &&
2197 !(dsakey->pub_key == NULL));
2200 dsa_pkey_has_private_data(DSA *dsakey)
2202 return (dsa_pkey_has_public_data(dsakey) &&
2203 !(dsakey->priv_key == NULL));
2206 DEFUN("ossl-dsa-generate-key", Fossl_dsa_generate_key, 1, 2, 0, /*
2207 Return a DSA public key with of length BITS seeded with (optional) SEED.
2216 unsigned_long h_ret;
2223 error ("prime number size must be a non-zero positive integer");
2230 TO_EXTERNAL_FORMAT (LISP_STRING, seed,
2231 C_STRING_ALLOCA, seed_ext, OSSL_CODING);
2232 seed_len = OSSL_STRING_LENGTH(seed);
2235 pkey = EVP_PKEY_new();
2236 dsakey = DSA_generate_parameters(XINT(bits),
2237 (unsigned char*)seed_ext, seed_len,
2238 &counter_ret, &h_ret,
2240 if (!DSA_generate_key(dsakey))
2241 error ("error during generation of DSA key");
2243 EVP_PKEY_assign_DSA(pkey, dsakey);
2245 return make_evp_pkey_pk(pkey);
2248 DEFUN("ossl-dsa-pkey-p", Fossl_dsa_pkey_p, 1, 1, 0, /*
2249 Return t iff PKEY is of DSA type.
2255 if (!EVPPKEYP(pkey))
2258 pk = (XEVPPKEY(pkey))->evp_pkey;
2266 dsa_get_public(EVP_PKEY *pk)
2271 memcpy(key, (pk->pkey).dsa, sizeof(DSA));
2273 /* now kill the private data */
2274 key->priv_key = NULL;
2279 DEFUN("ossl-dsa-subkey-p", Fossl_dsa_subkey_p, 2, 2, 0, /*
2280 Return t iff PKEY1 is a subkey of PKEY2.
2281 I.e. if PKEY1 has the same public key data as PKEY2 and
2282 PKEY2 has all private data.
2284 This function is not native OpenSSL.
2293 CHECK_EVPPKEY(pkey1);
2294 CHECK_EVPPKEY(pkey2);
2296 pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2297 pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2299 /* perform a type check first */
2300 if (!dsa_pkey_p(pk1))
2301 error ("pkey1 must be of DSA type");
2302 if (!dsa_pkey_p(pk2))
2303 error ("pkey2 must be of DSA type");
2305 dk1 = (pk1->pkey).dsa;
2306 dk2 = (pk2->pkey).dsa;
2308 if (dsa_pkey_has_private_data(dk2) &&
2309 dsa_pkey_has_public_data(dk1) &&
2310 (!BN_cmp(dk1->p, dk2->p)) &&
2311 (!BN_cmp(dk1->q, dk2->q)) &&
2312 (!BN_cmp(dk1->g, dk2->g)) &&
2313 (!BN_cmp(dk1->pub_key, dk2->pub_key)))
2318 #endif /* OPENSSL_NO_DSA */
2323 ec_pkey_p(EVP_PKEY *pkey)
2327 type = EVP_PKEY_type(pkey->type);
2329 #ifndef OPENSSL_NO_EC
2330 return (type == EVP_PKEY_EC);
2335 #ifndef OPENSSL_NO_EC
2337 ec_pkey_has_public_data(EC_KEY *ec_key)
2339 return (!(EC_KEY_get0_group(ec_key) == NULL) &&
2340 !(EC_KEY_get0_public_key(ec_key) == NULL));
2343 ec_pkey_has_private_data(EC_KEY *ec_key)
2345 return (ec_pkey_has_public_data(ec_key) &&
2346 !(EC_KEY_get0_private_key(ec_key) == NULL));
2349 DEFUN("ossl-ec-available-curves", Fossl_ec_available_curves, 0, 0, 0, /*
2350 Return a list of builtin elliptic curves.
2354 EC_builtin_curve *curves = NULL;
2355 size_t crv_len = 0, n = 0;
2356 Lisp_Object lcurves;
2360 crv_len = EC_get_builtin_curves(NULL, 0);
2361 curves = OPENSSL_malloc(sizeof(EC_builtin_curve) * crv_len);
2364 error ("no curves defined");
2366 if (!EC_get_builtin_curves(curves, crv_len)) {
2367 OPENSSL_free(curves);
2368 error ("error during initialisation of curves");
2371 for (n = 0; n < crv_len; n++) {
2372 int nid = curves[n].nid;
2373 lcurves = Fcons(intern(OBJ_nid2sn(nid)), lcurves);
2376 OPENSSL_free(curves);
2382 ec_curve_by_name(char *name)
2384 return OBJ_sn2nid(name);
2387 DEFUN("ossl-ec-generate-key", Fossl_ec_generate_key, 1, 1, 0, /*
2388 Return a EC public key on CURVE.
2389 CURVE may be any symbol from `ossl-ec-available-curves'.
2391 At the moment we do not support creating custom curves.
2398 CHECK_SYMBOL(curve);
2400 pkey = EVP_PKEY_new();
2401 eckey = EC_KEY_new_by_curve_name(
2402 ec_curve_by_name((char *)string_data(XSYMBOL(curve)->name)));
2404 if (eckey == NULL) {
2405 error ("no such curve");
2408 if (!EC_KEY_generate_key(eckey))
2409 error ("error during generation of EC key");
2411 EVP_PKEY_assign_EC_KEY(pkey, eckey);
2413 return make_evp_pkey_pk(pkey);
2416 DEFUN("ossl-ec-pkey-p", Fossl_ec_pkey_p, 1, 1, 0, /*
2417 Return t iff PKEY is of EC type.
2424 if (!EVPPKEYP(pkey))
2427 pk = (XEVPPKEY(pkey))->evp_pkey;
2428 type = EVP_PKEY_type(pk->type);
2429 if (type == EVP_PKEY_EC)
2436 ec_get_public(EVP_PKEY *pk)
2440 key = EC_KEY_dup((pk->pkey).ec);
2442 /* now kill the private data */
2443 EC_KEY_set_private_key(key, NULL);
2447 #endif /* OPENSSL_NO_EC */
2452 dh_pkey_p(EVP_PKEY *pkey)
2456 type = EVP_PKEY_type(pkey->type);
2458 #ifndef OPENSSL_NO_DH
2459 return (type == EVP_PKEY_DH);
2464 #ifndef OPENSSL_NO_DH
2466 dh_pkey_has_public_data(DH *dhkey)
2468 return (!(dhkey->p == NULL) &&
2469 !(dhkey->g == NULL) &&
2470 !(dhkey->pub_key == NULL));
2473 dh_pkey_has_private_data(DH *dhkey)
2475 return (dh_pkey_has_public_data(dhkey) &&
2476 !(dhkey->priv_key == NULL));
2479 DEFUN("ossl-dh-pkey-p", Fossl_dh_pkey_p, 1, 1, 0, /*
2480 Return t iff PKEY is of DH type.
2486 if (!EVPPKEYP(pkey))
2489 pk = (XEVPPKEY(pkey))->evp_pkey;
2497 #endif /* OPENSSL_NO_DH */
2500 /* more general access functions */
2501 DEFUN("ossl-seal", Fossl_seal, 3, 3, 0, /*
2502 Return an envelope derived from encrypting STRING by CIPHER under PKEY
2503 with the hybrid technique.
2505 That is, create a random key/iv pair for the symmetric encryption with
2506 CIPHER and encrypt that key/iv asymmetrically with the provided public
2509 The envelope returned is a list
2510 \(encrypted_string encrypted_key encrypted_iv\)
2512 `encrypted_string' is the (symmetrically) encrypted message
2513 `encrypted_key' is the (asymmetrically) encrypted random key
2514 `encrypted_iv' is the (asymmetrically) encrypted random iv
2516 Note: You probably want to put a wrapping encoder function
2517 (like `base16-encode-string') around it, since this function
2518 returns binary string data.
2520 (cipher, string, pkey))
2522 /* declarations for the cipher */
2523 const EVP_CIPHER *ciph;
2524 EVP_CIPHER_CTX ciphctx;
2525 /* declarations for the pkey */
2528 unsigned char *ekey;
2531 /* buffer for the generated IV */
2532 char iv[EVP_MAX_IV_LENGTH];
2534 /* buffer for output */
2535 unsigned char *outbuf;
2536 unsigned int outlen;
2537 Lisp_Object l_outbuf;
2538 /* buffer for external string data */
2545 CHECK_SYMBOL(cipher);
2546 CHECK_STRING(string);
2547 CHECK_EVPPKEY(pkey);
2550 pk[0] = (XEVPPKEY(pkey))->evp_pkey;
2551 if (!ossl_pkey_has_public_data(pk[0])) {
2552 error ("cannot seal, key has no public key data");
2556 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2557 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2558 string_len = OSSL_STRING_LENGTH(string);
2560 OpenSSL_add_all_algorithms();
2561 ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2565 error ("no such cipher");
2569 /* alloc ekey buffer */
2570 ekey = (unsigned char*)xmalloc_atomic(EVP_PKEY_size(pk[0]));
2572 /* now allocate some output buffer externally
2573 * this one has to be at least EVP_CIPHER_block_size bigger
2574 * since block algorithms merely operate blockwise
2576 outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string) +
2577 EVP_CIPHER_block_size(ciph));
2579 EVP_CIPHER_CTX_init(&ciphctx);
2580 if (!(EVP_SealInit(&ciphctx, ciph,
2582 (unsigned char *)&iv,
2583 (EVP_PKEY **)&pk, npubk)==npubk)) {
2587 error ("error in SealInit");
2590 if (!EVP_SealUpdate(&ciphctx, outbuf, (int *)&outlen,
2591 (unsigned char*)string_ext, string_len)) {
2595 error ("error in SealUpdate");
2598 if (!EVP_SealFinal(&ciphctx, (unsigned char*)outbuf+outlen, &tmplen)) {
2602 error ("error in SealFinal");
2605 /* added probable padding space to the length of the output buffer */
2607 EVP_CIPHER_CTX_cleanup(&ciphctx);
2609 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2610 l_ekey = make_ext_string((char *)ekey, ekey_len, OSSL_CODING);
2611 l_iv = make_ext_string(iv,EVP_CIPHER_iv_length(ciph), OSSL_CODING);
2616 return list3(l_outbuf, l_ekey, l_iv);
2620 DEFUN("ossl-open", Fossl_open, 4, 5, 0, /*
2621 Return the deciphered message STRING from an envelope
2622 obtained by `ossl-seal'.
2624 CIPHER is the cipher to use (the same as in `ossl-seal')
2625 STRING is the encrypted message
2626 PKEY is the private key
2627 EKEY is the encrypted random key
2628 EIV is the encrypted iv
2630 (cipher, string, pkey, ekey, eiv))
2632 /* declarations for the cipher */
2633 const EVP_CIPHER *ciph;
2634 EVP_CIPHER_CTX ciphctx;
2635 /* declarations for the pkey */
2637 /* buffer for external ekey data */
2640 /* buffer for external eiv data */
2642 /* buffer for output */
2643 unsigned char *outbuf;
2644 unsigned int outlen;
2645 Lisp_Object l_outbuf;
2646 /* buffer for external string data */
2653 CHECK_SYMBOL(cipher);
2654 CHECK_STRING(string);
2655 CHECK_EVPPKEY(pkey);
2659 pk = (XEVPPKEY(pkey))->evp_pkey;
2660 if (!ossl_pkey_has_private_data(pk))
2661 error ("cannot open, key has no private key data");
2663 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2664 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2665 string_len = OSSL_STRING_LENGTH(string);
2666 TO_EXTERNAL_FORMAT (LISP_STRING, ekey,
2667 C_STRING_ALLOCA, ekey_ext, OSSL_CODING);
2668 ekey_len = OSSL_STRING_LENGTH(ekey);
2670 OpenSSL_add_all_algorithms();
2671 ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2675 error ("no such cipher");
2683 TO_EXTERNAL_FORMAT (LISP_STRING, eiv,
2684 C_STRING_ALLOCA, eiv_ext, OSSL_CODING);
2687 /* now allocate some output buffer externally */
2688 outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string));
2690 EVP_CIPHER_CTX_init(&ciphctx);
2691 if (!EVP_OpenInit(&ciphctx, ciph,
2692 (unsigned char*)ekey_ext,
2693 (unsigned int)ekey_len,
2694 (unsigned char*)eiv_ext, pk)) {
2697 error ("error in OpenInit");
2700 if (!EVP_OpenUpdate(&ciphctx, outbuf, (int *)&outlen,
2701 (unsigned char*)string_ext,
2702 (unsigned int)string_len)) {
2705 error ("error in OpenUpdate");
2708 if (!EVP_OpenFinal(&ciphctx, outbuf+outlen, &tmplen)) {
2711 error ("error in OpenFinal");
2714 /* added probable padding space to the length of the output buffer */
2716 EVP_CIPHER_CTX_cleanup(&ciphctx);
2718 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2727 DEFUN("ossl-sign", Fossl_sign, 3, 3, 0, /*
2728 Return a signature obtained by signing STRING under DIGEST with PKEY.
2730 That is, hash the message STRING with the message digest DIGEST and
2731 encrypt the result with the private key PKEY.
2733 Note: Due to some relationship between the public key system and the
2734 message digest you cannot use every digest algorithm with every
2736 The most certain results will be achieved using
2737 RSA keys with RSA-* digests, DSA keys with DSA-* digests.
2739 See `ossl-available-digests'.
2741 Note: You probably want to put a wrapping encoder function
2742 (like `base16-encode-string') around it, since this returns
2745 (digest, string, pkey))
2747 /* declarations for the cipher */
2750 /* declarations for the pkey */
2752 /* buffer for output */
2753 unsigned char *outbuf;
2754 unsigned int outlen;
2755 Lisp_Object l_outbuf;
2756 /* buffer for external string data */
2761 CHECK_SYMBOL(digest);
2762 CHECK_STRING(string);
2763 CHECK_EVPPKEY(pkey);
2766 pk = (XEVPPKEY(pkey))->evp_pkey;
2767 if (!ossl_pkey_has_private_data(pk)) {
2768 error ("cannot sign, key has no private key data");
2771 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2772 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2773 string_len = OSSL_STRING_LENGTH(string);
2775 OpenSSL_add_all_algorithms();
2776 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2780 error ("no such digest");
2784 /* now allocate some output buffer externally */
2785 outbuf = (unsigned char *)xmalloc_atomic(EVP_PKEY_size(pk));
2787 EVP_MD_CTX_init(&mdctx);
2788 if (!(EVP_SignInit(&mdctx, md))) {
2791 error ("error in SignInit");
2794 if (!EVP_SignUpdate(&mdctx, string_ext, string_len)) {
2797 error ("error in SignUpdate");
2800 if (!EVP_SignFinal(&mdctx, outbuf, &outlen, pk)) {
2803 error ("error in SignFinal");
2806 EVP_MD_CTX_cleanup(&mdctx);
2808 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2816 DEFUN("ossl-verify", Fossl_verify, 4, 4, 0, /*
2817 Return t iff SIG is a valid signature of STRING under DIGEST obtained by PKEY.
2819 That is, hash the message STRING with the message digest DIGEST, then
2820 decrypt the signature SIG with the public key PKEY.
2821 Compare the results and return t iff both hashes are equal.
2823 DIGEST is the digest to use (the same as in `ossl-sign')
2824 STRING is the message
2825 SIG is the signature of message
2826 PKEY is the public key
2828 (digest, string, sig, pkey))
2830 /* declarations for the cipher */
2833 /* declarations for the pkey */
2835 /* buffer for external signature data */
2838 /* buffer for external string data */
2845 CHECK_SYMBOL(digest);
2846 CHECK_STRING(string);
2848 CHECK_EVPPKEY(pkey);
2851 pk = (XEVPPKEY(pkey))->evp_pkey;
2852 if (!ossl_pkey_has_public_data(pk))
2853 error ("cannot verify, key has no public key data");
2855 OpenSSL_add_all_algorithms();
2856 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2860 error ("no such digest");
2864 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2865 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2866 string_len = OSSL_STRING_LENGTH(string);
2867 TO_EXTERNAL_FORMAT (LISP_STRING, sig,
2868 C_STRING_ALLOCA, sig_ext, OSSL_CODING);
2869 sig_len = OSSL_STRING_LENGTH(sig);
2871 EVP_MD_CTX_init(&mdctx);
2872 if (!EVP_VerifyInit(&mdctx, md)) {
2874 error ("error in VerifyInit");
2877 if (!EVP_VerifyUpdate(&mdctx, string_ext, string_len)) {
2879 error ("error in VerifyUpdate");
2882 result = EVP_VerifyFinal(&mdctx, (unsigned char*)sig_ext, sig_len, pk);
2885 error ("error in VerifyFinal");
2888 EVP_MD_CTX_cleanup(&mdctx);
2892 return result ? Qt : Qnil;
2901 DEFUN("ossl-pem-read-public-key", Fossl_pem_read_public_key, 1, 1, 0, /*
2902 Return a key (the public part) stored in a PEM structure from FILE.
2906 /* declarations for the pkey */
2915 file = Fexpand_file_name(file, Qnil);
2917 if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2918 error ("error opening file.");
2920 pk509 = PEM_read_X509(fp, NULL, NULL, NULL);
2921 pk = PEM_read_PUBKEY(fp, NULL, NULL, NULL);
2925 return make_evp_pkey(pk, pk509);
2928 DEFUN("ossl-pem-read-key", Fossl_pem_read_key, 1, 2, 0, /*
2929 Return a key stored in a PEM structure from FILE.
2930 If the (private part of the) key is protected with a password
2931 provide (optional) PASSWORD.
2935 /* declarations for the pkey */
2939 /* password pointer */
2944 file = Fexpand_file_name(file, Qnil);
2946 if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2947 error ("error opening file.");
2949 if (NILP(password)) {
2952 CHECK_STRING(password);
2953 pass = (char *)XSTRING_DATA(password);
2956 pk = PEM_read_PrivateKey(fp, NULL, NULL, pass);
2959 /* now maybe it is a public key only */
2960 return Fossl_pem_read_public_key(file);
2963 return make_evp_pkey_pk(pk);
2966 DEFUN("ossl-pem-write-public-key", Fossl_pem_write_public_key, 2, 2, 0, /*
2967 Write PKEY (the public part) in a PEM structure to FILE.
2971 /* declarations for the pkey */
2978 CHECK_EVPPKEY(pkey);
2980 file = Fexpand_file_name(file, Qnil);
2982 pk = XEVPPKEY(pkey)->evp_pkey;
2983 pk509 = XEVPPKEY(pkey)->x509;
2984 SXE_SET_UNUSED(pk509);
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;
3024 SXE_SET_UNUSED(pk509);
3026 if (!ossl_pkey_has_private_data(pk))
3027 return Fossl_pem_write_public_key(file, pkey);
3029 CHECK_SYMBOL(cipher);
3031 OpenSSL_add_all_algorithms();
3037 ciph = EVP_get_cipherbyname(
3038 (char *)string_data(XSYMBOL(cipher)->name));
3041 error ("no such cipher");
3045 if (NILP(password)) {
3049 CHECK_STRING(password);
3050 pass = (char *)XSTRING_DATA(password);
3053 if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL) {
3055 error ("error opening file.");
3058 if (!PEM_write_PKCS8PrivateKey(fp, pk, ciph, NULL, 0, NULL, pass)) {
3061 error ("error writing PEM file.");
3071 ossl_pem_pkey_cb(BIO *bio, int cmd, const char *argp,
3072 int argi, long argl, long ret)
3075 void *foo = BIO_get_callback_arg(bio);
3077 if (!(key = (Lisp_Object)foo)) {
3081 if (BIO_CB_RETURN & cmd) {
3087 key = concat2(key, make_ext_string(argp, argi, OSSL_CODING));
3088 BIO_set_callback_arg(bio, (void*)key);
3096 DEFUN("ossl-pem-public-key",Fossl_pem_public_key, 1, 1, 0, /*
3097 Return PKEY as PEM encoded string.
3101 /* This function can GC */
3102 /* declarations for the pkey */
3108 struct gcpro gcpro1;
3112 CHECK_EVPPKEY(pkey);
3114 pk = (XEVPPKEY(pkey))->evp_pkey;
3116 if (!(b = BIO_new(BIO_s_null()))) {
3118 error("cannot open memory buffer");
3122 result = build_string("");
3123 BIO_set_callback(b, ossl_pem_pkey_cb);
3124 BIO_set_callback_arg(b, (void*)result);
3126 if (!PEM_write_bio_PUBKEY(b, pk)) {
3130 error ("error creating PEM string");
3135 void *foo = BIO_get_callback_arg(b);
3136 if (!(result = (Lisp_Object)foo)) {
3147 DEFUN("ossl-pem-key",Fossl_pem_key, 1, 3, 0, /*
3148 Return PKEY as PEM encoded string. The key itself is
3149 protected by (optional) CIPHER with PASSWORD.
3151 CIPHER can be set to nil and the key will not be encrypted.
3152 PASSWORD is ignored in this case.
3154 (pkey, cipher, password))
3156 /* This function can GC */
3157 /* declarations for the pkey */
3160 const EVP_CIPHER *ciph;
3164 struct gcpro gcpro1, gcpro2, gcpro3;
3166 GCPRO3(pkey, cipher, password);
3168 CHECK_EVPPKEY(pkey);
3170 pk = (XEVPPKEY(pkey))->evp_pkey;
3172 if (!ossl_pkey_has_private_data(pk)) {
3174 return Fossl_pem_public_key(pkey);
3177 CHECK_SYMBOL(cipher);
3179 OpenSSL_add_all_algorithms();
3185 ciph = EVP_get_cipherbyname(
3186 (char *)string_data(XSYMBOL(cipher)->name));
3190 error ("no such cipher");
3195 if (NILP(password)) {
3199 CHECK_STRING(password);
3200 pass = (char *)XSTRING_DATA(password);
3203 if (!(b = BIO_new(BIO_s_null()))) {
3205 error("cannot open memory buffer");
3209 result = build_string("");
3210 BIO_set_callback(b, ossl_pem_pkey_cb);
3211 BIO_set_callback_arg(b, (void*)result);
3213 if (!PEM_write_bio_PKCS8PrivateKey(b, pk, ciph, NULL, 0, NULL, pass)) {
3217 error ("error creating PEM string");
3222 void *foo = BIO_get_callback_arg(b);
3224 if (!(result = (Lisp_Object)foo)) {
3239 * The SSL support in this API is sorta high level since having
3240 * server hellos, handshakes and stuff like that is not what you want
3244 /* This is an opaque object for storing PKEYs in lisp */
3245 Lisp_Object Qssl_connp;
3248 make_ssl_conn(Lisp_SSL_CONN *ssl_conn)
3250 Lisp_Object lisp_ssl_conn;
3251 XSETSSLCONN(lisp_ssl_conn, ssl_conn);
3252 return lisp_ssl_conn;
3256 mark_ssl_conn(Lisp_Object obj)
3258 mark_object(XSSLCONN(obj)->parent);
3259 mark_object(XSSLCONN(obj)->pipe_instream);
3260 mark_object(XSSLCONN(obj)->pipe_outstream);
3262 mark_object(XSSLCONN(obj)->coding_instream);
3263 mark_object(XSSLCONN(obj)->coding_outstream);
3270 print_ssl_conn(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3275 conn = XSSLCONN(obj)->ssl_conn;
3276 parent = XSSLCONN(obj)->parent;
3278 write_c_string("#<OpenSSL socket layer: ", printcharfun);
3280 write_c_string("dead", printcharfun);
3282 write_c_string(SSL_get_version(conn), printcharfun);
3285 if (PROCESSP(parent)) {
3286 write_c_string(" on top of ", printcharfun);
3287 print_internal(parent, printcharfun, escapeflag);
3289 #endif /* HAVE_SOCKETS */
3291 #ifdef HAVE_POSTGRESQL
3292 if (PGCONNP(parent) &&
3293 PQstatus(XPGCONN(parent)->pgconn) == CONNECTION_OK) {
3294 write_c_string(" on top of ", printcharfun);
3295 print_internal(parent, printcharfun, escapeflag);
3297 #endif /* HAVE_POSTGRESQL */
3298 write_c_string(">", printcharfun);
3302 allocate_ssl_conn(void)
3304 Lisp_SSL_CONN *ssl_conn =
3305 alloc_lcrecord_type(Lisp_SSL_CONN, &lrecord_ssl_conn);
3307 /* the network process stuff */
3308 ssl_conn->parent = Qnil;
3309 ssl_conn->infd = -1;
3310 ssl_conn->outfd = -1;
3312 ssl_conn->connected_p = 0;
3313 ssl_conn->protected_p = 0;
3315 ssl_conn->pipe_instream = Qnil;
3316 ssl_conn->pipe_outstream = Qnil;
3318 ssl_conn->coding_instream = Qnil;
3319 ssl_conn->coding_outstream = Qnil;
3326 finalise_ssl_conn(void *header, int for_disksave)
3328 Lisp_SSL_CONN *ssl_conn = (Lisp_SSL_CONN *) header;
3330 if (!(ssl_conn->ssl_conn == NULL)) {
3331 if (ssl_conn->connected_p)
3332 SSL_shutdown(ssl_conn->ssl_conn);
3333 SSL_free(ssl_conn->ssl_conn);
3334 ssl_conn->ssl_conn = NULL;
3336 if (!(ssl_conn->ssl_ctx == NULL)) {
3337 SSL_CTX_free(ssl_conn->ssl_ctx);
3338 ssl_conn->ssl_ctx = NULL;
3340 ssl_conn->ssl_bio = NULL;
3342 if (PROCESSP(ssl_conn->parent)) {
3343 XPROCESS(ssl_conn->parent)->process_type = PROCESS_TYPE_NETWORK;
3344 XPROCESS(ssl_conn->parent)->process_type_data = Qnil;
3346 /* we leave the process alive, it's not our fault, but
3347 * we nullify its pointer
3349 ssl_conn->parent = Qnil;
3350 ssl_conn->infd = -1;
3351 ssl_conn->outfd = -1;
3353 ssl_conn->connected_p = 0;
3354 ssl_conn->protected_p = 0;
3356 /* free the lstream resources */
3357 #if 0 /* will lead to problems */
3358 if (LSTREAMP(ssl_conn->pipe_instream))
3359 Lstream_delete(XLSTREAM(ssl_conn->pipe_instream));
3360 if (LSTREAMP(ssl_conn->pipe_outstream))
3361 Lstream_delete(XLSTREAM(ssl_conn->pipe_outstream));
3363 ssl_conn->pipe_instream = Qnil;
3364 ssl_conn->pipe_outstream = Qnil;
3366 #if 0 /* will lead to problems */
3367 if (LSTREAMP(ssl_conn->coding_instream))
3368 Lstream_delete(XLSTREAM(ssl_conn->coding_instream));
3369 if (LSTREAMP(ssl_conn->coding_outstream))
3370 Lstream_delete(XLSTREAM(ssl_conn->coding_outstream));
3372 ssl_conn->coding_instream = Qnil;
3373 ssl_conn->coding_outstream = Qnil;
3376 /* avoid some warning */
3380 DEFINE_LRECORD_IMPLEMENTATION("ssl_conn", ssl_conn,
3381 mark_ssl_conn, print_ssl_conn,
3383 NULL, NULL, 0, Lisp_SSL_CONN);
3386 ssl_conn_alive_p(Lisp_SSL_CONN *ssl_conn)
3388 return ssl_conn->connected_p;
3392 get_process_infd(Lisp_Process * p)
3394 Lisp_Object instr, outstr;
3395 get_process_streams(p, &instr, &outstr);
3396 return Lstream_get_fd(XLSTREAM(instr));
3399 get_process_outfd(Lisp_Process * p)
3401 Lisp_Object instr, outstr;
3402 get_process_streams(p, &instr, &outstr);
3403 return Lstream_get_fd(XLSTREAM(outstr));
3407 event_stream_ssl_create_stream_pair(
3409 Lisp_Object *instream, Lisp_Object *outstream, int flags)
3411 *instream = make_ssl_input_stream(conn, flags);
3412 *outstream = make_ssl_output_stream(conn, flags);
3418 init_ssl_io_handles(Lisp_SSL_CONN *s, int flags)
3420 event_stream_ssl_create_stream_pair(
3421 s->ssl_conn, &s->pipe_instream, &s->pipe_outstream, flags);
3424 s->coding_instream = make_decoding_input_stream(
3425 XLSTREAM(s->pipe_instream), Fget_coding_system(
3426 Vcoding_system_for_read));
3427 Lstream_set_character_mode(XLSTREAM(s->coding_instream));
3428 s->coding_outstream = make_encoding_output_stream(
3429 XLSTREAM(s->pipe_outstream), Fget_coding_system(
3430 Vcoding_system_for_write));
3431 #endif /* FILE_CODING */
3434 /* Advanced step-by-step initialisation */
3435 #define OSSL_CHECK_PROCESS(process) \
3437 /* Make sure the process is really alive. */ \
3438 if (!EQ(XPROCESS(process)->status_symbol, Qrun)) \
3439 error("Network stream %s not alive", \
3440 XSTRING_DATA(XPROCESS(process)->name)); \
3441 /* Make sure the process is a network stream. */ \
3442 if (!network_connection_p(process)) \
3443 error("Process %s is not a network stream", \
3444 XSTRING_DATA(XPROCESS(process)->name)); \
3447 #ifdef OSSL_DEBUG_FLAG
3449 ossl_bio_dump_callback(BIO *bio, int cmd, const char *argp,
3450 int argi, long argl, long ret)
3454 out=(BIO *)BIO_get_callback_arg(bio);
3455 if (out == NULL) return(ret);
3457 if (cmd == (BIO_CB_READ|BIO_CB_RETURN))
3459 BIO_printf(out,"read from %p [%p] (%d bytes => %ld (0x%lX))\n",
3460 (void *)bio,argp,argi,ret,ret);
3461 BIO_dump(out,argp,(int)ret);
3464 else if (cmd == (BIO_CB_WRITE|BIO_CB_RETURN))
3466 BIO_printf(out,"write to %p [%p] (%d bytes => %ld (0x%lX))\n",
3467 (void *)bio,argp,argi,ret,ret);
3468 BIO_dump(out,argp,(int)ret);
3475 ossl_ssl_prepare_cmeth(Lisp_Object method)
3477 SSL_METHOD *meth = NULL;
3478 Lisp_SSL_CONN *lisp_ssl_conn;
3480 /* start preparing the conn object */
3482 SSL_load_error_strings();
3484 /* I would love to make 'meth' const SSL_METHOD* as well as the
3485 'ssl_meth' member of 'Lisp_SSL_CONN' unfortunately not all
3486 supported versions of OpenSSL then take const SSL_METHOD*
3487 as arguments, so turning off the cast qualifier warning and
3488 store non-const is a more reasonable solution.
3490 #pragma GCC diagnostic push
3491 #pragma GCC diagnostic ignored "-Wcast-qual"
3493 } else if (EQ(method, Qssl2)) {
3494 #if HAVE_SSLV2_CLIENT_METHOD
3495 meth = (SSL_METHOD *)SSLv2_client_method();
3497 error("sslv2 client method not supported");
3499 } else if (EQ(method, Qssl3)) {
3500 #if HAVE_SSLV3_CLIENT_METHOD
3501 meth = (SSL_METHOD *)SSLv3_client_method();
3503 error("sslv3 client method not supported");
3505 } else if (EQ(method, Qssl23)) {
3506 #if HAVE_SSLV23_CLIENT_METHOD
3507 meth = (SSL_METHOD *)SSLv23_client_method();
3509 error("sslv23 client method not supported");
3511 } else if (EQ(method, Qtls1)) {
3512 #if HAVE_TLSV1_CLIENT_METHOD
3513 meth = (SSL_METHOD *)TLSv1_client_method();
3515 error("tlsv1 client method not supported");
3518 #if HAVE_TLSV1_CLIENT_METHOD
3519 meth = (SSL_METHOD *)TLSv1_client_method();
3521 error("default tlsv1 client method not supported");
3524 #pragma GCC diagnostic pop
3526 error("OSSL: not enough random data");
3528 /* now allocate this stuff, pump it and return */
3529 lisp_ssl_conn = allocate_ssl_conn();
3530 lisp_ssl_conn->ssl_meth = meth;
3531 lisp_ssl_conn->ssl_ctx = NULL;
3532 lisp_ssl_conn->ssl_conn = NULL;
3533 lisp_ssl_conn->ssl_bio = NULL;
3535 return make_ssl_conn(lisp_ssl_conn);
3539 ossl_ssl_prepare_smeth(Lisp_Object method)
3541 SSL_METHOD *meth = NULL;
3542 Lisp_SSL_CONN *lisp_ssl_conn;
3544 /* start preparing the conn object */
3546 SSL_load_error_strings();
3548 /* I would love to make 'meth' const SSL_METHOD* as well as the
3549 'ssl_meth' member of 'Lisp_SSL_CONN' unfortunately not all
3550 supported versions of OpenSSL then take const SSL_METHOD*
3551 as arguments, so turning off the cast qualifier warning and
3552 store non-const is a more reasonable solution.
3554 #pragma GCC diagnostic push
3555 #pragma GCC diagnostic ignored "-Wcast-qual"
3557 } else if (EQ(method, Qssl2)) {
3558 #if HAVE_SSLV2_SERVER_METHOD
3559 meth = (SSL_METHOD *)SSLv2_server_method();
3561 error("sslv2 client method not supported");
3563 } else if (EQ(method, Qssl3)) {
3564 #if HAVE_SSLV3_SERVER_METHOD
3565 meth = (SSL_METHOD *)SSLv3_server_method();
3567 error("sslv3 client method not supported");
3569 } else if (EQ(method, Qssl23)) {
3570 #if HAVE_SSLV23_SERVER_METHOD
3571 meth = (SSL_METHOD *)SSLv23_server_method();
3573 error("sslv23 client method not supported");
3575 } else if (EQ(method, Qtls1)) {
3576 #if HAVE_TLSV1_SERVER_METHOD
3577 meth = (SSL_METHOD *)TLSv1_server_method();
3579 error("tlsv1 client method not supported");
3582 #if HAVE_SSLV23_SERVER_METHOD
3583 meth = (SSL_METHOD *)SSLv23_server_method();
3585 error("default sslv23 client method not supported");
3588 #pragma GCC diagnostic pop
3590 error("OSSL: not enough random data");
3592 /* now allocate this stuff, pump it and return */
3593 lisp_ssl_conn = allocate_ssl_conn();
3594 lisp_ssl_conn->ssl_meth = meth;
3595 lisp_ssl_conn->ssl_ctx = NULL;
3596 lisp_ssl_conn->ssl_conn = NULL;
3597 lisp_ssl_conn->ssl_bio = NULL;
3599 return make_ssl_conn(lisp_ssl_conn);
3603 ossl_ssl_prepare_ctx(Lisp_Object ssl_conn)
3605 /* SSL connection stuff */
3606 SSL_CTX *ctx = NULL;
3607 Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3609 ctx = SSL_CTX_new(lisp_ssl_conn->ssl_meth);
3611 error("OSSL: context initialisation failed");
3613 /* OpenSSL contains code to work-around lots of bugs and flaws in
3614 * various SSL-implementations. SSL_CTX_set_options() is used to enabled
3615 * those work-arounds. The man page for this option states that
3616 * SSL_OP_ALL enables all the work-arounds and that "It is usually safe
3617 * to use SSL_OP_ALL to enable the bug workaround options if
3618 * compatibility with somewhat broken implementations is desired."
3620 SSL_CTX_set_options(ctx, SSL_OP_ALL);
3622 lisp_ssl_conn->ssl_ctx = ctx;
3628 ossl_ssl_prepare(Lisp_Object ssl_conn, void(*fun)(SSL*))
3630 /* SSL connection stuff */
3633 #ifdef OSSL_DEBUG_FLAG
3634 BIO *bio_c_out = NULL;
3636 Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3638 /* now initialise a new connection context */
3639 conn = SSL_new(lisp_ssl_conn->ssl_ctx);
3640 if (conn == NULL || fun == NULL)
3641 error("OSSL: connection initialisation failed");
3643 /* always renegotiate */
3644 SSL_set_mode(conn, SSL_MODE_AUTO_RETRY);
3646 /* initialise the main connection BIO */
3647 bio = BIO_new(BIO_s_socket());
3649 #ifdef OSSL_DEBUG_FLAG
3650 /* this is a debug BIO which pukes tons of stuff to stderr */
3651 bio_c_out = BIO_new_fp(stderr, BIO_NOCLOSE);
3652 BIO_set_callback(bio, ossl_bio_dump_callback);
3653 BIO_set_callback_arg(bio, bio_c_out);
3656 /* connect SSL with the bio */
3657 SSL_set_bio(conn, bio, bio);
3658 /* turn into client or server */
3661 /* now allocate this stuff, pump it and return */
3662 lisp_ssl_conn->ssl_conn = conn;
3663 lisp_ssl_conn->ssl_bio = bio;
3665 /* create lstream handles */
3666 init_ssl_io_handles(lisp_ssl_conn, STREAM_NETWORK_CONNECTION);
3671 /* Injection of CA certificates */
3672 int ossl_ssl_inject_ca(Lisp_Object ssl_conn, Lisp_Object cacert)
3678 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3679 cert = XEVPPKEY(cacert)->evp_pkey;
3680 xc509 = XEVPPKEY(cacert)->x509;
3682 if (cert && !xc509) {
3684 X509_set_pubkey(xc509, cert);
3685 XEVPPKEY(cacert)->x509 = xc509;
3690 /* what about coding system issues? */
3691 if (!SSL_CTX_add_client_CA(ctx, xc509))
3697 int ossl_ssl_inject_ca_file(Lisp_Object ssl_conn, Lisp_Object cafile)
3701 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3703 /* what about coding system issues? */
3704 if (!SSL_CTX_load_verify_locations(
3705 ctx, (char*)XSTRING_DATA(cafile), NULL))
3711 int ossl_ssl_inject_ca_path(Lisp_Object ssl_conn, Lisp_Object capath)
3715 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3717 /* what about coding system issues? */
3718 if (!SSL_CTX_load_verify_locations(
3719 ctx, NULL, (char*)XSTRING_DATA(capath)))
3725 int ossl_ssl_inject_cert(Lisp_Object ssl_conn,
3726 Lisp_Object cert, Lisp_Object key)
3733 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3734 pkey = XEVPPKEY(key)->evp_pkey;
3735 xcert = XEVPPKEY(cert)->evp_pkey;
3736 xc509 = XEVPPKEY(cert)->x509;
3738 if (xcert && !xc509) {
3740 X509_set_pubkey(xc509, xcert);
3741 XEVPPKEY(cert)->x509 = xc509;
3746 if (SSL_CTX_use_certificate(ctx, xc509) <= 0)
3749 if (SSL_CTX_use_PrivateKey(ctx, pkey) <= 0)
3751 if (!SSL_CTX_check_private_key(ctx))
3757 int ossl_ssl_inject_cert_file(Lisp_Object ssl_conn,
3758 Lisp_Object cert, Lisp_Object key)
3762 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3764 if (SSL_CTX_use_certificate_file(
3765 ctx, (char*)XSTRING_DATA(cert), SSL_FILETYPE_PEM) <= 0)
3767 if (SSL_CTX_use_PrivateKey_file(
3768 ctx, (char*)XSTRING_DATA(key), SSL_FILETYPE_PEM) <= 0)
3770 if (!SSL_CTX_check_private_key(ctx))
3776 Lisp_Object ossl_ssl_handshake(Lisp_Object ssl_conn, Lisp_Object process)
3778 /* This function can GC */
3779 /* SSL connection stuff */
3782 #if 0 && defined(OSSL_DEBUG_FLAG)
3783 BIO *bio_c_out = NULL;
3785 int ret, err, infd, outfd;
3787 struct gcpro gcpro1, gcpro2;
3789 /* Make sure we have a process, the alive check should be done in the
3790 function calling this here */
3791 CHECK_PROCESS(process);
3793 GCPRO2(ssl_conn, process);
3795 /* set the alternate one */
3796 event_stream_unselect_process(XPROCESS(process));
3799 /* just announce that we are very binary */
3800 Fset_process_coding_system(process, Qbinary, Qbinary);
3803 /* initialise the process' buffer for type-specific data,
3804 * we will store process input there */
3805 XPROCESS(process)->process_type_data = Qnil;
3807 /* retrieve the sockets of the process */
3808 infd = get_process_infd(XPROCESS(process));
3809 outfd = get_process_outfd(XPROCESS(process));
3811 /* push data to ssl_conn */
3812 XSSLCONN(ssl_conn)->parent = process;
3813 XSSLCONN(ssl_conn)->infd = infd;
3814 XSSLCONN(ssl_conn)->outfd = outfd;
3816 /* frob vars from ssl_conn */
3817 conn = XSSLCONN(ssl_conn)->ssl_conn;
3818 bio = XSSLCONN(ssl_conn)->ssl_bio;
3820 /* initialise the main connection BIO */
3821 BIO_set_fd(bio, infd, 0);
3823 /* now perform the actual handshake
3824 * this is a loop because of the genuine openssl concept to not handle
3825 * non-blocking I/O correctly */
3829 ret = SSL_do_handshake(conn);
3830 err = SSL_get_error(conn, ret);
3832 /* perform select() with timeout
3833 * 1 second at the moment */
3837 if (err == SSL_ERROR_NONE) {
3839 } else if (err == SSL_ERROR_WANT_READ) {
3841 OSSL_DEBUG("WANT_READ\n");
3844 FD_SET(infd, &read_fds);
3846 /* wait for socket to be readable */
3847 if (!(ret = select(infd+1, &read_fds, 0, NULL, &to))) {
3849 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3850 error("timeout during handshake");
3853 } else if (err == SSL_ERROR_WANT_WRITE) {
3855 OSSL_DEBUG("WANT_WRITE\n");
3856 FD_ZERO(&write_fds);
3857 FD_SET(outfd, &write_fds);
3859 /* wait for socket to be writable */
3860 if (!(ret = select(infd+1, &write_fds, 0, NULL, &to))) {
3862 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3863 error("timeout during handshake");
3866 } else if (err == SSL_ERROR_SSL) {
3867 /* close down the process object */
3868 Fdelete_process(process);
3871 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3872 error("handshake failed");
3875 OSSL_CRITICAL("\nUnknown error: %d\n"
3877 "sxemacs-devel@sxemacs.org\n\n", err);
3880 /* we used to check whether the connection is
3881 still alive, but this was perhaps a bad idea */
3882 try = BIO_read(bio, buf, 2);
3884 (try < 0 && !BIO_should_retry(bio))) {
3885 /* Handle closed connection */
3886 XPROCESS(process)->exit_code = 256;
3887 XPROCESS(process)->status_symbol = Qexit;
3890 /* close down the process object */
3891 Fdelete_process(process);
3895 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3896 error("unknown handshake error");
3901 /* marry the socket layer now */
3902 ossl_ssl_proselytise_process(ssl_conn, process);
3904 /* declare the whole pig connected */
3905 XSSLCONN(ssl_conn)->connected_p = 1;
3907 event_stream_select_process(XPROCESS(process));
3913 DEFUN("ossl-ssl-inject-cert", Fossl_ssl_inject_cert, 2, 3, 0, /*
3914 Add CERT as the local certificate of SSL-CONN.
3915 Optional argument KEY specifies a key file or evp-pkey, if
3916 CERT does not contain it.
3918 Both, CERT and KEY may be either a filename pointing to a
3919 PEM-encoded certificate and key respectively, or may be an
3922 (ssl_conn, cert, key))
3924 /* This function can GC */
3925 int (*fun)(Lisp_Object, Lisp_Object, Lisp_Object) = NULL;
3926 struct gcpro gcpro1, gcpro2, gcpro3;
3928 GCPRO3(ssl_conn, cert, key);
3930 CHECK_SSLCONN(ssl_conn);
3933 CHECK_EVPPKEY(cert);
3938 /* certificate and key preparation */
3939 if (STRINGP(cert)) {
3940 cert = Fexpand_file_name(cert, Qnil);
3941 if (NILP(Ffile_readable_p(cert)))
3946 key = Fexpand_file_name(key, Qnil);
3947 if (NILP(Ffile_readable_p(key)))
3951 if (STRINGP(cert) && NILP(key))
3953 else if (EVPPKEYP(cert) && NILP(key))
3956 /* certificate and key injection */
3957 if (!NILP(cert) && !NILP(key) &&
3958 STRINGP(cert) && STRINGP(key))
3959 fun = ossl_ssl_inject_cert_file;
3960 else if (!NILP(cert) && !NILP(key) &&
3961 EVPPKEYP(cert) && EVPPKEYP(key))
3962 fun = ossl_ssl_inject_cert;
3964 if (fun && fun(ssl_conn, cert, key)) {
3973 DEFUN("ossl-ssl-inject-ca", Fossl_ssl_inject_ca, 2, 2, 0, /*
3974 Add CA to the pile of certificate authorities of SSL-CONN.
3975 Also force a \(re\)verification of the remote peer certificate
3976 against CA. Return `t' if the injection was successful,
3979 CA may be either a file name pointing to a PEM-encoded
3980 CA certificate, or may be a directory containing a valid
3981 bunch of CA certificates according to OpenSSL's CA path
3982 layout, or may also be an evp-pkey object.
3986 /* This function can GC */
3987 int (*fun)(Lisp_Object, Lisp_Object) = NULL;
3989 struct gcpro gcpro1, gcpro2;
3991 GCPRO2(ssl_conn, ca);
3993 CHECK_SSLCONN(ssl_conn);
3999 ca = Fexpand_file_name(ca, Qnil);
4000 if (NILP(Ffile_readable_p(ca)))
4004 if (!NILP(ca) && STRINGP(ca)) {
4005 if (NILP(Ffile_directory_p(ca)))
4006 fun = ossl_ssl_inject_ca_file;
4008 fun = ossl_ssl_inject_ca_path;
4009 } else if (!NILP(ca) && EVPPKEYP(ca))
4010 fun = ossl_ssl_inject_ca;
4012 if (fun && fun(ssl_conn, ca) &&
4013 (conn = XSSLCONN(ssl_conn)->ssl_conn)) {
4014 #if HAVE_SSL_VERIFY_CERT_CHAIN
4015 ssl_verify_cert_chain(conn, SSL_get_peer_cert_chain(conn));
4017 error("SSL certificate chain verification not supported");
4027 DEFUN("ossl-ssl-handshake", Fossl_ssl_handshake, 1, 6, 0, /*
4028 Perform a handshake on the network connection PROCESS.
4030 Return a ssl-conn object, or `nil' if the handshake failed.
4031 In the latter case, most likely the remote site cannot handle
4032 the specified method, requires a client certificate, or cannot
4035 Optional argument METHOD indicates the SSL connection method,
4036 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
4038 Optional argument CA indicates a CA certificate.
4039 See `ossl-ssl-inject-ca'.
4041 Optional arguments CERT and KEY indicate a peer certificate
4042 and possibly a separate key file respectively.
4043 See `ossl-ssl-inject-peer-cert'.
4045 Optional argument SERVERP indicates whether to perform the
4046 handshake as a server if non-nil, and as a client otherwise.
4047 Note: In case of a handshake as server it is mandatory to provide
4048 a valid certificate and a corresponding key.
4050 (process, method, ca, cert, key, serverp))
4052 /* This function can GC */
4054 Lisp_Object ssl_conn, result;
4056 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
4058 GCPRO6(process, method, ca, cert, key, serverp);
4060 /* Make sure the process is really alive. */
4061 CHECK_PROCESS(process);
4062 OSSL_CHECK_PROCESS(process);
4064 /* create a ssl_conn object first */
4066 ssl_conn = ossl_ssl_prepare_cmeth(method);
4068 ssl_conn = ossl_ssl_prepare_smeth(method);
4070 /* create the context */
4071 ossl_ssl_prepare_ctx(ssl_conn);
4073 /* certificate and key preparation */
4074 Fossl_ssl_inject_cert(ssl_conn, cert, key);
4075 /* certificate authority preparation */
4076 Fossl_ssl_inject_ca(ssl_conn, ca);
4078 /* prepare for handshake */
4080 ossl_ssl_prepare(ssl_conn, SSL_set_connect_state);
4082 ossl_ssl_prepare(ssl_conn, SSL_set_accept_state);
4084 result = ossl_ssl_handshake(ssl_conn, process);
4090 DEFUN("ossl-ssl-connect", Fossl_ssl_connect, 0, MANY, 0, /*
4091 Perform a TLS or SSL handshake, return a ssl-conn object on
4092 success, or `nil' if the handshake failed.
4093 In the latter case, most likely the remote site cannot handle
4094 the specified method, requires a client certificate, or cannot
4105 Optional argument METHOD indicates the SSL connection method,
4106 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
4108 (int nargs, Lisp_Object *args))
4112 for (i = 0; i < nargs; i++);
4118 ossl_swap_process_streams(Lisp_SSL_CONN *s, Lisp_Process *p)
4120 Lisp_Object in, out;
4122 in = p->pipe_instream;
4123 out = p->pipe_outstream;
4125 p->pipe_instream = s->pipe_instream;
4126 p->pipe_outstream = s->pipe_outstream;
4128 s->pipe_instream = in;
4129 s->pipe_outstream = out;
4132 in = p->coding_instream;
4133 out = p->coding_outstream;
4135 p->coding_instream = s->coding_instream;
4136 p->coding_outstream = s->coding_outstream;
4138 s->coding_instream = in;
4139 s->coding_outstream = out;
4144 ossl_ssl_proselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4146 Lisp_Process *p = XPROCESS(process);
4147 Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4149 event_stream_unselect_process(p);
4151 /* put the streams we have in the ssl-conn object into the process
4152 object; actually these swap their places */
4153 if (p->process_type != PROCESS_TYPE_SSL)
4154 ossl_swap_process_streams(s, p);
4156 /* somehow we gotta link the network-process with the ss-layer
4157 * otherwise it'd be easy to open a network stream then
4158 * a ss-layer on top of it and then via `delete-process'
4159 * all the work is void while the ss-layer still exists
4161 p->process_type = PROCESS_TYPE_SSL;
4162 p->process_type_data = ssl_conn;
4164 event_stream_select_process(p);
4170 ossl_ssl_unproselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4172 Lisp_Process *p = XPROCESS(process);
4173 Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4175 /* put the streams we have in the ssl-conn object into the process
4176 object (they should be the former process streams) */
4177 if (p->process_type == PROCESS_TYPE_SSL)
4178 ossl_swap_process_streams(s, p);
4180 /* somehow we gotta link the network-process with the ss-layer
4181 * otherwise it'd be easy to open a network stream then
4182 * a ss-layer on top of it and then via `delete-process'
4183 * all the work is void while the ss-layer still exists
4185 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
4186 XPROCESS(process)->process_type_data = Qnil;
4191 DEFUN("ossl-ssl-proselytise-process", Fossl_ssl_proselytise_process,
4193 Convert the underlying process of SSL-CONN into a secure
4194 network connection object.
4198 Lisp_Object process;
4200 CHECK_SSLCONN(ssl_conn);
4202 process = XSSLCONN(ssl_conn)->parent;
4203 if (!PROCESSP(process)) {
4204 error("no process associated with this connection");
4208 /* Make sure the process is really alive. */
4209 OSSL_CHECK_PROCESS(process);
4211 ossl_ssl_proselytise_process(ssl_conn, process);
4216 DEFUN("ossl-ssl-unproselytise-process", Fossl_ssl_unproselytise_process,
4218 Convert the underlying process of SSL-CONN into an ordinary
4219 network connection object.
4223 Lisp_Object process;
4225 CHECK_SSLCONN(ssl_conn);
4227 process = XSSLCONN(ssl_conn)->parent;
4228 if (!PROCESSP(process)) {
4229 error("no process associated with this connection");
4233 /* Make sure the process is really alive. */
4234 OSSL_CHECK_PROCESS(process);
4236 /* Castrate the process and make it a network process again */
4237 ossl_ssl_unproselytise_process(ssl_conn, process);
4242 DEFUN("ossl-ssl-finish", Fossl_ssl_finish, 1, 1, 0, /*
4243 Finish an SSL connection SSL-CONN.
4245 Note: This may also finish the network connection.
4249 Lisp_Object process;
4251 CHECK_SSLCONN(ssl_conn);
4253 if (XSSLCONN(ssl_conn)->protected_p)
4254 error ("Cannot finish protected SSL connection");
4256 process = XSSLCONN(ssl_conn)->parent;
4257 if (PROCESSP(process))
4258 ossl_ssl_unproselytise_process(ssl_conn, process);
4260 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
4264 DEFUN("ossl-ssl-read", Fossl_ssl_read, 2, 2, 0, /*
4265 Return the cleartext of STRING which is assumed to be a complete
4266 block of data sent through SSL-CONN.
4270 /* network stream stuff */
4272 Lisp_Object process;
4274 Lisp_Object result = Qnil;
4276 CHECK_SSLCONN(ssl_conn);
4277 CHECK_STRING(string);
4279 if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4280 error("SSL connection dead");
4282 conn = XSSLCONN(ssl_conn)->ssl_conn;
4283 SXE_SET_UNUSED(conn);
4285 process = XSSLCONN(ssl_conn)->parent;
4287 /* Make sure the process is really alive. */
4288 OSSL_CHECK_PROCESS(process);
4293 DEFUN("ossl-ssl-write", Fossl_ssl_write, 2, 2, 0, /*
4294 Send STRING to the tunnel SSL-CONN.
4298 /* network stream stuff */
4300 Lisp_Object process, proc_filter;
4305 CHECK_SSLCONN(ssl_conn);
4306 CHECK_STRING(string);
4308 if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4309 error("SSL connection dead");
4311 conn = XSSLCONN(ssl_conn)->ssl_conn;
4312 process = XSSLCONN(ssl_conn)->parent;
4314 /* Make sure the process is really alive. */
4315 OSSL_CHECK_PROCESS(process);
4317 switch (XPROCESS(process)->process_type) {
4318 case PROCESS_TYPE_NETWORK:
4319 /* ssl streams reside in ssl-conn object atm */
4320 out = XLSTREAM(DATA_OUTSTREAM(XSSLCONN(ssl_conn)));
4322 case PROCESS_TYPE_SSL:
4323 /* ssl streams reside in process object, snarf from there */
4324 out = XLSTREAM(DATA_OUTSTREAM(XPROCESS(process)));
4328 error("unable to write");
4331 /* store the original process filter */
4332 proc_filter = XPROCESS(process)->filter;
4333 SXE_SET_UNUSED(proc_filter);
4335 ret = Lstream_write(out, XSTRING_DATA(string), XSTRING_LENGTH(string));
4338 switch (SSL_get_error(conn, ret)) {
4339 case SSL_ERROR_NONE:
4341 case SSL_ERROR_WANT_WRITE:
4342 error("Connection wants write");
4343 case SSL_ERROR_WANT_READ:
4344 error("Connection wants read");
4346 error("Severe SSL connection error");
4349 /* restore the original process filter */
4350 return (SSL_pending(conn) == 0) ? Qt : Qnil;
4353 /* convenience functions */
4354 DEFUN("ossl-ssl-parent", Fossl_ssl_parent, 1, 1, 0, /*
4355 Return the underlying parent layer of SSL-CONN.
4359 CHECK_SSLCONN(ssl_conn);
4361 return XSSLCONN(ssl_conn)->parent;
4364 DEFUN("ossl-ssl-cert", Fossl_ssl_cert, 1, 1, 0, /*
4365 Return the local peer's certificate of SSL-CONN if present,
4370 /* SSL connection stuff */
4374 CHECK_SSLCONN(ssl_conn);
4376 conn = XSSLCONN(ssl_conn)->ssl_conn;
4377 cert = SSL_get_certificate(conn);
4380 return make_evp_pkey_x509(cert);
4385 DEFUN("ossl-ssl-peer-cert", Fossl_ssl_peer_cert, 1, 1, 0, /*
4386 Return the remote peer's certificate of SSL-CONN if present,
4391 /* SSL connection stuff */
4395 CHECK_SSLCONN(ssl_conn);
4397 conn = XSSLCONN(ssl_conn)->ssl_conn;
4398 cert = SSL_get_peer_certificate(conn);
4401 return make_evp_pkey_x509(cert);
4406 DEFUN("ossl-ssl-peer-cert-chain", Fossl_ssl_peer_cert_chain, 1, 1, 0, /*
4407 Return the certificate chain of SSL-CONN as a list of
4413 /* SSL connection stuff */
4417 Lisp_Object result = Qnil;
4419 CHECK_SSLCONN(ssl_conn);
4421 conn = XSSLCONN(ssl_conn)->ssl_conn;
4422 sk = SSL_get_peer_cert_chain(conn);
4427 for (i=0; i<sk_X509_num(sk); i++) {
4428 X509 *cert = sk_X509_value(sk, i);
4430 result = Fcons(make_evp_pkey_x509(cert), result);
4437 DEFUN("ossl-ssl-cert-store", Fossl_ssl_cert_store, 1, 1, 0, /*
4438 Return the X509 cert store of SSL-CONN.
4442 X509_STORE *sto = NULL;
4448 #if 0 /* just thoughts */
4449 int SSL_get_verify_mode(const SSL *s);
4450 int SSL_get_verify_depth(const SSL *s);
4453 DEFUN("ossl-ssl-verify-certificate", Fossl_ssl_verify_certificate,
4455 Return a verify code of SSL-CONN.
4457 The result is a cons cell with the numeric verify code in
4458 the car and a verbose string in the cdr.
4463 /* SSL connection stuff */
4466 Lisp_Object result = Qnil;
4468 CHECK_SSLCONN(ssl_conn);
4470 conn = XSSLCONN(ssl_conn)->ssl_conn;
4471 vrc = SSL_get_verify_result(conn);
4475 build_string(X509_verify_cert_error_string(vrc)));
4480 DEFUN("ossl-ssl-cipher-version", Fossl_ssl_cipher_version, 1, 1, 0, /*
4481 Return the protocol version of the tunnel SSL-CONN.
4485 /* SSL connection stuff */
4487 const SSL_CIPHER *ciph;
4488 /* network stream stuff */
4489 Lisp_SSL_CONN *lisp_ssl_conn;
4491 CHECK_SSLCONN(ssl_conn);
4492 lisp_ssl_conn = XSSLCONN(ssl_conn);
4494 conn = lisp_ssl_conn->ssl_conn;
4498 ciph = SSL_get_current_cipher(conn);
4500 if (!(ciph == NULL))
4501 return Fmake_symbol(
4502 build_string(SSL_CIPHER_get_version(ciph)));
4507 DEFUN("ossl-ssl-cipher-name", Fossl_ssl_cipher_name, 1, 1, 0, /*
4508 Return the name of the current cipher used in the tunnel SSL-CONN.
4512 /* SSL connection stuff */
4514 const SSL_CIPHER *ciph;
4515 /* network stream stuff */
4516 Lisp_SSL_CONN *lisp_ssl_conn;
4518 CHECK_SSLCONN(ssl_conn);
4519 lisp_ssl_conn = XSSLCONN(ssl_conn);
4521 conn = lisp_ssl_conn->ssl_conn;
4525 ciph = SSL_get_current_cipher(conn);
4527 if (!(ciph == NULL))
4528 return intern(SSL_CIPHER_get_name(ciph));
4533 DEFUN("ossl-ssl-cipher-names", Fossl_ssl_cipher_names, 1, 1, 0, /*
4534 Return the names of all supported ciphers in the tunnel SSL-CONN.
4539 /* SSL connection stuff */
4541 STACK_OF(SSL_CIPHER) *ciphs;
4542 Lisp_Object result = Qnil;
4544 CHECK_SSLCONN(ssl_conn);
4546 conn = XSSLCONN(ssl_conn)->ssl_conn;
4550 ciphs = SSL_get_ciphers(conn);
4552 for (i=sk_SSL_CIPHER_num(ciphs)-1; i>=0; i--) {
4553 SSL_CIPHER *ciph = sk_SSL_CIPHER_value(ciphs, i);
4555 result = Fcons(intern(SSL_CIPHER_get_name(ciph)), result);
4561 DEFUN("ossl-ssl-cipher-bits", Fossl_ssl_cipher_bits, 1, 1, 0, /*
4562 Return the number of effective bits of the current cipher in SSL-CONN.
4566 /* SSL connection stuff */
4568 const SSL_CIPHER *ciph;
4569 int alg_bits, strength_bits;
4570 /* network stream stuff */
4571 Lisp_SSL_CONN *lisp_ssl_conn;
4573 CHECK_SSLCONN(ssl_conn);
4574 lisp_ssl_conn = XSSLCONN(ssl_conn);
4576 conn = lisp_ssl_conn->ssl_conn;
4580 ciph = SSL_get_current_cipher(conn);
4582 if (!(ciph == NULL)) {
4583 strength_bits = SSL_CIPHER_get_bits(ciph, &alg_bits);
4584 /* what do we want to do with alg_bits? */
4585 return make_int(strength_bits);
4590 DEFUN("ossl-ssl-cipher-description", Fossl_ssl_cipher_description, 1, 1, 0, /*
4591 Return a description of the current cipher used in the tunnel SSL-CONN.
4595 /* SSL connection stuff */
4597 const SSL_CIPHER *ciph;
4598 /* network stream stuff */
4599 Lisp_SSL_CONN *lisp_ssl_conn;
4601 CHECK_SSLCONN(ssl_conn);
4602 lisp_ssl_conn = XSSLCONN(ssl_conn);
4604 conn = lisp_ssl_conn->ssl_conn;
4608 ciph = SSL_get_current_cipher(conn);
4610 if (!(ciph == NULL))
4611 return build_string(SSL_CIPHER_description(ciph, NULL, 0));
4617 /* X509 cert handling */
4618 DEFUN("ossl-x509-subject", Fossl_x509_subject, 1, 1, 0, /*
4619 Return the certificate subject of CERT (an evp-pkey object).
4621 This will return a string in LDAP syntax.
4627 CHECK_EVPPKEY(cert);
4629 pk509 = XEVPPKEY(cert)->x509;
4632 X509_NAME *sub = X509_get_subject_name(pk509);
4633 return build_string(X509_NAME_oneline(sub, NULL, 0));
4638 DEFUN("ossl-x509-issuer", Fossl_x509_issuer, 1, 1, 0, /*
4639 Return the certificate issuer of CERT (an evp-pkey object),
4640 that is the organisation which signed the certificate.
4642 This will return a string in LDAP syntax.
4648 CHECK_EVPPKEY(cert);
4650 pk509 = XEVPPKEY(cert)->x509;
4653 X509_NAME *iss = X509_get_issuer_name(pk509);
4654 return build_string(X509_NAME_oneline(iss, NULL, 0));
4659 DEFUN("ossl-x509-serial", Fossl_x509_serial, 1, 1, 0, /*
4660 Return the certificate serial of CERT (an evp-pkey object).
4666 CHECK_EVPPKEY(cert);
4668 pk509 = XEVPPKEY(cert)->x509;
4671 ASN1_INTEGER *ser = X509_get_serialNumber(pk509);
4672 return make_integer(ASN1_INTEGER_get(ser));
4677 DEFUN("ossl-x509-not-before", Fossl_x509_not_before, 1, 1, 0, /*
4678 Return the certificate valid-not-before time of CERT.
4684 CHECK_EVPPKEY(cert);
4686 pk509 = XEVPPKEY(cert)->x509;
4689 ASN1_TIME *nbf = X509_get_notBefore(pk509);
4690 return build_string((char*)nbf->data);
4695 DEFUN("ossl-x509-not-after", Fossl_x509_not_after, 1, 1, 0, /*
4696 Return the certificate valid-not-after time of CERT.
4702 CHECK_EVPPKEY(cert);
4704 pk509 = XEVPPKEY(cert)->x509;
4707 ASN1_TIME *nbf = X509_get_notAfter(pk509);
4708 return build_string((char*)nbf->data);
4713 DEFUN("ossl-x509-signature-type", Fossl_x509_signature_type, 1, 1, 0, /*
4714 Return the signature type of CERT.
4720 CHECK_EVPPKEY(cert);
4722 pk509 = XEVPPKEY(cert)->x509;
4725 int ty = X509_get_signature_type(pk509);
4726 Lisp_Object result = Qnil;
4730 result = intern("none");
4732 #ifndef OPENSSL_NO_RSA
4734 result = intern("rsa");
4737 result = intern("rsa2");
4740 #ifndef OPENSSL_NO_DSA
4742 result = intern("dsa");
4745 result = intern("dsa1");
4748 result = intern("dsa2");
4751 result = intern("dsa3");
4754 result = intern("dsa4");
4757 #ifndef OPENSSL_NO_DH
4759 result = intern("dh");
4762 #ifndef OPENSSL_NO_EC
4764 result = intern("ec");
4768 result = intern("unknown");
4783 * Initialisation stuff
4786 void syms_of_openssl(void)
4788 INIT_LRECORD_IMPLEMENTATION(evp_pkey);
4789 INIT_LRECORD_IMPLEMENTATION(ssl_conn);
4791 defsymbol(&Qopenssl, "openssl");
4792 defsymbol(&Qevp_pkeyp, "ossl-pkey-p");
4794 DEFSUBR(Fossl_version);
4795 DEFSUBR(Fossl_available_digests);
4796 DEFSUBR(Fossl_available_ciphers);
4797 DEFSUBR(Fossl_digest_size);
4798 DEFSUBR(Fossl_digest_bits);
4799 DEFSUBR(Fossl_digest_block_size);
4800 DEFSUBR(Fossl_cipher_key_length);
4801 DEFSUBR(Fossl_cipher_bits);
4802 DEFSUBR(Fossl_cipher_iv_length);
4803 DEFSUBR(Fossl_cipher_block_size);
4804 DEFSUBR(Fossl_cipher_mode);
4806 DEFSUBR(Fossl_rand_bytes);
4807 DEFSUBR(Fossl_rand_bytes_egd);
4809 DEFSUBR(Fossl_digest);
4810 DEFSUBR(Fossl_digest_file);
4812 DEFSUBR(Fossl_hmac);
4813 DEFSUBR(Fossl_hmac_file);
4815 DEFSUBR(Fossl_bytes_to_key);
4816 DEFSUBR(Fossl_encrypt);
4817 DEFSUBR(Fossl_encrypt_file);
4818 DEFSUBR(Fossl_decrypt);
4819 DEFSUBR(Fossl_decrypt_file);
4822 DEFSUBR(Fossl_pkey_p);
4823 DEFSUBR(Fossl_pkey_size);
4824 DEFSUBR(Fossl_pkey_private_p);
4825 DEFSUBR(Fossl_pkey_get_public);
4827 #ifndef OPENSSL_NO_RSA
4829 DEFSUBR(Fossl_rsa_generate_key);
4830 DEFSUBR(Fossl_rsa_pkey_p);
4831 DEFSUBR(Fossl_rsa_subkey_p);
4832 #endif /* OPENSSL_NO_RSA */
4833 #ifndef OPENSSL_NO_DSA
4835 DEFSUBR(Fossl_dsa_generate_key);
4836 DEFSUBR(Fossl_dsa_pkey_p);
4837 DEFSUBR(Fossl_dsa_subkey_p);
4838 #endif /* OPENSSL_NO_DSA */
4839 #ifndef OPENSSL_NO_EC
4841 DEFSUBR(Fossl_ec_available_curves);
4842 DEFSUBR(Fossl_ec_generate_key);
4843 DEFSUBR(Fossl_ec_pkey_p);
4844 #endif /* OPENSSL_NO_EC */
4845 #ifndef OPENSSL_NO_DH
4847 /* DEFSUBR(Fossl_ec_generate_key); */
4848 DEFSUBR(Fossl_dh_pkey_p);
4850 DEFSUBR(Fossl_seal);
4851 DEFSUBR(Fossl_open);
4853 DEFSUBR(Fossl_sign);
4854 DEFSUBR(Fossl_verify);
4857 DEFSUBR(Fossl_pem_read_public_key);
4858 DEFSUBR(Fossl_pem_read_key);
4859 DEFSUBR(Fossl_pem_write_public_key);
4860 DEFSUBR(Fossl_pem_write_key);
4861 DEFSUBR(Fossl_pem_public_key);
4862 DEFSUBR(Fossl_pem_key);
4865 defsymbol(&Qssl_connp, "ossl-ssl-conn-p");
4866 defsymbol(&Qssl2, "ssl2");
4867 defsymbol(&Qssl23, "ssl23");
4868 defsymbol(&Qssl3, "ssl3");
4869 defsymbol(&Qtls1, "tls1");
4871 DEFSUBR(Fossl_ssl_handshake);
4872 DEFSUBR(Fossl_ssl_inject_ca);
4873 DEFSUBR(Fossl_ssl_inject_cert);
4874 DEFSUBR(Fossl_ssl_proselytise_process);
4875 DEFSUBR(Fossl_ssl_unproselytise_process);
4876 DEFSUBR(Fossl_ssl_connect);
4877 DEFSUBR(Fossl_ssl_finish);
4878 DEFSUBR(Fossl_ssl_read);
4879 DEFSUBR(Fossl_ssl_write);
4880 DEFSUBR(Fossl_ssl_parent);
4881 DEFSUBR(Fossl_ssl_cert);
4882 DEFSUBR(Fossl_ssl_peer_cert);
4883 DEFSUBR(Fossl_ssl_peer_cert_chain);
4884 DEFSUBR(Fossl_ssl_verify_certificate);
4885 DEFSUBR(Fossl_ssl_cipher_version);
4886 DEFSUBR(Fossl_ssl_cipher_name);
4887 DEFSUBR(Fossl_ssl_cipher_names);
4888 DEFSUBR(Fossl_ssl_cipher_bits);
4889 DEFSUBR(Fossl_ssl_cipher_description);
4892 DEFSUBR(Fossl_x509_subject);
4893 DEFSUBR(Fossl_x509_issuer);
4894 DEFSUBR(Fossl_x509_serial);
4895 DEFSUBR(Fossl_x509_not_before);
4896 DEFSUBR(Fossl_x509_not_after);
4897 DEFSUBR(Fossl_x509_signature_type);
4900 void vars_of_openssl(void)
4904 #ifndef OPENSSL_NO_RSA
4905 Fprovide(intern("openssl-rsa"));
4907 #ifndef OPENSSL_NO_DSA
4908 Fprovide(intern("openssl-dsa"));
4910 #ifndef OPENSSL_NO_EC
4911 Fprovide(intern("openssl-ec"));
4913 #ifndef OPENSSL_NO_DH
4914 Fprovide(intern("openssl-dh"));
4917 Fprovide(intern("openssl-ssl"));