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)))
880 return wrong_type_argument(Qfile_readable_p, file);
883 OpenSSL_add_all_digests();
884 md = EVP_get_digestbyname(
885 (char *)string_data(XSYMBOL(digest)->name));
889 error ("no such digest");
892 mdctx = xnew(EVP_MD_CTX);
893 EVP_MD_CTX_init(mdctx);
894 md_blocksize = (unsigned int)(EVP_MD_block_size(md) / 8);
896 EVP_DigestInit_ex(mdctx, md, NULL);
898 /* we reuse md_value here for streaming over fp */
900 n = fread(md_value, 1, EVP_MAX_MD_SIZE, fp);
905 error("file corrupted");
908 EVP_DigestUpdate(mdctx, md_value, n);
911 EVP_DigestFinal_ex(mdctx, md_value, &md_len);
912 EVP_MD_CTX_cleanup(mdctx);
918 return make_ext_string((char *)md_value, md_len, OSSL_CODING);
924 * HMAC (aka keyed hashes)
927 DEFUN("ossl-hmac", Fossl_hmac, 3, 3, 0, /*
928 Return the message authentication code of MSG
929 using the hash function DIGEST and the key PASSWORD.
931 Note: You probably want to put a wrapping encoder function
932 \(like `base16-encode-string'\) around it, since this returns
935 (digest, msg, password))
940 /* buffer for the ciphertext */
941 unsigned char outbuf[EVP_MAX_MD_SIZE];
943 /* buffer for external password */
945 unsigned int password_len;
947 /* buffer for external message */
949 unsigned int msg_len;
952 CHECK_SYMBOL(digest);
954 CHECK_STRING(password);
956 OpenSSL_add_all_digests();
957 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
961 error ("no such digest");
964 TO_EXTERNAL_FORMAT (LISP_STRING, password,
965 C_STRING_ALLOCA, password_ext, OSSL_CODING);
966 password_len = OSSL_STRING_LENGTH(password);
968 #if 0 /* i wonder why */
969 TO_EXTERNAL_FORMAT (LISP_STRING, msg,
970 C_STRING_ALLOCA, msg_ext, OSSL_CODING);
971 msg_len = OSSL_STRING_LENGTH(msg);
974 hmacctx = xnew(HMAC_CTX);
975 HMAC_CTX_init(hmacctx);
976 HMAC_Init(hmacctx, password_ext, password_len, md);
977 HMAC_Update(hmacctx, (unsigned char*)XSTRING_DATA(msg),
978 XSTRING_LENGTH(msg));
979 HMAC_Final(hmacctx, outbuf, &outlen);
980 HMAC_CTX_cleanup(hmacctx);
985 return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
988 DEFUN("ossl-hmac-file", Fossl_hmac_file, 3, 3, 0, /*
989 Return the message authentication code of the contents of FILE
990 using the hash function DIGEST and the key PASSWORD.
992 Note: You probably want to put a wrapping encoder function
993 \(like `base16-encode-string'\) around it, since this returns
996 (digest, file, password))
1001 /* buffer for the ciphertext */
1002 unsigned char outbuf[EVP_MAX_MD_SIZE];
1003 unsigned int outlen;
1005 /* buffer for external password */
1007 unsigned int password_len;
1011 CHECK_SYMBOL(digest);
1013 CHECK_STRING(password);
1015 file = Fexpand_file_name(file, Qnil);
1017 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1018 (fseek(fp, 0, SEEK_SET))) {
1021 return wrong_type_argument(Qfile_readable_p, file);
1025 OpenSSL_add_all_digests();
1026 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
1030 error ("no such digest");
1033 TO_EXTERNAL_FORMAT (LISP_STRING, password,
1034 C_STRING_ALLOCA, password_ext, OSSL_CODING);
1035 password_len = OSSL_STRING_LENGTH(password);
1037 hmacctx = xnew(HMAC_CTX);
1038 HMAC_CTX_init(hmacctx);
1039 HMAC_Init(hmacctx, password_ext, password_len, md);
1041 /* we reuse md_value here for streaming over fp */
1043 n = fread(outbuf, 1, EVP_MAX_MD_SIZE, fp);
1048 error("file corrupted");
1051 HMAC_Update(hmacctx, outbuf, n);
1054 HMAC_Final(hmacctx, outbuf, &outlen);
1055 HMAC_CTX_cleanup(hmacctx);
1061 return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1070 DEFUN("ossl-bytes-to-key", Fossl_bytes_to_key, 5, 5, 0, /*
1071 Derive a key and initialisation vector (iv) suitable for a cipher.
1072 Return a string KEY being the key. The initialisation vector is
1073 put into KEY's property list as 'iv.
1075 CIPHER \(a symbol\) is the cipher to derive the key and IV for.
1076 Valid ciphers can be obtained by `ossl-available-ciphers'.
1078 DIGEST \(a symbol\) is the message digest to use.
1079 Valid digests can be obtained by `ossl-available-digests'.
1081 SALT \(string or `nil'\) is used as a salt in the derivation.
1082 Use `nil' here to indicate that no salt is used.
1084 PASSWORD is an arbitrary string which is processed to derive a
1087 COUNT \(a positive integer\) is the iteration count to use. This
1088 indicates how often the hash algorithm is called recursively.
1090 Note: You probably want to put a wrapping encoder function
1091 \(like `base16-encode-string'\) around it, since this returns
1094 (cipher, digest, salt, password, count))
1097 const EVP_CIPHER *ciph;
1098 const char *salt_ext;
1101 unsigned int password_len;
1103 char key[EVP_MAX_KEY_LENGTH];
1104 char iv[EVP_MAX_IV_LENGTH];
1108 CHECK_STRING(password);
1109 CHECK_SYMBOL(cipher);
1110 CHECK_SYMBOL(digest);
1111 CHECK_NATNUM(count);
1115 error ("count has to be a non-zero positive integer");
1117 OpenSSL_add_all_algorithms();
1118 md = EVP_get_digestbyname(
1119 (char *)string_data(XSYMBOL(digest)->name));
1120 ciph = EVP_get_cipherbyname(
1121 (char *)string_data(XSYMBOL(cipher)->name));
1125 error ("no such cipher");
1130 error ("no such digest");
1137 TO_EXTERNAL_FORMAT (LISP_STRING, salt,
1138 C_STRING_ALLOCA, salt_ext, OSSL_CODING);
1142 TO_EXTERNAL_FORMAT (LISP_STRING, password,
1143 C_STRING_ALLOCA, password_ext, OSSL_CODING);
1144 password_len = OSSL_STRING_LENGTH(password);
1146 EVP_BytesToKey(ciph, md, (const unsigned char *)salt_ext,
1147 (const unsigned char *)password_ext, password_len,
1149 (unsigned char *)key,
1150 (unsigned char *)iv);
1154 result = make_ext_string(key, EVP_CIPHER_key_length(ciph), OSSL_CODING);
1155 Fput(result, intern("iv"),
1156 make_ext_string(iv, EVP_CIPHER_iv_length(ciph), OSSL_CODING));
1162 DEFUN("ossl-encrypt", Fossl_encrypt, 3, 4, 0, /*
1163 Return the cipher of STRING computed by CIPHER under KEY.
1165 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1166 you have compiled. See `ossl-available-ciphers'.
1168 STRING is the text to be encrypted.
1170 KEY should be a key generated suitably for this cipher, for example
1171 by `ossl-bytes-to-key'.
1173 Optional fourth argument IV should be an initialisation vector
1174 suitable for this cipher. Normally the initialisation vector from
1175 KEY's property list is used. However, if IV is
1176 non-nil, use this IV instead.
1178 Note: You probably want to put a wrapping encoder function
1179 \(like `base16-encode-string'\) around it, since this returns
1182 (cipher, string, key, iv))
1184 /* buffer for the external string */
1186 unsigned int string_len;
1187 /* buffer for the ciphertext */
1190 Lisp_Object l_outbuf;
1191 /* buffer for key */
1196 /* declarations for the cipher */
1197 const EVP_CIPHER *ciph;
1198 EVP_CIPHER_CTX *ciphctx;
1201 int speccount = specpdl_depth();
1204 /* frob the IV from the plist of key maybe */
1206 iv = Fget(key, intern("iv"), Qnil);
1208 CHECK_SYMBOL(cipher);
1209 CHECK_STRING(string);
1213 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1214 C_STRING_ALLOCA, string_ext, OSSL_CODING);
1215 string_len = OSSL_STRING_LENGTH(string);
1217 if (string_len <= 0)
1218 error ("string must be of non-zero positive length.");
1220 OpenSSL_add_all_algorithms();
1221 /* ENGINE_load_builtin_engines(); */
1222 /* atm, no support for different engines */
1223 ciph = EVP_get_cipherbyname(
1224 (char *)string_data(XSYMBOL(cipher)->name));
1228 error ("no such cipher");
1231 /* now allocate some output buffer externally
1232 * this one has to be at least EVP_CIPHER_block_size bigger
1233 * since block algorithms merely operate blockwise
1235 alloclen = XSTRING_LENGTH(string) + EVP_CIPHER_block_size(ciph);
1236 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1238 TO_EXTERNAL_FORMAT(LISP_STRING, key,
1239 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1240 TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1241 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1243 ciphctx = xnew(EVP_CIPHER_CTX);
1244 EVP_CIPHER_CTX_init(ciphctx);
1245 if (!EVP_EncryptInit(ciphctx, ciph,
1246 (unsigned char *)key_ext,
1247 (unsigned char *)iv_ext)) {
1250 error ("error in EncryptInit");
1252 if (!EVP_EncryptUpdate(ciphctx,
1253 (unsigned char *)outbuf, &outlen,
1254 (unsigned char *)string_ext, string_len)) {
1257 error ("error in EncryptUpdate");
1259 /* Buffer passed to EVP_EncryptFinal() must be after data just
1260 * encrypted to avoid overwriting it.
1262 if (!EVP_EncryptFinal(ciphctx,
1263 (unsigned char *)outbuf+outlen, &tmplen)) {
1266 error ("error in EncryptFinal");
1268 /* added probable padding space to the length of the output buffer */
1270 EVP_CIPHER_CTX_cleanup(ciphctx);
1272 l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1273 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1281 DEFUN("ossl-encrypt-file", Fossl_encrypt_file, 3, 5, 0, /*
1282 Return the encrypted contents of FILE computed by CIPHER under KEY.
1284 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1285 you have compiled. See `ossl-available-ciphers'.
1287 FILE is the file to be encrypted.
1289 Third argument KEY should be a key generated suitably for this
1290 cipher, for example by `ossl-bytes-to-key'.
1292 Optional fourth argument IV should be an initialisation vector
1293 suitable for this cipher. Normally the initialisation vector from
1294 KEY's property list is used. However, if IV is
1295 non-nil, use this IV instead.
1297 Optional fifth argument OUTFILE may specify a file to have the
1298 encrypted data redirected.
1300 Note: You probably want to put a wrapping encoder function
1301 \(like `base16-encode-string'\) around it, since this returns
1304 (cipher, file, key, iv, outfile))
1306 /* buffer for the external string */
1307 unsigned char string_in[1024];
1309 unsigned int block_len;
1310 unsigned long file_size;
1311 /* buffer for the ciphertext */
1312 unsigned char *outbuf;
1315 Lisp_Object l_outbuf;
1316 /* buffer for key */
1326 /* declarations for the cipher */
1327 const EVP_CIPHER *ciph;
1328 EVP_CIPHER_CTX *ciphctx;
1331 int speccount = specpdl_depth();
1334 /* frob the IV from the plist of key maybe */
1336 iv = Fget(key, intern("iv"), Qnil);
1338 CHECK_SYMBOL(cipher);
1343 if (!NILP(outfile)) {
1344 CHECK_STRING(outfile);
1345 outfile = Fexpand_file_name(outfile, Qnil);
1346 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1347 return wrong_type_argument(Qfile_writable_p, outfile);
1352 file = Fexpand_file_name(file, Qnil);
1353 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1354 (fseek(fp, 0, SEEK_SET))) {
1359 return wrong_type_argument(Qfile_readable_p, file);
1362 fseek(fp, 0, SEEK_END);
1363 file_size = ftell(fp);
1364 fseek(fp, 0, SEEK_SET);
1367 OpenSSL_add_all_algorithms();
1368 /* ENGINE_load_builtin_engines(); */
1369 /* atm, no support for different engines */
1370 ciph = EVP_get_cipherbyname(
1371 (char *)string_data(XSYMBOL(cipher)->name));
1378 error ("no such cipher");
1381 /* now allocate some output buffer externally
1382 * this one has to be at least EVP_CIPHER_block_size bigger
1383 * since block algorithms merely operate blockwise
1385 block_len = EVP_CIPHER_block_size(ciph);
1386 if (UNLIKELY(of != NULL)) {
1389 alloclen = file_size + block_len;
1391 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1393 TO_EXTERNAL_FORMAT(LISP_STRING, key,
1394 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1395 TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1396 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1398 ciphctx = xnew(EVP_CIPHER_CTX);
1399 EVP_CIPHER_CTX_init(ciphctx);
1400 if (!EVP_EncryptInit(ciphctx, ciph,
1401 (unsigned char *)key_ext,
1402 (unsigned char *)iv_ext)) {
1408 error("error in EncryptInit");
1414 string_len = fread(string_in, 1, 1024, fp);
1415 if (string_len < 0) {
1421 error("file corrupted");
1426 if (string_len > 0 &&
1427 !EVP_EncryptUpdate(ciphctx,
1429 string_in, string_len)) {
1435 error("error in EncryptUpdate");
1439 fwrite(obp, 1, tmplen, of);
1444 } while (string_len > 0);
1446 /* Buffer passed to EVP_EncryptFinal() must be after data just
1447 * encrypted to avoid overwriting it.
1449 if (!EVP_EncryptFinal(ciphctx, obp, &tmplen)) {
1455 error("error in EncryptFinal");
1459 fwrite(obp, 1, tmplen, of);
1461 /* added probable padding space to the length of the output buffer */
1463 EVP_CIPHER_CTX_cleanup(ciphctx);
1465 if (UNLIKELY(of != NULL)) {
1468 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1470 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1481 (setq k (ossl-bytes-to-key 'AES-256-OFB 'SHA1 nil "password" 1))
1482 (ossl-encrypt-file 'AES-256-OFB "~/.gnus" k nil "/tmp/gnus-enc")
1483 (ossl-decrypt-file 'AES-256-OFB "/tmp/gnus-enc" k nil "/tmp/gnus-dec")
1487 DEFUN("ossl-decrypt", Fossl_decrypt, 3, 4, 0, /*
1488 Return the deciphered version of STRING computed by CIPHER under KEY.
1490 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1491 you have compiled. See `ossl-available-ciphers'.
1493 STRING is the text to be decrypted.
1495 KEY should be a key generated suitably for this
1496 cipher, for example by `ossl-bytes-to-key'.
1498 Optional fourth argument IV should be an initialisation vector
1499 suitable for this cipher. Normally the initialisation vector from
1500 KEY's property list is used. However, if IV is
1501 non-nil, use this IV instead.
1503 (cipher, string, key, iv))
1505 /* buffer for the external string */
1507 unsigned int string_len;
1508 /* buffer for the deciphered text */
1511 Lisp_Object l_outbuf;
1512 /* buffer for key */
1517 /* declarations for the decipher */
1518 const EVP_CIPHER *ciph;
1519 EVP_CIPHER_CTX *ciphctx;
1522 int speccount = specpdl_depth();
1525 /* frob the IV from the plist of key maybe */
1527 iv = Fget(key, intern("iv"), Qnil);
1529 CHECK_SYMBOL(cipher);
1530 CHECK_STRING(string);
1534 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1535 C_STRING_ALLOCA, string_ext, OSSL_CODING);
1536 string_len = OSSL_STRING_LENGTH(string);
1539 error ("string must be of non-zero positive length.");
1541 OpenSSL_add_all_algorithms();
1542 /* ENGINE_load_builtin_engines(); */
1543 /* atm, no support for different engines */
1544 ciph = EVP_get_cipherbyname(
1545 (char *)string_data(XSYMBOL(cipher)->name));
1549 error ("no such cipher");
1552 /* now allocate some output buffer externally */
1553 alloclen = XSTRING_LENGTH(string);
1554 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1556 TO_EXTERNAL_FORMAT (LISP_STRING, key,
1557 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1558 TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1559 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1561 ciphctx = xnew(EVP_CIPHER_CTX);
1562 EVP_CIPHER_CTX_init(ciphctx);
1563 if (!EVP_DecryptInit(ciphctx, ciph,
1564 (unsigned char *)key_ext,
1565 (unsigned char *)iv_ext)) {
1568 error ("error in DecryptInit");
1570 if (!EVP_DecryptUpdate(ciphctx,
1571 (unsigned char *)outbuf, &outlen,
1572 (unsigned char *)string_ext,string_len)) {
1575 error ("error in DecryptUpdate");
1577 /* Buffer passed to EVP_EncryptFinal() must be after data just
1578 * encrypted to avoid overwriting it.
1580 if (!EVP_DecryptFinal(ciphctx,
1581 (unsigned char *)outbuf+outlen, &tmplen)) {
1584 error ("error in DecryptFinal");
1586 /* added probable padding space to the length of the output buffer */
1588 EVP_CIPHER_CTX_cleanup(ciphctx);
1590 l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1591 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1599 DEFUN("ossl-decrypt-file", Fossl_decrypt_file, 3, 5, 0, /*
1600 Return the deciphered version of FILE computed by CIPHER under KEY.
1602 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1603 you have compiled. See `ossl-available-ciphers'.
1605 FILE is the file to be decrypted.
1607 Third argument KEY should be a key generated suitably for this
1608 cipher, for example by `ossl-bytes-to-key'.
1610 Optional fourth argument IV should be an initialisation vector
1611 suitable for this cipher. Normally the initialisation vector from
1612 KEY's property list is used. However, if IV is
1613 non-nil, use this IV instead.
1615 Optional fifth argument OUTFILE may specify a file to have the
1616 encrypted data redirected.
1618 (cipher, file, key, iv, outfile))
1620 /* buffer for the external string */
1621 unsigned char string_in[1024];
1623 unsigned int block_len;
1624 unsigned long file_size;
1625 /* buffer for the deciphered text */
1626 unsigned char *outbuf;
1629 Lisp_Object l_outbuf;
1630 /* buffer for key */
1640 /* declarations for the decipher */
1641 const EVP_CIPHER *ciph;
1642 EVP_CIPHER_CTX *ciphctx;
1645 int speccount = specpdl_depth();
1648 /* frob the IV from the plist of key maybe */
1650 iv = Fget(key, intern("iv"), Qnil);
1652 CHECK_SYMBOL(cipher);
1657 if (!NILP(outfile)) {
1658 CHECK_STRING(outfile);
1659 outfile = Fexpand_file_name(outfile, Qnil);
1660 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1661 return wrong_type_argument(Qfile_writable_p, outfile);
1666 file = Fexpand_file_name(file, Qnil);
1667 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1668 (fseek(fp, 0, SEEK_SET))) {
1673 return wrong_type_argument(Qfile_readable_p, file);
1676 fseek(fp, 0, SEEK_END);
1677 file_size = ftell(fp);
1678 fseek(fp, 0, SEEK_SET);
1681 OpenSSL_add_all_algorithms();
1682 /* ENGINE_load_builtin_engines(); */
1683 /* atm, no support for different engines */
1684 ciph = EVP_get_cipherbyname(
1685 (char *)string_data(XSYMBOL(cipher)->name));
1692 error ("no such cipher");
1695 /* now allocate some output buffer externally */
1696 block_len = EVP_CIPHER_block_size(ciph);
1697 if (UNLIKELY(of != NULL)) {
1700 alloclen = file_size + block_len;
1702 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1704 TO_EXTERNAL_FORMAT (LISP_STRING, key,
1705 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1706 TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1707 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1709 ciphctx = xnew(EVP_CIPHER_CTX);
1710 EVP_CIPHER_CTX_init(ciphctx);
1711 if (!EVP_DecryptInit(ciphctx, ciph,
1712 (unsigned char *)key_ext,
1713 (unsigned char *)iv_ext)) {
1719 error ("error in DecryptInit");
1725 string_len = fread(string_in, 1, 1024, fp);
1726 if (string_len < 0) {
1732 error("file corrupted");
1737 if (string_len > 0 &&
1738 !EVP_DecryptUpdate(ciphctx,
1740 string_in, string_len)) {
1746 error ("error in DecryptUpdate");
1750 fwrite(obp, 1, tmplen, of);
1755 } while (string_len > 0);
1757 /* Buffer passed to EVP_EncryptFinal() must be after data just
1758 * encrypted to avoid overwriting it.
1760 if (!EVP_DecryptFinal(ciphctx, obp, &tmplen)) {
1766 error ("error in DecryptFinal");
1770 fwrite(obp, 1, tmplen, of);
1772 /* added probable padding space to the length of the output buffer */
1774 EVP_CIPHER_CTX_cleanup(ciphctx);
1776 if (UNLIKELY(of != NULL)) {
1779 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1781 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1798 /* This is an opaque object for storing PKEYs in lisp */
1799 Lisp_Object Qevp_pkeyp;
1802 mark_evp_pkey(Lisp_Object obj)
1804 /* avoid some warning */
1810 print_evp_pkey(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1816 pkey = XEVPPKEY(obj)->evp_pkey;
1817 x509 = XEVPPKEY(obj)->x509;
1819 write_c_string("#<OpenSSL", printcharfun);
1822 X509_NAME *iss = X509_get_issuer_name(x509);
1823 X509_NAME *sub = X509_get_subject_name(x509);
1824 write_c_string(" X509 Certificate", printcharfun);
1825 write_c_string(" iss:", printcharfun);
1826 write_c_string(X509_NAME_oneline(sub, NULL, 0), printcharfun);
1827 write_c_string(" sub:", printcharfun);
1828 write_c_string(X509_NAME_oneline(iss, NULL, 0), printcharfun);
1833 write_c_string(";", printcharfun);
1835 if (rsa_pkey_p(pkey))
1836 write_c_string(" RSA", printcharfun);
1837 else if (dsa_pkey_p(pkey))
1838 write_c_string(" DSA", printcharfun);
1839 else if (ec_pkey_p(pkey))
1840 write_c_string(" EC", printcharfun);
1842 if (ossl_pkey_has_private_data(pkey))
1843 write_c_string(" private/public key", printcharfun);
1844 else if (ossl_pkey_has_public_data(pkey))
1845 write_c_string(" public key", printcharfun);
1847 write_c_string(" empty key", printcharfun);
1849 if (EVP_PKEY_size(pkey) > 0) {
1850 snprintf(buf, 256, ", size %d", EVP_PKEY_size(pkey)*8);
1851 write_c_string(buf, printcharfun);
1855 write_c_string(">", printcharfun);
1857 /* avoid some warning */
1861 static Lisp_EVP_PKEY *
1862 allocate_evp_pkey(void)
1864 Lisp_EVP_PKEY *evp_pkey =
1865 alloc_lcrecord_type(Lisp_EVP_PKEY, &lrecord_evp_pkey);
1866 evp_pkey->evp_pkey = NULL;
1867 evp_pkey->x509 = NULL;
1872 finalise_evp_pkey(void *header, int for_disksave)
1874 Lisp_EVP_PKEY *evp_pkey = (Lisp_EVP_PKEY *) header;
1876 if (evp_pkey->evp_pkey) {
1877 EVP_PKEY_free(evp_pkey->evp_pkey);
1878 evp_pkey->evp_pkey = NULL;
1880 if (evp_pkey->x509) {
1881 X509_free(evp_pkey->x509);
1882 evp_pkey->x509 = NULL;
1885 /* avoid some warning */
1889 DEFINE_LRECORD_IMPLEMENTATION("evp_pkey", evp_pkey,
1890 mark_evp_pkey, print_evp_pkey,
1896 make_evp_pkey(EVP_PKEY *pkey, X509 *x509)
1898 Lisp_EVP_PKEY *lisp_pkey = allocate_evp_pkey();
1900 lisp_pkey->evp_pkey = pkey;
1901 lisp_pkey->x509 = x509;
1903 return wrap_evppkey(lisp_pkey);
1907 make_evp_pkey_pk(EVP_PKEY *pkey)
1909 return make_evp_pkey(pkey, NULL);
1913 make_evp_pkey_x509(X509 *x509)
1915 return make_evp_pkey(X509_get_pubkey(x509), x509);
1918 DEFUN("ossl-pkey-p", Fossl_pkey_p, 1, 1, 0, /*
1919 Return t iff OBJECT is a pkey, nil otherwise.
1923 if (EVPPKEYP(object))
1929 DEFUN("ossl-pkey-size", Fossl_pkey_size, 1, 1, 0, /*
1930 Return the size a public key PKEY in bits.
1936 CHECK_EVPPKEY(pkey);
1938 pk = (XEVPPKEY(pkey))->evp_pkey;
1940 return make_int(EVP_PKEY_size(pk)*8);
1944 ossl_pkey_has_public_data(EVP_PKEY *pkey)
1946 if (rsa_pkey_p(pkey)) {
1947 #ifndef OPENSSL_NO_RSA
1948 return rsa_pkey_has_public_data((pkey->pkey).rsa);
1952 } else if (dsa_pkey_p(pkey)) {
1953 #ifndef OPENSSL_NO_DSA
1954 return dsa_pkey_has_public_data((pkey->pkey).dsa);
1958 } else if (ec_pkey_p(pkey)) {
1959 #ifndef OPENSSL_NO_EC
1960 return ec_pkey_has_public_data((pkey->pkey).ec);
1964 } else if (dh_pkey_p(pkey)) {
1965 #ifndef OPENSSL_NO_DH
1966 return dh_pkey_has_public_data((pkey->pkey).dh);
1974 ossl_pkey_has_private_data(EVP_PKEY *pkey)
1976 if (rsa_pkey_p(pkey)) {
1977 #ifndef OPENSSL_NO_RSA
1978 return rsa_pkey_has_private_data((pkey->pkey).rsa);
1982 } else if (dsa_pkey_p(pkey)) {
1983 #ifndef OPENSSL_NO_DSA
1984 return dsa_pkey_has_private_data((pkey->pkey).dsa);
1988 } else if (ec_pkey_p(pkey)) {
1989 #ifndef OPENSSL_NO_EC
1990 return ec_pkey_has_private_data((pkey->pkey).ec);
1994 } else if (dh_pkey_p(pkey)) {
1995 #ifndef OPENSSL_NO_DH
1996 return dh_pkey_has_private_data((pkey->pkey).dh);
2004 DEFUN("ossl-pkey-private-p", Fossl_pkey_private_p, 1, 1, 0, /*
2005 Return non-nil if PKEY contains private data.
2007 This function is not native OpenSSL.
2013 if (!(EVPPKEYP(pkey)))
2016 pk = (XEVPPKEY(pkey))->evp_pkey;
2018 if (ossl_pkey_has_private_data(pk))
2024 DEFUN("ossl-pkey-get-public", Fossl_pkey_get_public, 1, 1, 0, /*
2025 Return a copy of PKEY stripped by the private data.
2027 This function is not native OpenSSL.
2034 CHECK_EVPPKEY(pkey);
2036 pk = (XEVPPKEY(pkey))->evp_pkey;
2037 if (!(ossl_pkey_has_public_data(pk)))
2038 error ("key must have public data");
2040 pkout = EVP_PKEY_new();
2041 if (rsa_pkey_p(pk)) {
2042 #ifndef OPENSSL_NO_RSA
2043 EVP_PKEY_assign_RSA(pkout, RSAPublicKey_dup((pk->pkey).rsa));
2045 } else if (dsa_pkey_p(pk)) {
2046 #ifndef OPENSSL_NO_DSA
2047 EVP_PKEY_assign_DSA(pkout, dsa_get_public(pk));
2049 } else if (ec_pkey_p(pk)) {
2050 #ifndef OPENSSL_NO_EC
2051 EVP_PKEY_assign_EC_KEY(pkout, ec_get_public(pk));
2054 error ("no method to strip private data yet");
2056 return make_evp_pkey_pk(pkout);
2061 rsa_pkey_p(EVP_PKEY *pkey)
2065 type = EVP_PKEY_type(pkey->type);
2067 #ifndef OPENSSL_NO_RSA
2068 return ((type == EVP_PKEY_RSA) ||
2069 (type == EVP_PKEY_RSA2));
2074 #ifndef OPENSSL_NO_RSA
2076 rsa_pkey_has_public_data(RSA *rsakey)
2078 return (!(rsakey->n == NULL) &&
2079 !(rsakey->e == NULL));
2082 rsa_pkey_has_private_data(RSA *rsakey)
2084 return (rsa_pkey_has_public_data(rsakey) &&
2085 !(rsakey->d == NULL));
2088 DEFUN("ossl-rsa-generate-key", Fossl_rsa_generate_key, 2, 2, 0, /*
2089 Return an RSA public key with of length BITS and exponent EXPO.
2101 error ("modulus size must be a non-zero positive integer");
2102 if (!(XINT(expo) % 2))
2103 error ("exponent must be an odd positive integer");
2105 pkey = EVP_PKEY_new();
2106 rsakey = RSA_generate_key(XINT(bits), XINT(expo), NULL, NULL);
2107 EVP_PKEY_assign_RSA(pkey, rsakey);
2109 return make_evp_pkey_pk(pkey);
2112 DEFUN("ossl-rsa-pkey-p", Fossl_rsa_pkey_p, 1, 1, 0, /*
2113 Return t iff PKEY is of RSA type.
2119 if (!EVPPKEYP(pkey))
2122 pk = (XEVPPKEY(pkey))->evp_pkey;
2130 DEFUN("ossl-rsa-subkey-p", Fossl_rsa_subkey_p, 2, 2, 0, /*
2131 Return t iff PKEY1 is a subkey of PKEY2.
2132 I.e. if PKEY1 has the same public key data as PKEY2 and
2133 PKEY2 has all private data.
2135 This function is not native OpenSSL.
2144 CHECK_EVPPKEY(pkey1);
2145 CHECK_EVPPKEY(pkey2);
2147 pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2148 pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2150 /* perform a type check first */
2151 if (!rsa_pkey_p(pk1))
2152 error ("pkey1 must be of RSA type");
2153 if (!rsa_pkey_p(pk2))
2154 error ("pkey2 must be of RSA type");
2156 rk1 = (pk1->pkey).rsa;
2157 rk2 = (pk2->pkey).rsa;
2159 if (rsa_pkey_has_private_data(rk2) &&
2160 rsa_pkey_has_public_data(rk1) &&
2161 (!BN_cmp(rk1->n, rk2->n)) &&
2162 (!BN_cmp(rk1->e, rk2->e)))
2167 #endif /* OPENSSL_NO_RSA */
2172 dsa_pkey_p(EVP_PKEY *pkey)
2176 type = EVP_PKEY_type(pkey->type);
2178 #ifndef OPENSSL_NO_DSA
2179 return ((type == EVP_PKEY_DSA) ||
2180 (type == EVP_PKEY_DSA1) ||
2181 (type == EVP_PKEY_DSA2) ||
2182 (type == EVP_PKEY_DSA3) ||
2183 (type == EVP_PKEY_DSA4));
2188 #ifndef OPENSSL_NO_DSA
2190 dsa_pkey_has_public_data(DSA *dsakey)
2192 return (!(dsakey->p == NULL) &&
2193 !(dsakey->q == NULL) &&
2194 !(dsakey->g == NULL) &&
2195 !(dsakey->pub_key == NULL));
2198 dsa_pkey_has_private_data(DSA *dsakey)
2200 return (dsa_pkey_has_public_data(dsakey) &&
2201 !(dsakey->priv_key == NULL));
2204 DEFUN("ossl-dsa-generate-key", Fossl_dsa_generate_key, 1, 2, 0, /*
2205 Return a DSA public key with of length BITS seeded with (optional) SEED.
2214 unsigned_long h_ret;
2221 error ("prime number size must be a non-zero positive integer");
2228 TO_EXTERNAL_FORMAT (LISP_STRING, seed,
2229 C_STRING_ALLOCA, seed_ext, OSSL_CODING);
2230 seed_len = OSSL_STRING_LENGTH(seed);
2233 pkey = EVP_PKEY_new();
2234 dsakey = DSA_generate_parameters(XINT(bits),
2235 (unsigned char*)seed_ext, seed_len,
2236 &counter_ret, &h_ret,
2238 if (!DSA_generate_key(dsakey))
2239 error ("error during generation of DSA key");
2241 EVP_PKEY_assign_DSA(pkey, dsakey);
2243 return make_evp_pkey_pk(pkey);
2246 DEFUN("ossl-dsa-pkey-p", Fossl_dsa_pkey_p, 1, 1, 0, /*
2247 Return t iff PKEY is of DSA type.
2253 if (!EVPPKEYP(pkey))
2256 pk = (XEVPPKEY(pkey))->evp_pkey;
2264 dsa_get_public(EVP_PKEY *pk)
2269 memcpy(key, (pk->pkey).dsa, sizeof(DSA));
2271 /* now kill the private data */
2272 key->priv_key = NULL;
2277 DEFUN("ossl-dsa-subkey-p", Fossl_dsa_subkey_p, 2, 2, 0, /*
2278 Return t iff PKEY1 is a subkey of PKEY2.
2279 I.e. if PKEY1 has the same public key data as PKEY2 and
2280 PKEY2 has all private data.
2282 This function is not native OpenSSL.
2291 CHECK_EVPPKEY(pkey1);
2292 CHECK_EVPPKEY(pkey2);
2294 pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2295 pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2297 /* perform a type check first */
2298 if (!dsa_pkey_p(pk1))
2299 error ("pkey1 must be of DSA type");
2300 if (!dsa_pkey_p(pk2))
2301 error ("pkey2 must be of DSA type");
2303 dk1 = (pk1->pkey).dsa;
2304 dk2 = (pk2->pkey).dsa;
2306 if (dsa_pkey_has_private_data(dk2) &&
2307 dsa_pkey_has_public_data(dk1) &&
2308 (!BN_cmp(dk1->p, dk2->p)) &&
2309 (!BN_cmp(dk1->q, dk2->q)) &&
2310 (!BN_cmp(dk1->g, dk2->g)) &&
2311 (!BN_cmp(dk1->pub_key, dk2->pub_key)))
2316 #endif /* OPENSSL_NO_DSA */
2321 ec_pkey_p(EVP_PKEY *pkey)
2325 type = EVP_PKEY_type(pkey->type);
2327 #ifndef OPENSSL_NO_EC
2328 return (type == EVP_PKEY_EC);
2333 #ifndef OPENSSL_NO_EC
2335 ec_pkey_has_public_data(EC_KEY *ec_key)
2337 return (!(EC_KEY_get0_group(ec_key) == NULL) &&
2338 !(EC_KEY_get0_public_key(ec_key) == NULL));
2341 ec_pkey_has_private_data(EC_KEY *ec_key)
2343 return (ec_pkey_has_public_data(ec_key) &&
2344 !(EC_KEY_get0_private_key(ec_key) == NULL));
2347 DEFUN("ossl-ec-available-curves", Fossl_ec_available_curves, 0, 0, 0, /*
2348 Return a list of builtin elliptic curves.
2352 EC_builtin_curve *curves = NULL;
2353 size_t crv_len = 0, n = 0;
2354 Lisp_Object lcurves;
2358 crv_len = EC_get_builtin_curves(NULL, 0);
2359 curves = OPENSSL_malloc(sizeof(EC_builtin_curve) * crv_len);
2362 error ("no curves defined");
2364 if (!EC_get_builtin_curves(curves, crv_len)) {
2365 OPENSSL_free(curves);
2366 error ("error during initialisation of curves");
2369 for (n = 0; n < crv_len; n++) {
2370 int nid = curves[n].nid;
2371 lcurves = Fcons(intern(OBJ_nid2sn(nid)), lcurves);
2374 OPENSSL_free(curves);
2380 ec_curve_by_name(char *name)
2382 return OBJ_sn2nid(name);
2385 DEFUN("ossl-ec-generate-key", Fossl_ec_generate_key, 1, 1, 0, /*
2386 Return a EC public key on CURVE.
2387 CURVE may be any symbol from `ossl-ec-available-curves'.
2389 At the moment we do not support creating custom curves.
2394 EC_KEY *eckey = EC_KEY_new();
2396 CHECK_SYMBOL(curve);
2398 pkey = EVP_PKEY_new();
2399 eckey = EC_KEY_new_by_curve_name(
2400 ec_curve_by_name((char *)string_data(XSYMBOL(curve)->name)));
2402 if ((eckey == NULL)) {
2403 error ("no such curve");
2406 if (!EC_KEY_generate_key(eckey))
2407 error ("error during generation of EC key");
2409 EVP_PKEY_assign_EC_KEY(pkey, eckey);
2411 return make_evp_pkey_pk(pkey);
2414 DEFUN("ossl-ec-pkey-p", Fossl_ec_pkey_p, 1, 1, 0, /*
2415 Return t iff PKEY is of EC type.
2422 if (!EVPPKEYP(pkey))
2425 pk = (XEVPPKEY(pkey))->evp_pkey;
2426 type = EVP_PKEY_type(pk->type);
2427 if (type == EVP_PKEY_EC)
2434 ec_get_public(EVP_PKEY *pk)
2438 key = EC_KEY_dup((pk->pkey).ec);
2440 /* now kill the private data */
2441 EC_KEY_set_private_key(key, NULL);
2445 #endif /* OPENSSL_NO_EC */
2450 dh_pkey_p(EVP_PKEY *pkey)
2454 type = EVP_PKEY_type(pkey->type);
2456 #ifndef OPENSSL_NO_DH
2457 return (type == EVP_PKEY_DH);
2462 #ifndef OPENSSL_NO_DH
2464 dh_pkey_has_public_data(DH *dhkey)
2466 return (!(dhkey->p == NULL) &&
2467 !(dhkey->g == NULL) &&
2468 !(dhkey->pub_key == NULL));
2471 dh_pkey_has_private_data(DH *dhkey)
2473 return (dh_pkey_has_public_data(dhkey) &&
2474 !(dhkey->priv_key == NULL));
2477 DEFUN("ossl-dh-pkey-p", Fossl_dh_pkey_p, 1, 1, 0, /*
2478 Return t iff PKEY is of DH type.
2484 if (!EVPPKEYP(pkey))
2487 pk = (XEVPPKEY(pkey))->evp_pkey;
2495 #endif /* OPENSSL_NO_DH */
2498 /* more general access functions */
2499 DEFUN("ossl-seal", Fossl_seal, 3, 3, 0, /*
2500 Return an envelope derived from encrypting STRING by CIPHER under PKEY
2501 with the hybrid technique.
2503 That is, create a random key/iv pair for the symmetric encryption with
2504 CIPHER and encrypt that key/iv asymmetrically with the provided public
2507 The envelope returned is a list
2508 \(encrypted_string encrypted_key encrypted_iv\)
2510 `encrypted_string' is the (symmetrically) encrypted message
2511 `encrypted_key' is the (asymmetrically) encrypted random key
2512 `encrypted_iv' is the (asymmetrically) encrypted random iv
2514 Note: You probably want to put a wrapping encoder function
2515 (like `base16-encode-string') around it, since this function
2516 returns binary string data.
2518 (cipher, string, pkey))
2520 /* declarations for the cipher */
2521 const EVP_CIPHER *ciph;
2522 EVP_CIPHER_CTX ciphctx;
2523 /* declarations for the pkey */
2526 unsigned char *ekey;
2529 /* buffer for the generated IV */
2530 char iv[EVP_MAX_IV_LENGTH];
2532 /* buffer for output */
2533 unsigned char *outbuf;
2534 unsigned int outlen;
2535 Lisp_Object l_outbuf;
2536 /* buffer for external string data */
2543 CHECK_SYMBOL(cipher);
2544 CHECK_STRING(string);
2545 CHECK_EVPPKEY(pkey);
2548 pk[0] = (XEVPPKEY(pkey))->evp_pkey;
2549 if (!ossl_pkey_has_public_data(pk[0])) {
2550 error ("cannot seal, key has no public key data");
2554 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2555 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2556 string_len = OSSL_STRING_LENGTH(string);
2558 OpenSSL_add_all_algorithms();
2559 ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2563 error ("no such cipher");
2567 /* alloc ekey buffer */
2568 ekey = (unsigned char*)xmalloc_atomic(EVP_PKEY_size(pk[0]));
2570 /* now allocate some output buffer externally
2571 * this one has to be at least EVP_CIPHER_block_size bigger
2572 * since block algorithms merely operate blockwise
2574 outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string) +
2575 EVP_CIPHER_block_size(ciph));
2577 EVP_CIPHER_CTX_init(&ciphctx);
2578 if (!(EVP_SealInit(&ciphctx, ciph,
2580 (unsigned char *)&iv,
2581 (EVP_PKEY **)&pk, npubk)==npubk)) {
2585 error ("error in SealInit");
2588 if (!EVP_SealUpdate(&ciphctx, outbuf, (int *)&outlen,
2589 (unsigned char*)string_ext, string_len)) {
2593 error ("error in SealUpdate");
2596 if (!EVP_SealFinal(&ciphctx, (unsigned char*)outbuf+outlen, &tmplen)) {
2600 error ("error in SealFinal");
2603 /* added probable padding space to the length of the output buffer */
2605 EVP_CIPHER_CTX_cleanup(&ciphctx);
2607 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2608 l_ekey = make_ext_string((char *)ekey, ekey_len, OSSL_CODING);
2609 l_iv = make_ext_string(iv,EVP_CIPHER_iv_length(ciph), OSSL_CODING);
2614 return list3(l_outbuf, l_ekey, l_iv);
2618 DEFUN("ossl-open", Fossl_open, 4, 5, 0, /*
2619 Return the deciphered message STRING from an envelope
2620 obtained by `ossl-seal'.
2622 CIPHER is the cipher to use (the same as in `ossl-seal')
2623 STRING is the encrypted message
2624 PKEY is the private key
2625 EKEY is the encrypted random key
2626 EIV is the encrypted iv
2628 (cipher, string, pkey, ekey, eiv))
2630 /* declarations for the cipher */
2631 const EVP_CIPHER *ciph;
2632 EVP_CIPHER_CTX ciphctx;
2633 /* declarations for the pkey */
2635 /* buffer for external ekey data */
2638 /* buffer for external eiv data */
2640 /* buffer for output */
2641 unsigned char *outbuf;
2642 unsigned int outlen;
2643 Lisp_Object l_outbuf;
2644 /* buffer for external string data */
2651 CHECK_SYMBOL(cipher);
2652 CHECK_STRING(string);
2653 CHECK_EVPPKEY(pkey);
2657 pk = (XEVPPKEY(pkey))->evp_pkey;
2658 if (!ossl_pkey_has_private_data(pk))
2659 error ("cannot open, key has no private key data");
2661 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2662 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2663 string_len = OSSL_STRING_LENGTH(string);
2664 TO_EXTERNAL_FORMAT (LISP_STRING, ekey,
2665 C_STRING_ALLOCA, ekey_ext, OSSL_CODING);
2666 ekey_len = OSSL_STRING_LENGTH(ekey);
2668 OpenSSL_add_all_algorithms();
2669 ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2673 error ("no such cipher");
2681 TO_EXTERNAL_FORMAT (LISP_STRING, eiv,
2682 C_STRING_ALLOCA, eiv_ext, OSSL_CODING);
2685 /* now allocate some output buffer externally */
2686 outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string));
2688 EVP_CIPHER_CTX_init(&ciphctx);
2689 if (!EVP_OpenInit(&ciphctx, ciph,
2690 (unsigned char*)ekey_ext,
2691 (unsigned int)ekey_len,
2692 (unsigned char*)eiv_ext, pk)) {
2695 error ("error in OpenInit");
2698 if (!EVP_OpenUpdate(&ciphctx, outbuf, (int *)&outlen,
2699 (unsigned char*)string_ext,
2700 (unsigned int)string_len)) {
2703 error ("error in OpenUpdate");
2706 if (!EVP_OpenFinal(&ciphctx, outbuf+outlen, &tmplen)) {
2709 error ("error in OpenFinal");
2712 /* added probable padding space to the length of the output buffer */
2714 EVP_CIPHER_CTX_cleanup(&ciphctx);
2716 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2725 DEFUN("ossl-sign", Fossl_sign, 3, 3, 0, /*
2726 Return a signature obtained by signing STRING under DIGEST with PKEY.
2728 That is, hash the message STRING with the message digest DIGEST and
2729 encrypt the result with the private key PKEY.
2731 Note: Due to some relationship between the public key system and the
2732 message digest you cannot use every digest algorithm with every
2734 The most certain results will be achieved using
2735 RSA keys with RSA-* digests, DSA keys with DSA-* digests.
2737 See `ossl-available-digests'.
2739 Note: You probably want to put a wrapping encoder function
2740 (like `base16-encode-string') around it, since this returns
2743 (digest, string, pkey))
2745 /* declarations for the cipher */
2748 /* declarations for the pkey */
2750 /* buffer for output */
2751 unsigned char *outbuf;
2752 unsigned int outlen;
2753 Lisp_Object l_outbuf;
2754 /* buffer for external string data */
2759 CHECK_SYMBOL(digest);
2760 CHECK_STRING(string);
2761 CHECK_EVPPKEY(pkey);
2764 pk = (XEVPPKEY(pkey))->evp_pkey;
2765 if (!ossl_pkey_has_private_data(pk)) {
2766 error ("cannot sign, key has no private key data");
2769 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2770 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2771 string_len = OSSL_STRING_LENGTH(string);
2773 OpenSSL_add_all_algorithms();
2774 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2778 error ("no such digest");
2782 /* now allocate some output buffer externally */
2783 outbuf = (unsigned char *)xmalloc_atomic(EVP_PKEY_size(pk));
2785 EVP_MD_CTX_init(&mdctx);
2786 if (!(EVP_SignInit(&mdctx, md))) {
2789 error ("error in SignInit");
2792 if (!EVP_SignUpdate(&mdctx, string_ext, string_len)) {
2795 error ("error in SignUpdate");
2798 if (!EVP_SignFinal(&mdctx, outbuf, &outlen, pk)) {
2801 error ("error in SignFinal");
2804 EVP_MD_CTX_cleanup(&mdctx);
2806 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2814 DEFUN("ossl-verify", Fossl_verify, 4, 4, 0, /*
2815 Return t iff SIG is a valid signature of STRING under DIGEST obtained by PKEY.
2817 That is, hash the message STRING with the message digest DIGEST, then
2818 decrypt the signature SIG with the public key PKEY.
2819 Compare the results and return t iff both hashes are equal.
2821 DIGEST is the digest to use (the same as in `ossl-sign')
2822 STRING is the message
2823 SIG is the signature of message
2824 PKEY is the public key
2826 (digest, string, sig, pkey))
2828 /* declarations for the cipher */
2831 /* declarations for the pkey */
2833 /* buffer for external signature data */
2836 /* buffer for external string data */
2843 CHECK_SYMBOL(digest);
2844 CHECK_STRING(string);
2846 CHECK_EVPPKEY(pkey);
2849 pk = (XEVPPKEY(pkey))->evp_pkey;
2850 if (!ossl_pkey_has_public_data(pk))
2851 error ("cannot verify, key has no public key data");
2853 OpenSSL_add_all_algorithms();
2854 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2858 error ("no such digest");
2862 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2863 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2864 string_len = OSSL_STRING_LENGTH(string);
2865 TO_EXTERNAL_FORMAT (LISP_STRING, sig,
2866 C_STRING_ALLOCA, sig_ext, OSSL_CODING);
2867 sig_len = OSSL_STRING_LENGTH(sig);
2869 EVP_MD_CTX_init(&mdctx);
2870 if (!EVP_VerifyInit(&mdctx, md)) {
2872 error ("error in VerifyInit");
2875 if (!EVP_VerifyUpdate(&mdctx, string_ext, string_len)) {
2877 error ("error in VerifyUpdate");
2880 result = EVP_VerifyFinal(&mdctx, (unsigned char*)sig_ext, sig_len, pk);
2883 error ("error in VerifyFinal");
2886 EVP_MD_CTX_cleanup(&mdctx);
2890 return result ? Qt : Qnil;
2899 DEFUN("ossl-pem-read-public-key", Fossl_pem_read_public_key, 1, 1, 0, /*
2900 Return a key (the public part) stored in a PEM structure from FILE.
2904 /* declarations for the pkey */
2913 file = Fexpand_file_name(file, Qnil);
2915 if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2916 error ("error opening file.");
2918 pk509 = PEM_read_X509(fp, NULL, NULL, NULL);
2919 pk = PEM_read_PUBKEY(fp, NULL, NULL, NULL);
2923 return make_evp_pkey(pk, pk509);
2926 DEFUN("ossl-pem-read-key", Fossl_pem_read_key, 1, 2, 0, /*
2927 Return a key stored in a PEM structure from FILE.
2928 If the (private part of the) key is protected with a password
2929 provide (optional) PASSWORD.
2933 /* declarations for the pkey */
2937 /* password pointer */
2942 file = Fexpand_file_name(file, Qnil);
2944 if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2945 error ("error opening file.");
2947 if (NILP(password)) {
2950 CHECK_STRING(password);
2951 pass = (char *)XSTRING_DATA(password);
2954 pk = PEM_read_PrivateKey(fp, NULL, NULL, pass);
2957 /* now maybe it is a public key only */
2958 return Fossl_pem_read_public_key(file);
2961 return make_evp_pkey_pk(pk);
2964 DEFUN("ossl-pem-write-public-key", Fossl_pem_write_public_key, 2, 2, 0, /*
2965 Write PKEY (the public part) in a PEM structure to FILE.
2969 /* declarations for the pkey */
2976 CHECK_EVPPKEY(pkey);
2978 file = Fexpand_file_name(file, Qnil);
2980 pk = XEVPPKEY(pkey)->evp_pkey;
2981 pk509 = XEVPPKEY(pkey)->x509;
2983 if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL)
2984 error ("error opening file.");
2986 if (!PEM_write_PUBKEY(fp, pk)) {
2988 error ("error writing PEM file.");
2996 DEFUN("ossl-pem-write-key", Fossl_pem_write_key, 2, 4, 0, /*
2997 Write PKEY in a PEM structure to FILE. The key itself is
2998 protected by (optional) CIPHER with PASSWORD.
3000 CIPHER can be set to nil and the key will not be encrypted.
3001 PASSWORD is ignored in this case.
3003 (file, pkey, cipher, password))
3005 const EVP_CIPHER *ciph;
3006 /* declarations for the pkey */
3011 /* password pointer */
3015 CHECK_EVPPKEY(pkey);
3017 file = Fexpand_file_name(file, Qnil);
3019 pk = XEVPPKEY(pkey)->evp_pkey;
3020 pk509 = XEVPPKEY(pkey)->x509;
3022 if (!ossl_pkey_has_private_data(pk))
3023 return Fossl_pem_write_public_key(file, pkey);
3025 CHECK_SYMBOL(cipher);
3027 OpenSSL_add_all_algorithms();
3033 ciph = EVP_get_cipherbyname(
3034 (char *)string_data(XSYMBOL(cipher)->name));
3037 error ("no such cipher");
3041 if (NILP(password)) {
3045 CHECK_STRING(password);
3046 pass = (char *)XSTRING_DATA(password);
3049 if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL) {
3051 error ("error opening file.");
3054 if (!PEM_write_PKCS8PrivateKey(fp, pk, ciph, NULL, 0, NULL, pass)) {
3057 error ("error writing PEM file.");
3067 ossl_pem_pkey_cb(BIO *bio, int cmd, const char *argp,
3068 int argi, long argl, long ret)
3071 void *foo = BIO_get_callback_arg(bio);
3073 if (!(key = (Lisp_Object)foo)) {
3077 if (BIO_CB_RETURN & cmd) {
3083 key = concat2(key, make_ext_string(argp, argi, OSSL_CODING));
3084 BIO_set_callback_arg(bio, (void*)key);
3092 DEFUN("ossl-pem-public-key",Fossl_pem_public_key, 1, 1, 0, /*
3093 Return PKEY as PEM encoded string.
3097 /* This function can GC */
3098 /* declarations for the pkey */
3104 struct gcpro gcpro1;
3108 CHECK_EVPPKEY(pkey);
3110 pk = (XEVPPKEY(pkey))->evp_pkey;
3112 if (!(b = BIO_new(BIO_s_null()))) {
3114 error("cannot open memory buffer");
3118 result = build_string("");
3119 BIO_set_callback(b, ossl_pem_pkey_cb);
3120 BIO_set_callback_arg(b, (void*)result);
3122 if (!PEM_write_bio_PUBKEY(b, pk)) {
3126 error ("error creating PEM string");
3131 void *foo = BIO_get_callback_arg(b);
3132 if (!(result = (Lisp_Object)foo)) {
3143 DEFUN("ossl-pem-key",Fossl_pem_key, 1, 3, 0, /*
3144 Return PKEY as PEM encoded string. The key itself is
3145 protected by (optional) CIPHER with PASSWORD.
3147 CIPHER can be set to nil and the key will not be encrypted.
3148 PASSWORD is ignored in this case.
3150 (pkey, cipher, password))
3152 /* This function can GC */
3153 /* declarations for the pkey */
3156 const EVP_CIPHER *ciph;
3160 struct gcpro gcpro1, gcpro2, gcpro3;
3162 GCPRO3(pkey, cipher, password);
3164 CHECK_EVPPKEY(pkey);
3166 pk = (XEVPPKEY(pkey))->evp_pkey;
3168 if (!ossl_pkey_has_private_data(pk)) {
3170 return Fossl_pem_public_key(pkey);
3173 CHECK_SYMBOL(cipher);
3175 OpenSSL_add_all_algorithms();
3181 ciph = EVP_get_cipherbyname(
3182 (char *)string_data(XSYMBOL(cipher)->name));
3186 error ("no such cipher");
3191 if (NILP(password)) {
3195 CHECK_STRING(password);
3196 pass = (char *)XSTRING_DATA(password);
3199 if (!(b = BIO_new(BIO_s_null()))) {
3201 error("cannot open memory buffer");
3205 result = build_string("");
3206 BIO_set_callback(b, ossl_pem_pkey_cb);
3207 BIO_set_callback_arg(b, (void*)result);
3209 if (!PEM_write_bio_PKCS8PrivateKey(b, pk, ciph, NULL, 0, NULL, pass)) {
3213 error ("error creating PEM string");
3218 void *foo = BIO_get_callback_arg(b);
3220 if (!(result = (Lisp_Object)foo)) {
3235 * The SSL support in this API is sorta high level since having
3236 * server hellos, handshakes and stuff like that is not what you want
3240 /* This is an opaque object for storing PKEYs in lisp */
3241 Lisp_Object Qssl_connp;
3244 make_ssl_conn(Lisp_SSL_CONN *ssl_conn)
3246 Lisp_Object lisp_ssl_conn;
3247 XSETSSLCONN(lisp_ssl_conn, ssl_conn);
3248 return lisp_ssl_conn;
3252 mark_ssl_conn(Lisp_Object obj)
3254 mark_object(XSSLCONN(obj)->parent);
3255 mark_object(XSSLCONN(obj)->pipe_instream);
3256 mark_object(XSSLCONN(obj)->pipe_outstream);
3258 mark_object(XSSLCONN(obj)->coding_instream);
3259 mark_object(XSSLCONN(obj)->coding_outstream);
3266 print_ssl_conn(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3271 conn = XSSLCONN(obj)->ssl_conn;
3272 parent = XSSLCONN(obj)->parent;
3274 write_c_string("#<OpenSSL socket layer: ", printcharfun);
3276 write_c_string("dead", printcharfun);
3278 write_c_string(SSL_get_version(conn), printcharfun);
3281 if (PROCESSP(parent)) {
3282 write_c_string(" on top of ", printcharfun);
3283 print_internal(parent, printcharfun, escapeflag);
3285 #endif /* HAVE_SOCKETS */
3287 #ifdef HAVE_POSTGRESQL
3288 if (PGCONNP(parent) &&
3289 PQstatus(XPGCONN(parent)->pgconn) == CONNECTION_OK) {
3290 write_c_string(" on top of ", printcharfun);
3291 print_internal(parent, printcharfun, escapeflag);
3293 #endif /* HAVE_POSTGRESQL */
3294 write_c_string(">", printcharfun);
3298 allocate_ssl_conn(void)
3300 Lisp_SSL_CONN *ssl_conn =
3301 alloc_lcrecord_type(Lisp_SSL_CONN, &lrecord_ssl_conn);
3303 /* the network process stuff */
3304 ssl_conn->parent = Qnil;
3305 ssl_conn->infd = -1;
3306 ssl_conn->outfd = -1;
3308 ssl_conn->connected_p = 0;
3309 ssl_conn->protected_p = 0;
3311 ssl_conn->pipe_instream = Qnil;
3312 ssl_conn->pipe_outstream = Qnil;
3314 ssl_conn->coding_instream = Qnil;
3315 ssl_conn->coding_outstream = Qnil;
3322 finalise_ssl_conn(void *header, int for_disksave)
3324 Lisp_SSL_CONN *ssl_conn = (Lisp_SSL_CONN *) header;
3326 if (!(ssl_conn->ssl_conn == NULL)) {
3327 if (ssl_conn->connected_p)
3328 SSL_shutdown(ssl_conn->ssl_conn);
3329 SSL_free(ssl_conn->ssl_conn);
3330 ssl_conn->ssl_conn = NULL;
3332 if (!(ssl_conn->ssl_ctx == NULL)) {
3333 SSL_CTX_free(ssl_conn->ssl_ctx);
3334 ssl_conn->ssl_ctx = NULL;
3336 ssl_conn->ssl_bio = NULL;
3338 if (PROCESSP(ssl_conn->parent)) {
3339 XPROCESS(ssl_conn->parent)->process_type = PROCESS_TYPE_NETWORK;
3340 XPROCESS(ssl_conn->parent)->process_type_data = Qnil;
3342 /* we leave the process alive, it's not our fault, but
3343 * we nullify its pointer
3345 ssl_conn->parent = Qnil;
3346 ssl_conn->infd = -1;
3347 ssl_conn->outfd = -1;
3349 ssl_conn->connected_p = 0;
3350 ssl_conn->protected_p = 0;
3352 /* free the lstream resources */
3353 #if 0 /* will lead to problems */
3354 if (LSTREAMP(ssl_conn->pipe_instream))
3355 Lstream_delete(XLSTREAM(ssl_conn->pipe_instream));
3356 if (LSTREAMP(ssl_conn->pipe_outstream))
3357 Lstream_delete(XLSTREAM(ssl_conn->pipe_outstream));
3359 ssl_conn->pipe_instream = Qnil;
3360 ssl_conn->pipe_outstream = Qnil;
3362 #if 0 /* will lead to problems */
3363 if (LSTREAMP(ssl_conn->coding_instream))
3364 Lstream_delete(XLSTREAM(ssl_conn->coding_instream));
3365 if (LSTREAMP(ssl_conn->coding_outstream))
3366 Lstream_delete(XLSTREAM(ssl_conn->coding_outstream));
3368 ssl_conn->coding_instream = Qnil;
3369 ssl_conn->coding_outstream = Qnil;
3372 /* avoid some warning */
3376 DEFINE_LRECORD_IMPLEMENTATION("ssl_conn", ssl_conn,
3377 mark_ssl_conn, print_ssl_conn,
3379 NULL, NULL, 0, Lisp_SSL_CONN);
3382 ssl_conn_alive_p(Lisp_SSL_CONN *ssl_conn)
3384 return ssl_conn->connected_p;
3388 get_process_infd(Lisp_Process * p)
3390 Lisp_Object instr, outstr;
3391 get_process_streams(p, &instr, &outstr);
3392 return Lstream_get_fd(XLSTREAM(instr));
3395 get_process_outfd(Lisp_Process * p)
3397 Lisp_Object instr, outstr;
3398 get_process_streams(p, &instr, &outstr);
3399 return Lstream_get_fd(XLSTREAM(outstr));
3403 event_stream_ssl_create_stream_pair(
3405 Lisp_Object *instream, Lisp_Object *outstream, int flags)
3407 *instream = make_ssl_input_stream(conn, flags);
3408 *outstream = make_ssl_output_stream(conn, flags);
3414 init_ssl_io_handles(Lisp_SSL_CONN *s, int flags)
3416 event_stream_ssl_create_stream_pair(
3417 s->ssl_conn, &s->pipe_instream, &s->pipe_outstream, flags);
3420 s->coding_instream = make_decoding_input_stream(
3421 XLSTREAM(s->pipe_instream), Fget_coding_system(
3422 Vcoding_system_for_read));
3423 Lstream_set_character_mode(XLSTREAM(s->coding_instream));
3424 s->coding_outstream = make_encoding_output_stream(
3425 XLSTREAM(s->pipe_outstream), Fget_coding_system(
3426 Vcoding_system_for_write));
3427 #endif /* FILE_CODING */
3430 /* Advanced step-by-step initialisation */
3431 #define OSSL_CHECK_PROCESS(process) \
3433 /* Make sure the process is really alive. */ \
3434 if (!EQ(XPROCESS(process)->status_symbol, Qrun)) \
3435 error("Network stream %s not alive", \
3436 XSTRING_DATA(XPROCESS(process)->name)); \
3437 /* Make sure the process is a network stream. */ \
3438 if (!network_connection_p(process)) \
3439 error("Process %s is not a network stream", \
3440 XSTRING_DATA(XPROCESS(process)->name)); \
3443 #ifdef OSSL_DEBUG_FLAG
3445 ossl_bio_dump_callback(BIO *bio, int cmd, const char *argp,
3446 int argi, long argl, long ret)
3450 out=(BIO *)BIO_get_callback_arg(bio);
3451 if (out == NULL) return(ret);
3453 if (cmd == (BIO_CB_READ|BIO_CB_RETURN))
3455 BIO_printf(out,"read from %p [%p] (%d bytes => %ld (0x%lX))\n",
3456 (void *)bio,argp,argi,ret,ret);
3457 BIO_dump(out,argp,(int)ret);
3460 else if (cmd == (BIO_CB_WRITE|BIO_CB_RETURN))
3462 BIO_printf(out,"write to %p [%p] (%d bytes => %ld (0x%lX))\n",
3463 (void *)bio,argp,argi,ret,ret);
3464 BIO_dump(out,argp,(int)ret);
3471 ossl_ssl_prepare_cmeth(Lisp_Object method)
3473 SSL_METHOD *meth = NULL;
3474 Lisp_SSL_CONN *lisp_ssl_conn;
3476 /* start preparing the conn object */
3478 SSL_load_error_strings();
3481 else if (EQ(method, Qssl2))
3482 meth = (SSL_METHOD *)SSLv2_client_method();
3483 else if (EQ(method, Qssl3))
3484 meth = (SSL_METHOD *)SSLv3_client_method();
3485 else if (EQ(method, Qssl23))
3486 meth = (SSL_METHOD *)SSLv23_client_method();
3487 else if (EQ(method, Qtls1))
3488 meth = (SSL_METHOD *)TLSv1_client_method();
3490 meth = (SSL_METHOD *)TLSv1_client_method();
3493 error("OSSL: not enough random data");
3495 /* now allocate this stuff, pump it and return */
3496 lisp_ssl_conn = allocate_ssl_conn();
3497 lisp_ssl_conn->ssl_meth = meth;
3498 lisp_ssl_conn->ssl_ctx = NULL;
3499 lisp_ssl_conn->ssl_conn = NULL;
3500 lisp_ssl_conn->ssl_bio = NULL;
3502 return make_ssl_conn(lisp_ssl_conn);
3506 ossl_ssl_prepare_smeth(Lisp_Object method)
3508 SSL_METHOD *meth = NULL;
3509 Lisp_SSL_CONN *lisp_ssl_conn;
3511 /* start preparing the conn object */
3513 SSL_load_error_strings();
3516 else if (EQ(method, Qssl2))
3517 meth = (SSL_METHOD *)SSLv2_server_method();
3518 else if (EQ(method, Qssl3))
3519 meth = (SSL_METHOD *)SSLv3_server_method();
3520 else if (EQ(method, Qssl23))
3521 meth = (SSL_METHOD *)SSLv23_server_method();
3522 else if (EQ(method, Qtls1))
3523 meth = (SSL_METHOD *)TLSv1_server_method();
3525 meth = (SSL_METHOD *)SSLv23_server_method();
3528 error("OSSL: not enough random data");
3530 /* now allocate this stuff, pump it and return */
3531 lisp_ssl_conn = allocate_ssl_conn();
3532 lisp_ssl_conn->ssl_meth = meth;
3533 lisp_ssl_conn->ssl_ctx = NULL;
3534 lisp_ssl_conn->ssl_conn = NULL;
3535 lisp_ssl_conn->ssl_bio = NULL;
3537 return make_ssl_conn(lisp_ssl_conn);
3541 ossl_ssl_prepare_ctx(Lisp_Object ssl_conn)
3543 /* SSL connection stuff */
3544 SSL_CTX *ctx = NULL;
3545 Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3547 ctx = SSL_CTX_new(lisp_ssl_conn->ssl_meth);
3549 error("OSSL: context initialisation failed");
3551 /* OpenSSL contains code to work-around lots of bugs and flaws in
3552 * various SSL-implementations. SSL_CTX_set_options() is used to enabled
3553 * those work-arounds. The man page for this option states that
3554 * SSL_OP_ALL enables all the work-arounds and that "It is usually safe
3555 * to use SSL_OP_ALL to enable the bug workaround options if
3556 * compatibility with somewhat broken implementations is desired."
3558 SSL_CTX_set_options(ctx, SSL_OP_ALL);
3560 lisp_ssl_conn->ssl_ctx = ctx;
3566 ossl_ssl_prepare(Lisp_Object ssl_conn, void(*fun)(SSL*))
3568 /* SSL connection stuff */
3571 #ifdef OSSL_DEBUG_FLAG
3572 BIO *bio_c_out = NULL;
3574 Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3576 /* now initialise a new connection context */
3577 conn = SSL_new(lisp_ssl_conn->ssl_ctx);
3578 if (conn == NULL || fun == NULL)
3579 error("OSSL: connection initialisation failed");
3581 /* always renegotiate */
3582 SSL_set_mode(conn, SSL_MODE_AUTO_RETRY);
3584 /* initialise the main connection BIO */
3585 bio = BIO_new(BIO_s_socket());
3587 #ifdef OSSL_DEBUG_FLAG
3588 /* this is a debug BIO which pukes tons of stuff to stderr */
3589 bio_c_out = BIO_new_fp(stderr, BIO_NOCLOSE);
3590 BIO_set_callback(bio, ossl_bio_dump_callback);
3591 BIO_set_callback_arg(bio, bio_c_out);
3594 /* connect SSL with the bio */
3595 SSL_set_bio(conn, bio, bio);
3596 /* turn into client or server */
3599 /* now allocate this stuff, pump it and return */
3600 lisp_ssl_conn->ssl_conn = conn;
3601 lisp_ssl_conn->ssl_bio = bio;
3603 /* create lstream handles */
3604 init_ssl_io_handles(lisp_ssl_conn, STREAM_NETWORK_CONNECTION);
3609 /* Injection of CA certificates */
3610 int ossl_ssl_inject_ca(Lisp_Object ssl_conn, Lisp_Object cacert)
3616 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3617 cert = XEVPPKEY(cacert)->evp_pkey;
3618 xc509 = XEVPPKEY(cacert)->x509;
3620 if (cert && !xc509) {
3622 X509_set_pubkey(xc509, cert);
3623 XEVPPKEY(cacert)->x509 = xc509;
3628 /* what about coding system issues? */
3629 if (!SSL_CTX_add_client_CA(ctx, xc509))
3635 int ossl_ssl_inject_ca_file(Lisp_Object ssl_conn, Lisp_Object cafile)
3639 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3641 /* what about coding system issues? */
3642 if (!SSL_CTX_load_verify_locations(
3643 ctx, (char*)XSTRING_DATA(cafile), NULL))
3649 int ossl_ssl_inject_ca_path(Lisp_Object ssl_conn, Lisp_Object capath)
3653 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3655 /* what about coding system issues? */
3656 if (!SSL_CTX_load_verify_locations(
3657 ctx, NULL, (char*)XSTRING_DATA(capath)))
3663 int ossl_ssl_inject_cert(Lisp_Object ssl_conn,
3664 Lisp_Object cert, Lisp_Object key)
3671 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3672 pkey = XEVPPKEY(key)->evp_pkey;
3673 xcert = XEVPPKEY(cert)->evp_pkey;
3674 xc509 = XEVPPKEY(cert)->x509;
3676 if (xcert && !xc509) {
3678 X509_set_pubkey(xc509, xcert);
3679 XEVPPKEY(cert)->x509 = xc509;
3684 if (SSL_CTX_use_certificate(ctx, xc509) <= 0)
3687 if (SSL_CTX_use_PrivateKey(ctx, pkey) <= 0)
3689 if (!SSL_CTX_check_private_key(ctx))
3695 int ossl_ssl_inject_cert_file(Lisp_Object ssl_conn,
3696 Lisp_Object cert, Lisp_Object key)
3700 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3702 if (SSL_CTX_use_certificate_file(
3703 ctx, (char*)XSTRING_DATA(cert), SSL_FILETYPE_PEM) <= 0)
3705 if (SSL_CTX_use_PrivateKey_file(
3706 ctx, (char*)XSTRING_DATA(key), SSL_FILETYPE_PEM) <= 0)
3708 if (!SSL_CTX_check_private_key(ctx))
3714 Lisp_Object ossl_ssl_handshake(Lisp_Object ssl_conn, Lisp_Object process)
3716 /* This function can GC */
3717 /* SSL connection stuff */
3720 #if 0 && defined(OSSL_DEBUG_FLAG)
3721 BIO *bio_c_out = NULL;
3723 int ret, err, infd, outfd;
3725 struct gcpro gcpro1, gcpro2;
3727 /* Make sure we have a process, the alive check should be done in the
3728 function calling this here */
3729 CHECK_PROCESS(process);
3731 GCPRO2(ssl_conn, process);
3733 /* set the alternate one */
3734 event_stream_unselect_process(XPROCESS(process));
3737 /* just announce that we are very binary */
3738 Fset_process_coding_system(process, Qbinary, Qbinary);
3741 /* initialise the process' buffer for type-specific data,
3742 * we will store process input there */
3743 XPROCESS(process)->process_type_data = Qnil;
3745 /* retrieve the sockets of the process */
3746 infd = get_process_infd(XPROCESS(process));
3747 outfd = get_process_outfd(XPROCESS(process));
3749 /* push data to ssl_conn */
3750 XSSLCONN(ssl_conn)->parent = process;
3751 XSSLCONN(ssl_conn)->infd = infd;
3752 XSSLCONN(ssl_conn)->outfd = outfd;
3754 /* frob vars from ssl_conn */
3755 conn = XSSLCONN(ssl_conn)->ssl_conn;
3756 bio = XSSLCONN(ssl_conn)->ssl_bio;
3758 /* initialise the main connection BIO */
3759 BIO_set_fd(bio, infd, 0);
3761 /* now perform the actual handshake
3762 * this is a loop because of the genuine openssl concept to not handle
3763 * non-blocking I/O correctly */
3767 ret = SSL_do_handshake(conn);
3768 err = SSL_get_error(conn, ret);
3770 /* perform select() with timeout
3771 * 1 second at the moment */
3775 if (err == SSL_ERROR_NONE) {
3777 } else if (err == SSL_ERROR_WANT_READ) {
3779 OSSL_DEBUG("WANT_READ\n");
3782 FD_SET(infd, &read_fds);
3784 /* wait for socket to be readable */
3785 if (!(ret = select(infd+1, &read_fds, 0, NULL, &to))) {
3787 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3788 error("timeout during handshake");
3791 } else if (err == SSL_ERROR_WANT_WRITE) {
3793 OSSL_DEBUG("WANT_WRITE\n");
3794 FD_ZERO(&write_fds);
3795 FD_SET(outfd, &write_fds);
3797 /* wait for socket to be writable */
3798 if (!(ret = select(infd+1, &write_fds, 0, NULL, &to))) {
3800 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3801 error("timeout during handshake");
3804 } else if (err == SSL_ERROR_SSL) {
3805 /* close down the process object */
3806 Fdelete_process(process);
3809 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3810 error("handshake failed");
3813 OSSL_CRITICAL("\nUnknown error: %d\n"
3815 "sxemacs-devel@sxemacs.org\n\n", err);
3818 /* we used to check whether the connection is
3819 still alive, but this was perhaps a bad idea */
3820 try = BIO_read(bio, buf, 2);
3822 (try < 0 && !BIO_should_retry(bio))) {
3823 /* Handle closed connection */
3824 XPROCESS(process)->exit_code = 256;
3825 XPROCESS(process)->status_symbol = Qexit;
3828 /* close down the process object */
3829 Fdelete_process(process);
3833 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3834 error("unknown handshake error");
3839 /* marry the socket layer now */
3840 ossl_ssl_proselytise_process(ssl_conn, process);
3842 /* declare the whole pig connected */
3843 XSSLCONN(ssl_conn)->connected_p = 1;
3845 event_stream_select_process(XPROCESS(process));
3851 DEFUN("ossl-ssl-inject-cert", Fossl_ssl_inject_cert, 2, 3, 0, /*
3852 Add CERT as the local certificate of SSL-CONN.
3853 Optional argument KEY specifies a key file or evp-pkey, if
3854 CERT does not contain it.
3856 Both, CERT and KEY may be either a filename pointing to a
3857 PEM-encoded certificate and key respectively, or may be an
3860 (ssl_conn, cert, key))
3862 /* This function can GC */
3863 int (*fun)(Lisp_Object, Lisp_Object, Lisp_Object) = NULL;
3864 struct gcpro gcpro1, gcpro2, gcpro3;
3866 GCPRO3(ssl_conn, cert, key);
3868 CHECK_SSLCONN(ssl_conn);
3871 CHECK_EVPPKEY(cert);
3876 /* certificate and key preparation */
3877 if (STRINGP(cert)) {
3878 cert = Fexpand_file_name(cert, Qnil);
3879 if (NILP(Ffile_readable_p(cert)))
3884 key = Fexpand_file_name(key, Qnil);
3885 if (NILP(Ffile_readable_p(key)))
3889 if (STRINGP(cert) && NILP(key))
3891 else if (EVPPKEYP(cert) && NILP(key))
3894 /* certificate and key injection */
3895 if (!NILP(cert) && !NILP(key) &&
3896 STRINGP(cert) && STRINGP(key))
3897 fun = ossl_ssl_inject_cert_file;
3898 else if (!NILP(cert) && !NILP(key) &&
3899 EVPPKEYP(cert) && EVPPKEYP(key))
3900 fun = ossl_ssl_inject_cert;
3902 if (fun && fun(ssl_conn, cert, key)) {
3911 DEFUN("ossl-ssl-inject-ca", Fossl_ssl_inject_ca, 2, 2, 0, /*
3912 Add CA to the pile of certificate authorities of SSL-CONN.
3913 Also force a \(re\)verification of the remote peer certificate
3914 against CA. Return `t' if the injection was successful,
3917 CA may be either a file name pointing to a PEM-encoded
3918 CA certificate, or may be a directory containing a valid
3919 bunch of CA certificates according to OpenSSL's CA path
3920 layout, or may also be an evp-pkey object.
3924 /* This function can GC */
3925 int (*fun)(Lisp_Object, Lisp_Object) = NULL;
3927 struct gcpro gcpro1, gcpro2;
3929 GCPRO2(ssl_conn, ca);
3931 CHECK_SSLCONN(ssl_conn);
3937 ca = Fexpand_file_name(ca, Qnil);
3938 if (NILP(Ffile_readable_p(ca)))
3942 if (!NILP(ca) && STRINGP(ca)) {
3943 if (NILP(Ffile_directory_p(ca)))
3944 fun = ossl_ssl_inject_ca_file;
3946 fun = ossl_ssl_inject_ca_path;
3947 } else if (!NILP(ca) && EVPPKEYP(ca))
3948 fun = ossl_ssl_inject_ca;
3950 if (fun && fun(ssl_conn, ca) &&
3951 (conn = XSSLCONN(ssl_conn)->ssl_conn)) {
3952 ssl_verify_cert_chain(conn, SSL_get_peer_cert_chain(conn));
3961 DEFUN("ossl-ssl-handshake", Fossl_ssl_handshake, 1, 6, 0, /*
3962 Perform a handshake on the network connection PROCESS.
3964 Return a ssl-conn object, or `nil' if the handshake failed.
3965 In the latter case, most likely the remote site cannot handle
3966 the specified method, requires a client certificate, or cannot
3969 Optional argument METHOD indicates the SSL connection method,
3970 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
3972 Optional argument CA indicates a CA certificate.
3973 See `ossl-ssl-inject-ca'.
3975 Optional arguments CERT and KEY indicate a peer certificate
3976 and possibly a separate key file respectively.
3977 See `ossl-ssl-inject-peer-cert'.
3979 Optional argument SERVERP indicates whether to perform the
3980 handshake as a server if non-nil, and as a client otherwise.
3981 Note: In case of a handshake as server it is mandatory to provide
3982 a valid certificate and a corresponding key.
3984 (process, method, ca, cert, key, serverp))
3986 /* This function can GC */
3988 Lisp_Object ssl_conn, result;
3990 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
3992 GCPRO6(process, method, ca, cert, key, serverp);
3994 /* Make sure the process is really alive. */
3995 CHECK_PROCESS(process);
3996 OSSL_CHECK_PROCESS(process);
3998 /* create a ssl_conn object first */
4000 ssl_conn = ossl_ssl_prepare_cmeth(method);
4002 ssl_conn = ossl_ssl_prepare_smeth(method);
4004 /* create the context */
4005 ossl_ssl_prepare_ctx(ssl_conn);
4007 /* certificate and key preparation */
4008 Fossl_ssl_inject_cert(ssl_conn, cert, key);
4009 /* certificate authority preparation */
4010 Fossl_ssl_inject_ca(ssl_conn, ca);
4012 /* prepare for handshake */
4014 ossl_ssl_prepare(ssl_conn, SSL_set_connect_state);
4016 ossl_ssl_prepare(ssl_conn, SSL_set_accept_state);
4018 result = ossl_ssl_handshake(ssl_conn, process);
4024 DEFUN("ossl-ssl-connect", Fossl_ssl_connect, 0, MANY, 0, /*
4025 Perform a TLS or SSL handshake, return a ssl-conn object on
4026 success, or `nil' if the handshake failed.
4027 In the latter case, most likely the remote site cannot handle
4028 the specified method, requires a client certificate, or cannot
4039 Optional argument METHOD indicates the SSL connection method,
4040 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
4042 (int nargs, Lisp_Object *args))
4046 for (i = 0; i < nargs; i++);
4052 ossl_swap_process_streams(Lisp_SSL_CONN *s, Lisp_Process *p)
4054 Lisp_Object in, out;
4056 in = p->pipe_instream;
4057 out = p->pipe_outstream;
4059 p->pipe_instream = s->pipe_instream;
4060 p->pipe_outstream = s->pipe_outstream;
4062 s->pipe_instream = in;
4063 s->pipe_outstream = out;
4066 in = p->coding_instream;
4067 out = p->coding_outstream;
4069 p->coding_instream = s->coding_instream;
4070 p->coding_outstream = s->coding_outstream;
4072 s->coding_instream = in;
4073 s->coding_outstream = out;
4078 ossl_ssl_proselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4080 Lisp_Process *p = XPROCESS(process);
4081 Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4083 event_stream_unselect_process(p);
4085 /* put the streams we have in the ssl-conn object into the process
4086 object; actually these swap their places */
4087 if (p->process_type != PROCESS_TYPE_SSL)
4088 ossl_swap_process_streams(s, p);
4090 /* somehow we gotta link the network-process with the ss-layer
4091 * otherwise it'd be easy to open a network stream then
4092 * a ss-layer on top of it and then via `delete-process'
4093 * all the work is void while the ss-layer still exists
4095 p->process_type = PROCESS_TYPE_SSL;
4096 p->process_type_data = ssl_conn;
4098 event_stream_select_process(p);
4104 ossl_ssl_unproselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4106 Lisp_Process *p = XPROCESS(process);
4107 Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4109 /* put the streams we have in the ssl-conn object into the process
4110 object (they should be the former process streams) */
4111 if (p->process_type == PROCESS_TYPE_SSL)
4112 ossl_swap_process_streams(s, p);
4114 /* somehow we gotta link the network-process with the ss-layer
4115 * otherwise it'd be easy to open a network stream then
4116 * a ss-layer on top of it and then via `delete-process'
4117 * all the work is void while the ss-layer still exists
4119 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
4120 XPROCESS(process)->process_type_data = Qnil;
4125 DEFUN("ossl-ssl-proselytise-process", Fossl_ssl_proselytise_process,
4127 Convert the underlying process of SSL-CONN into a secure
4128 network connection object.
4132 Lisp_Object process;
4134 CHECK_SSLCONN(ssl_conn);
4136 process = XSSLCONN(ssl_conn)->parent;
4137 if (!PROCESSP(process)) {
4138 error("no process associated with this connection");
4142 /* Make sure the process is really alive. */
4143 OSSL_CHECK_PROCESS(process);
4145 ossl_ssl_proselytise_process(ssl_conn, process);
4150 DEFUN("ossl-ssl-unproselytise-process", Fossl_ssl_unproselytise_process,
4152 Convert the underlying process of SSL-CONN into an ordinary
4153 network connection object.
4157 Lisp_Object process;
4159 CHECK_SSLCONN(ssl_conn);
4161 process = XSSLCONN(ssl_conn)->parent;
4162 if (!PROCESSP(process)) {
4163 error("no process associated with this connection");
4167 /* Make sure the process is really alive. */
4168 OSSL_CHECK_PROCESS(process);
4170 /* Castrate the process and make it a network process again */
4171 ossl_ssl_unproselytise_process(ssl_conn, process);
4176 DEFUN("ossl-ssl-finish", Fossl_ssl_finish, 1, 1, 0, /*
4177 Finish an SSL connection SSL-CONN.
4179 Note: This may also finish the network connection.
4183 Lisp_Object process;
4185 CHECK_SSLCONN(ssl_conn);
4187 if (XSSLCONN(ssl_conn)->protected_p)
4188 error ("Cannot finish protected SSL connection");
4190 process = XSSLCONN(ssl_conn)->parent;
4191 if (PROCESSP(process))
4192 ossl_ssl_unproselytise_process(ssl_conn, process);
4194 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
4198 DEFUN("ossl-ssl-read", Fossl_ssl_read, 2, 2, 0, /*
4199 Return the cleartext of STRING which is assumed to be a complete
4200 block of data sent through SSL-CONN.
4204 /* network stream stuff */
4206 Lisp_Object process;
4208 Lisp_Object result = Qnil;
4210 CHECK_SSLCONN(ssl_conn);
4211 CHECK_STRING(string);
4213 if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4214 error("SSL connection dead");
4216 conn = XSSLCONN(ssl_conn)->ssl_conn;
4217 process = XSSLCONN(ssl_conn)->parent;
4219 /* Make sure the process is really alive. */
4220 OSSL_CHECK_PROCESS(process);
4225 DEFUN("ossl-ssl-write", Fossl_ssl_write, 2, 2, 0, /*
4226 Send STRING to the tunnel SSL-CONN.
4230 /* network stream stuff */
4232 Lisp_Object process, proc_filter;
4237 CHECK_SSLCONN(ssl_conn);
4238 CHECK_STRING(string);
4240 if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4241 error("SSL connection dead");
4243 conn = XSSLCONN(ssl_conn)->ssl_conn;
4244 process = XSSLCONN(ssl_conn)->parent;
4246 /* Make sure the process is really alive. */
4247 OSSL_CHECK_PROCESS(process);
4249 switch (XPROCESS(process)->process_type) {
4250 case PROCESS_TYPE_NETWORK:
4251 /* ssl streams reside in ssl-conn object atm */
4252 out = XLSTREAM(DATA_OUTSTREAM(XSSLCONN(ssl_conn)));
4254 case PROCESS_TYPE_SSL:
4255 /* ssl streams reside in process object, snarf from there */
4256 out = XLSTREAM(DATA_OUTSTREAM(XPROCESS(process)));
4260 error("unable to write");
4263 /* store the original process filter */
4264 proc_filter = XPROCESS(process)->filter;
4266 ret = Lstream_write(out, XSTRING_DATA(string), XSTRING_LENGTH(string));
4269 switch (SSL_get_error(conn, ret)) {
4270 case SSL_ERROR_NONE:
4272 case SSL_ERROR_WANT_WRITE:
4273 error("Connection wants write");
4274 case SSL_ERROR_WANT_READ:
4275 error("Connection wants read");
4277 error("Severe SSL connection error");
4280 /* restore the original process filter */
4281 return (SSL_pending(conn) == 0) ? Qt : Qnil;
4284 /* convenience functions */
4285 DEFUN("ossl-ssl-parent", Fossl_ssl_parent, 1, 1, 0, /*
4286 Return the underlying parent layer of SSL-CONN.
4290 CHECK_SSLCONN(ssl_conn);
4292 return XSSLCONN(ssl_conn)->parent;
4295 DEFUN("ossl-ssl-cert", Fossl_ssl_cert, 1, 1, 0, /*
4296 Return the local peer's certificate of SSL-CONN if present,
4301 /* SSL connection stuff */
4305 CHECK_SSLCONN(ssl_conn);
4307 conn = XSSLCONN(ssl_conn)->ssl_conn;
4308 cert = SSL_get_certificate(conn);
4311 return make_evp_pkey_x509(cert);
4316 DEFUN("ossl-ssl-peer-cert", Fossl_ssl_peer_cert, 1, 1, 0, /*
4317 Return the remote peer's certificate of SSL-CONN if present,
4322 /* SSL connection stuff */
4326 CHECK_SSLCONN(ssl_conn);
4328 conn = XSSLCONN(ssl_conn)->ssl_conn;
4329 cert = SSL_get_peer_certificate(conn);
4332 return make_evp_pkey_x509(cert);
4337 DEFUN("ossl-ssl-peer-cert-chain", Fossl_ssl_peer_cert_chain, 1, 1, 0, /*
4338 Return the certificate chain of SSL-CONN as a list of
4344 /* SSL connection stuff */
4348 Lisp_Object result = Qnil;
4350 CHECK_SSLCONN(ssl_conn);
4352 conn = XSSLCONN(ssl_conn)->ssl_conn;
4353 sk = SSL_get_peer_cert_chain(conn);
4358 for (i=0; i<sk_X509_num(sk); i++) {
4359 X509 *cert = sk_X509_value(sk, i);
4361 result = Fcons(make_evp_pkey_x509(cert), result);
4368 DEFUN("ossl-ssl-cert-store", Fossl_ssl_cert_store, 1, 1, 0, /*
4369 Return the X509 cert store of SSL-CONN.
4373 X509_STORE *sto = NULL;
4379 #if 0 /* just thoughts */
4380 int SSL_get_verify_mode(const SSL *s);
4381 int SSL_get_verify_depth(const SSL *s);
4384 DEFUN("ossl-ssl-verify-certificate", Fossl_ssl_verify_certificate,
4386 Return a verify code of SSL-CONN.
4388 The result is a cons cell with the numeric verify code in
4389 the car and a verbose string in the cdr.
4394 /* SSL connection stuff */
4397 Lisp_Object result = Qnil;
4399 CHECK_SSLCONN(ssl_conn);
4401 conn = XSSLCONN(ssl_conn)->ssl_conn;
4402 vrc = SSL_get_verify_result(conn);
4406 build_string(X509_verify_cert_error_string(vrc)));
4411 DEFUN("ossl-ssl-cipher-version", Fossl_ssl_cipher_version, 1, 1, 0, /*
4412 Return the protocol version of the tunnel SSL-CONN.
4416 /* SSL connection stuff */
4418 const SSL_CIPHER *ciph;
4419 /* network stream stuff */
4420 Lisp_SSL_CONN *lisp_ssl_conn;
4422 CHECK_SSLCONN(ssl_conn);
4423 lisp_ssl_conn = XSSLCONN(ssl_conn);
4425 conn = lisp_ssl_conn->ssl_conn;
4429 ciph = SSL_get_current_cipher(conn);
4431 if (!(ciph == NULL))
4432 return Fmake_symbol(
4433 build_string(SSL_CIPHER_get_version(ciph)));
4438 DEFUN("ossl-ssl-cipher-name", Fossl_ssl_cipher_name, 1, 1, 0, /*
4439 Return the name of the current cipher used in the tunnel SSL-CONN.
4443 /* SSL connection stuff */
4445 const SSL_CIPHER *ciph;
4446 /* network stream stuff */
4447 Lisp_SSL_CONN *lisp_ssl_conn;
4449 CHECK_SSLCONN(ssl_conn);
4450 lisp_ssl_conn = XSSLCONN(ssl_conn);
4452 conn = lisp_ssl_conn->ssl_conn;
4456 ciph = SSL_get_current_cipher(conn);
4458 if (!(ciph == NULL))
4459 return intern(SSL_CIPHER_get_name(ciph));
4464 DEFUN("ossl-ssl-cipher-names", Fossl_ssl_cipher_names, 1, 1, 0, /*
4465 Return the names of all supported ciphers in the tunnel SSL-CONN.
4470 /* SSL connection stuff */
4472 STACK_OF(SSL_CIPHER) *ciphs;
4473 Lisp_Object result = Qnil;
4475 CHECK_SSLCONN(ssl_conn);
4477 conn = XSSLCONN(ssl_conn)->ssl_conn;
4481 ciphs = SSL_get_ciphers(conn);
4483 for (i=sk_SSL_CIPHER_num(ciphs)-1; i>=0; i--) {
4484 SSL_CIPHER *ciph = sk_SSL_CIPHER_value(ciphs, i);
4486 result = Fcons(intern(SSL_CIPHER_get_name(ciph)), result);
4492 DEFUN("ossl-ssl-cipher-bits", Fossl_ssl_cipher_bits, 1, 1, 0, /*
4493 Return the number of effective bits of the current cipher in SSL-CONN.
4497 /* SSL connection stuff */
4499 const SSL_CIPHER *ciph;
4500 int alg_bits, strength_bits;
4501 /* network stream stuff */
4502 Lisp_SSL_CONN *lisp_ssl_conn;
4504 CHECK_SSLCONN(ssl_conn);
4505 lisp_ssl_conn = XSSLCONN(ssl_conn);
4507 conn = lisp_ssl_conn->ssl_conn;
4511 ciph = SSL_get_current_cipher(conn);
4513 if (!(ciph == NULL)) {
4514 strength_bits = SSL_CIPHER_get_bits(ciph, &alg_bits);
4515 /* what do we want to do with alg_bits? */
4516 return make_int(strength_bits);
4521 DEFUN("ossl-ssl-cipher-description", Fossl_ssl_cipher_description, 1, 1, 0, /*
4522 Return a description of the current cipher used in the tunnel SSL-CONN.
4526 /* SSL connection stuff */
4528 const SSL_CIPHER *ciph;
4529 /* network stream stuff */
4530 Lisp_SSL_CONN *lisp_ssl_conn;
4532 CHECK_SSLCONN(ssl_conn);
4533 lisp_ssl_conn = XSSLCONN(ssl_conn);
4535 conn = lisp_ssl_conn->ssl_conn;
4539 ciph = SSL_get_current_cipher(conn);
4541 if (!(ciph == NULL))
4542 return build_string(SSL_CIPHER_description(ciph, NULL, 0));
4548 /* X509 cert handling */
4549 DEFUN("ossl-x509-subject", Fossl_x509_subject, 1, 1, 0, /*
4550 Return the certificate subject of CERT (an evp-pkey object).
4552 This will return a string in LDAP syntax.
4558 CHECK_EVPPKEY(cert);
4560 pk509 = XEVPPKEY(cert)->x509;
4563 X509_NAME *sub = X509_get_subject_name(pk509);
4564 return build_string(X509_NAME_oneline(sub, NULL, 0));
4569 DEFUN("ossl-x509-issuer", Fossl_x509_issuer, 1, 1, 0, /*
4570 Return the certificate issuer of CERT (an evp-pkey object),
4571 that is the organisation which signed the certificate.
4573 This will return a string in LDAP syntax.
4579 CHECK_EVPPKEY(cert);
4581 pk509 = XEVPPKEY(cert)->x509;
4584 X509_NAME *iss = X509_get_issuer_name(pk509);
4585 return build_string(X509_NAME_oneline(iss, NULL, 0));
4590 DEFUN("ossl-x509-serial", Fossl_x509_serial, 1, 1, 0, /*
4591 Return the certificate serial of CERT (an evp-pkey object).
4597 CHECK_EVPPKEY(cert);
4599 pk509 = XEVPPKEY(cert)->x509;
4602 ASN1_INTEGER *ser = X509_get_serialNumber(pk509);
4603 return make_integer(ASN1_INTEGER_get(ser));
4608 DEFUN("ossl-x509-not-before", Fossl_x509_not_before, 1, 1, 0, /*
4609 Return the certificate valid-not-before time of CERT.
4615 CHECK_EVPPKEY(cert);
4617 pk509 = XEVPPKEY(cert)->x509;
4620 ASN1_TIME *nbf = X509_get_notBefore(pk509);
4621 return build_string((char*)nbf->data);
4626 DEFUN("ossl-x509-not-after", Fossl_x509_not_after, 1, 1, 0, /*
4627 Return the certificate valid-not-after time of CERT.
4633 CHECK_EVPPKEY(cert);
4635 pk509 = XEVPPKEY(cert)->x509;
4638 ASN1_TIME *nbf = X509_get_notAfter(pk509);
4639 return build_string((char*)nbf->data);
4644 DEFUN("ossl-x509-signature-type", Fossl_x509_signature_type, 1, 1, 0, /*
4645 Return the signature type of CERT.
4651 CHECK_EVPPKEY(cert);
4653 pk509 = XEVPPKEY(cert)->x509;
4656 int ty = X509_get_signature_type(pk509);
4657 Lisp_Object result = Qnil;
4661 result = intern("none");
4663 #ifndef OPENSSL_NO_RSA
4665 result = intern("rsa");
4668 result = intern("rsa2");
4671 #ifndef OPENSSL_NO_DSA
4673 result = intern("dsa");
4676 result = intern("dsa1");
4679 result = intern("dsa2");
4682 result = intern("dsa3");
4685 result = intern("dsa4");
4688 #ifndef OPENSSL_NO_DH
4690 result = intern("dh");
4693 #ifndef OPENSSL_NO_EC
4695 result = intern("ec");
4699 result = intern("unknown");
4714 * Initialisation stuff
4717 void syms_of_openssl(void)
4719 INIT_LRECORD_IMPLEMENTATION(evp_pkey);
4720 INIT_LRECORD_IMPLEMENTATION(ssl_conn);
4722 defsymbol(&Qopenssl, "openssl");
4723 defsymbol(&Qevp_pkeyp, "ossl-pkey-p");
4725 DEFSUBR(Fossl_version);
4726 DEFSUBR(Fossl_available_digests);
4727 DEFSUBR(Fossl_available_ciphers);
4728 DEFSUBR(Fossl_digest_size);
4729 DEFSUBR(Fossl_digest_bits);
4730 DEFSUBR(Fossl_digest_block_size);
4731 DEFSUBR(Fossl_cipher_key_length);
4732 DEFSUBR(Fossl_cipher_bits);
4733 DEFSUBR(Fossl_cipher_iv_length);
4734 DEFSUBR(Fossl_cipher_block_size);
4735 DEFSUBR(Fossl_cipher_mode);
4737 DEFSUBR(Fossl_rand_bytes);
4738 DEFSUBR(Fossl_rand_bytes_egd);
4740 DEFSUBR(Fossl_digest);
4741 DEFSUBR(Fossl_digest_file);
4743 DEFSUBR(Fossl_hmac);
4744 DEFSUBR(Fossl_hmac_file);
4746 DEFSUBR(Fossl_bytes_to_key);
4747 DEFSUBR(Fossl_encrypt);
4748 DEFSUBR(Fossl_encrypt_file);
4749 DEFSUBR(Fossl_decrypt);
4750 DEFSUBR(Fossl_decrypt_file);
4753 DEFSUBR(Fossl_pkey_p);
4754 DEFSUBR(Fossl_pkey_size);
4755 DEFSUBR(Fossl_pkey_private_p);
4756 DEFSUBR(Fossl_pkey_get_public);
4758 #ifndef OPENSSL_NO_RSA
4760 DEFSUBR(Fossl_rsa_generate_key);
4761 DEFSUBR(Fossl_rsa_pkey_p);
4762 DEFSUBR(Fossl_rsa_subkey_p);
4763 #endif /* OPENSSL_NO_RSA */
4764 #ifndef OPENSSL_NO_DSA
4766 DEFSUBR(Fossl_dsa_generate_key);
4767 DEFSUBR(Fossl_dsa_pkey_p);
4768 DEFSUBR(Fossl_dsa_subkey_p);
4769 #endif /* OPENSSL_NO_DSA */
4770 #ifndef OPENSSL_NO_EC
4772 DEFSUBR(Fossl_ec_available_curves);
4773 DEFSUBR(Fossl_ec_generate_key);
4774 DEFSUBR(Fossl_ec_pkey_p);
4775 #endif /* OPENSSL_NO_EC */
4776 #ifndef OPENSSL_NO_DH
4778 /* DEFSUBR(Fossl_ec_generate_key); */
4779 DEFSUBR(Fossl_dh_pkey_p);
4781 DEFSUBR(Fossl_seal);
4782 DEFSUBR(Fossl_open);
4784 DEFSUBR(Fossl_sign);
4785 DEFSUBR(Fossl_verify);
4788 DEFSUBR(Fossl_pem_read_public_key);
4789 DEFSUBR(Fossl_pem_read_key);
4790 DEFSUBR(Fossl_pem_write_public_key);
4791 DEFSUBR(Fossl_pem_write_key);
4792 DEFSUBR(Fossl_pem_public_key);
4793 DEFSUBR(Fossl_pem_key);
4796 defsymbol(&Qssl_connp, "ossl-ssl-conn-p");
4797 defsymbol(&Qssl2, "ssl2");
4798 defsymbol(&Qssl23, "ssl23");
4799 defsymbol(&Qssl3, "ssl3");
4800 defsymbol(&Qtls1, "tls1");
4802 DEFSUBR(Fossl_ssl_handshake);
4803 DEFSUBR(Fossl_ssl_inject_ca);
4804 DEFSUBR(Fossl_ssl_inject_cert);
4805 DEFSUBR(Fossl_ssl_proselytise_process);
4806 DEFSUBR(Fossl_ssl_unproselytise_process);
4807 DEFSUBR(Fossl_ssl_connect);
4808 DEFSUBR(Fossl_ssl_finish);
4809 DEFSUBR(Fossl_ssl_read);
4810 DEFSUBR(Fossl_ssl_write);
4811 DEFSUBR(Fossl_ssl_parent);
4812 DEFSUBR(Fossl_ssl_cert);
4813 DEFSUBR(Fossl_ssl_peer_cert);
4814 DEFSUBR(Fossl_ssl_peer_cert_chain);
4815 DEFSUBR(Fossl_ssl_verify_certificate);
4816 DEFSUBR(Fossl_ssl_cipher_version);
4817 DEFSUBR(Fossl_ssl_cipher_name);
4818 DEFSUBR(Fossl_ssl_cipher_names);
4819 DEFSUBR(Fossl_ssl_cipher_bits);
4820 DEFSUBR(Fossl_ssl_cipher_description);
4823 DEFSUBR(Fossl_x509_subject);
4824 DEFSUBR(Fossl_x509_issuer);
4825 DEFSUBR(Fossl_x509_serial);
4826 DEFSUBR(Fossl_x509_not_before);
4827 DEFSUBR(Fossl_x509_not_after);
4828 DEFSUBR(Fossl_x509_signature_type);
4831 void vars_of_openssl(void)
4835 #ifndef OPENSSL_NO_RSA
4836 Fprovide(intern("openssl-rsa"));
4838 #ifndef OPENSSL_NO_DSA
4839 Fprovide(intern("openssl-dsa"));
4841 #ifndef OPENSSL_NO_EC
4842 Fprovide(intern("openssl-ec"));
4844 #ifndef OPENSSL_NO_DH
4845 Fprovide(intern("openssl-dh"));
4848 Fprovide(intern("openssl-ssl"));