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)))
1019 return wrong_type_argument(Qfile_readable_p, file);
1022 OpenSSL_add_all_digests();
1023 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
1027 error ("no such digest");
1030 TO_EXTERNAL_FORMAT (LISP_STRING, password,
1031 C_STRING_ALLOCA, password_ext, OSSL_CODING);
1032 password_len = OSSL_STRING_LENGTH(password);
1034 hmacctx = xnew(HMAC_CTX);
1035 HMAC_CTX_init(hmacctx);
1036 HMAC_Init(hmacctx, password_ext, password_len, md);
1038 /* we reuse md_value here for streaming over fp */
1040 n = fread(outbuf, 1, EVP_MAX_MD_SIZE, fp);
1045 error("file corrupted");
1048 HMAC_Update(hmacctx, outbuf, n);
1051 HMAC_Final(hmacctx, outbuf, &outlen);
1052 HMAC_CTX_cleanup(hmacctx);
1057 return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1066 DEFUN("ossl-bytes-to-key", Fossl_bytes_to_key, 5, 5, 0, /*
1067 Derive a key and initialisation vector (iv) suitable for a cipher.
1068 Return a string KEY being the key. The initialisation vector is
1069 put into KEY's property list as 'iv.
1071 CIPHER \(a symbol\) is the cipher to derive the key and IV for.
1072 Valid ciphers can be obtained by `ossl-available-ciphers'.
1074 DIGEST \(a symbol\) is the message digest to use.
1075 Valid digests can be obtained by `ossl-available-digests'.
1077 SALT \(string or `nil'\) is used as a salt in the derivation.
1078 Use `nil' here to indicate that no salt is used.
1080 PASSWORD is an arbitrary string which is processed to derive a
1083 COUNT \(a positive integer\) is the iteration count to use. This
1084 indicates how often the hash algorithm is called recursively.
1086 Note: You probably want to put a wrapping encoder function
1087 \(like `base16-encode-string'\) around it, since this returns
1090 (cipher, digest, salt, password, count))
1093 const EVP_CIPHER *ciph;
1094 const char *salt_ext;
1097 unsigned int password_len;
1099 char key[EVP_MAX_KEY_LENGTH];
1100 char iv[EVP_MAX_IV_LENGTH];
1104 CHECK_STRING(password);
1105 CHECK_SYMBOL(cipher);
1106 CHECK_SYMBOL(digest);
1107 CHECK_NATNUM(count);
1111 error ("count has to be a non-zero positive integer");
1113 OpenSSL_add_all_algorithms();
1114 md = EVP_get_digestbyname(
1115 (char *)string_data(XSYMBOL(digest)->name));
1116 ciph = EVP_get_cipherbyname(
1117 (char *)string_data(XSYMBOL(cipher)->name));
1121 error ("no such cipher");
1126 error ("no such digest");
1133 TO_EXTERNAL_FORMAT (LISP_STRING, salt,
1134 C_STRING_ALLOCA, salt_ext, OSSL_CODING);
1138 TO_EXTERNAL_FORMAT (LISP_STRING, password,
1139 C_STRING_ALLOCA, password_ext, OSSL_CODING);
1140 password_len = OSSL_STRING_LENGTH(password);
1142 EVP_BytesToKey(ciph, md, (const unsigned char *)salt_ext,
1143 (const unsigned char *)password_ext, password_len,
1145 (unsigned char *)key,
1146 (unsigned char *)iv);
1150 result = make_ext_string(key, EVP_CIPHER_key_length(ciph), OSSL_CODING);
1151 Fput(result, intern("iv"),
1152 make_ext_string(iv, EVP_CIPHER_iv_length(ciph), OSSL_CODING));
1158 DEFUN("ossl-encrypt", Fossl_encrypt, 3, 4, 0, /*
1159 Return the cipher of STRING computed by CIPHER under KEY.
1161 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1162 you have compiled. See `ossl-available-ciphers'.
1164 STRING is the text to be encrypted.
1166 KEY should be a key generated suitably for this cipher, for example
1167 by `ossl-bytes-to-key'.
1169 Optional fourth argument IV should be an initialisation vector
1170 suitable for this cipher. Normally the initialisation vector from
1171 KEY's property list is used. However, if IV is
1172 non-nil, use this IV instead.
1174 Note: You probably want to put a wrapping encoder function
1175 \(like `base16-encode-string'\) around it, since this returns
1178 (cipher, string, key, iv))
1180 /* buffer for the external string */
1182 unsigned int string_len;
1183 /* buffer for the ciphertext */
1186 Lisp_Object l_outbuf;
1187 /* buffer for key */
1192 /* declarations for the cipher */
1193 const EVP_CIPHER *ciph;
1194 EVP_CIPHER_CTX *ciphctx;
1197 int speccount = specpdl_depth();
1200 /* frob the IV from the plist of key maybe */
1202 iv = Fget(key, intern("iv"), Qnil);
1204 CHECK_SYMBOL(cipher);
1205 CHECK_STRING(string);
1209 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1210 C_STRING_ALLOCA, string_ext, OSSL_CODING);
1211 string_len = OSSL_STRING_LENGTH(string);
1213 if (string_len <= 0)
1214 error ("string must be of non-zero positive length.");
1216 OpenSSL_add_all_algorithms();
1217 /* ENGINE_load_builtin_engines(); */
1218 /* atm, no support for different engines */
1219 ciph = EVP_get_cipherbyname(
1220 (char *)string_data(XSYMBOL(cipher)->name));
1224 error ("no such cipher");
1227 /* now allocate some output buffer externally
1228 * this one has to be at least EVP_CIPHER_block_size bigger
1229 * since block algorithms merely operate blockwise
1231 alloclen = XSTRING_LENGTH(string) + EVP_CIPHER_block_size(ciph);
1232 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1234 TO_EXTERNAL_FORMAT(LISP_STRING, key,
1235 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1236 TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1237 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1239 ciphctx = xnew(EVP_CIPHER_CTX);
1240 EVP_CIPHER_CTX_init(ciphctx);
1241 if (!EVP_EncryptInit(ciphctx, ciph,
1242 (unsigned char *)key_ext,
1243 (unsigned char *)iv_ext)) {
1246 error ("error in EncryptInit");
1248 if (!EVP_EncryptUpdate(ciphctx,
1249 (unsigned char *)outbuf, &outlen,
1250 (unsigned char *)string_ext, string_len)) {
1253 error ("error in EncryptUpdate");
1255 /* Buffer passed to EVP_EncryptFinal() must be after data just
1256 * encrypted to avoid overwriting it.
1258 if (!EVP_EncryptFinal(ciphctx,
1259 (unsigned char *)outbuf+outlen, &tmplen)) {
1262 error ("error in EncryptFinal");
1264 /* added probable padding space to the length of the output buffer */
1266 EVP_CIPHER_CTX_cleanup(ciphctx);
1268 l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1269 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1277 DEFUN("ossl-encrypt-file", Fossl_encrypt_file, 3, 5, 0, /*
1278 Return the encrypted contents of FILE computed by CIPHER under KEY.
1280 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1281 you have compiled. See `ossl-available-ciphers'.
1283 FILE is the file to be encrypted.
1285 Third argument KEY should be a key generated suitably for this
1286 cipher, for example by `ossl-bytes-to-key'.
1288 Optional fourth argument IV should be an initialisation vector
1289 suitable for this cipher. Normally the initialisation vector from
1290 KEY's property list is used. However, if IV is
1291 non-nil, use this IV instead.
1293 Optional fifth argument OUTFILE may specify a file to have the
1294 encrypted data redirected.
1296 Note: You probably want to put a wrapping encoder function
1297 \(like `base16-encode-string'\) around it, since this returns
1300 (cipher, file, key, iv, outfile))
1302 /* buffer for the external string */
1303 unsigned char string_in[1024];
1305 unsigned int block_len;
1306 unsigned long file_size;
1307 /* buffer for the ciphertext */
1308 unsigned char *outbuf;
1311 Lisp_Object l_outbuf;
1312 /* buffer for key */
1322 /* declarations for the cipher */
1323 const EVP_CIPHER *ciph;
1324 EVP_CIPHER_CTX *ciphctx;
1327 int speccount = specpdl_depth();
1330 /* frob the IV from the plist of key maybe */
1332 iv = Fget(key, intern("iv"), Qnil);
1334 CHECK_SYMBOL(cipher);
1339 if (!NILP(outfile)) {
1340 CHECK_STRING(outfile);
1341 outfile = Fexpand_file_name(outfile, Qnil);
1342 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1343 return wrong_type_argument(Qfile_writable_p, outfile);
1348 file = Fexpand_file_name(file, Qnil);
1349 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1350 (fseek(fp, 0, SEEK_SET)))
1351 return wrong_type_argument(Qfile_readable_p, file);
1353 fseek(fp, 0, SEEK_END);
1354 file_size = ftell(fp);
1355 fseek(fp, 0, SEEK_SET);
1358 OpenSSL_add_all_algorithms();
1359 /* ENGINE_load_builtin_engines(); */
1360 /* atm, no support for different engines */
1361 ciph = EVP_get_cipherbyname(
1362 (char *)string_data(XSYMBOL(cipher)->name));
1366 error ("no such cipher");
1369 /* now allocate some output buffer externally
1370 * this one has to be at least EVP_CIPHER_block_size bigger
1371 * since block algorithms merely operate blockwise
1373 block_len = EVP_CIPHER_block_size(ciph);
1374 if (UNLIKELY(of != NULL)) {
1377 alloclen = file_size + block_len;
1379 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1381 TO_EXTERNAL_FORMAT(LISP_STRING, key,
1382 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1383 TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1384 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1386 ciphctx = xnew(EVP_CIPHER_CTX);
1387 EVP_CIPHER_CTX_init(ciphctx);
1388 if (!EVP_EncryptInit(ciphctx, ciph,
1389 (unsigned char *)key_ext,
1390 (unsigned char *)iv_ext)) {
1393 error("error in EncryptInit");
1399 string_len = fread(string_in, 1, 1024, fp);
1400 if (string_len < 0) {
1404 error("file corrupted");
1409 if (string_len > 0 &&
1410 !EVP_EncryptUpdate(ciphctx,
1412 string_in, string_len)) {
1415 error("error in EncryptUpdate");
1419 fwrite(obp, 1, tmplen, of);
1424 } while (string_len > 0);
1426 /* Buffer passed to EVP_EncryptFinal() must be after data just
1427 * encrypted to avoid overwriting it.
1429 if (!EVP_EncryptFinal(ciphctx, obp, &tmplen)) {
1432 error("error in EncryptFinal");
1436 fwrite(obp, 1, tmplen, of);
1438 /* added probable padding space to the length of the output buffer */
1440 EVP_CIPHER_CTX_cleanup(ciphctx);
1442 if (UNLIKELY(of != NULL)) {
1445 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1447 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1458 (setq k (ossl-bytes-to-key 'AES-256-OFB 'SHA1 nil "password" 1))
1459 (ossl-encrypt-file 'AES-256-OFB "~/.gnus" k nil "/tmp/gnus-enc")
1460 (ossl-decrypt-file 'AES-256-OFB "/tmp/gnus-enc" k nil "/tmp/gnus-dec")
1464 DEFUN("ossl-decrypt", Fossl_decrypt, 3, 4, 0, /*
1465 Return the deciphered version of STRING computed by CIPHER under KEY.
1467 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1468 you have compiled. See `ossl-available-ciphers'.
1470 STRING is the text to be decrypted.
1472 KEY should be a key generated suitably for this
1473 cipher, for example by `ossl-bytes-to-key'.
1475 Optional fourth argument IV should be an initialisation vector
1476 suitable for this cipher. Normally the initialisation vector from
1477 KEY's property list is used. However, if IV is
1478 non-nil, use this IV instead.
1480 (cipher, string, key, iv))
1482 /* buffer for the external string */
1484 unsigned int string_len;
1485 /* buffer for the deciphered text */
1488 Lisp_Object l_outbuf;
1489 /* buffer for key */
1494 /* declarations for the decipher */
1495 const EVP_CIPHER *ciph;
1496 EVP_CIPHER_CTX *ciphctx;
1499 int speccount = specpdl_depth();
1502 /* frob the IV from the plist of key maybe */
1504 iv = Fget(key, intern("iv"), Qnil);
1506 CHECK_SYMBOL(cipher);
1507 CHECK_STRING(string);
1511 TO_EXTERNAL_FORMAT(LISP_STRING, string,
1512 C_STRING_ALLOCA, string_ext, OSSL_CODING);
1513 string_len = OSSL_STRING_LENGTH(string);
1516 error ("string must be of non-zero positive length.");
1518 OpenSSL_add_all_algorithms();
1519 /* ENGINE_load_builtin_engines(); */
1520 /* atm, no support for different engines */
1521 ciph = EVP_get_cipherbyname(
1522 (char *)string_data(XSYMBOL(cipher)->name));
1526 error ("no such cipher");
1529 /* now allocate some output buffer externally */
1530 alloclen = XSTRING_LENGTH(string);
1531 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1533 TO_EXTERNAL_FORMAT (LISP_STRING, key,
1534 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1535 TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1536 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1538 ciphctx = xnew(EVP_CIPHER_CTX);
1539 EVP_CIPHER_CTX_init(ciphctx);
1540 if (!EVP_DecryptInit(ciphctx, ciph,
1541 (unsigned char *)key_ext,
1542 (unsigned char *)iv_ext)) {
1545 error ("error in DecryptInit");
1547 if (!EVP_DecryptUpdate(ciphctx,
1548 (unsigned char *)outbuf, &outlen,
1549 (unsigned char *)string_ext,string_len)) {
1552 error ("error in DecryptUpdate");
1554 /* Buffer passed to EVP_EncryptFinal() must be after data just
1555 * encrypted to avoid overwriting it.
1557 if (!EVP_DecryptFinal(ciphctx,
1558 (unsigned char *)outbuf+outlen, &tmplen)) {
1561 error ("error in DecryptFinal");
1563 /* added probable padding space to the length of the output buffer */
1565 EVP_CIPHER_CTX_cleanup(ciphctx);
1567 l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1568 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1576 DEFUN("ossl-decrypt-file", Fossl_decrypt_file, 3, 5, 0, /*
1577 Return the deciphered version of FILE computed by CIPHER under KEY.
1579 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1580 you have compiled. See `ossl-available-ciphers'.
1582 FILE is the file to be decrypted.
1584 Third argument KEY should be a key generated suitably for this
1585 cipher, for example by `ossl-bytes-to-key'.
1587 Optional fourth argument IV should be an initialisation vector
1588 suitable for this cipher. Normally the initialisation vector from
1589 KEY's property list is used. However, if IV is
1590 non-nil, use this IV instead.
1592 Optional fifth argument OUTFILE may specify a file to have the
1593 encrypted data redirected.
1595 (cipher, file, key, iv, outfile))
1597 /* buffer for the external string */
1598 unsigned char string_in[1024];
1600 unsigned int block_len;
1601 unsigned long file_size;
1602 /* buffer for the deciphered text */
1603 unsigned char *outbuf;
1606 Lisp_Object l_outbuf;
1607 /* buffer for key */
1617 /* declarations for the decipher */
1618 const EVP_CIPHER *ciph;
1619 EVP_CIPHER_CTX *ciphctx;
1622 int speccount = specpdl_depth();
1625 /* frob the IV from the plist of key maybe */
1627 iv = Fget(key, intern("iv"), Qnil);
1629 CHECK_SYMBOL(cipher);
1634 if (!NILP(outfile)) {
1635 CHECK_STRING(outfile);
1636 outfile = Fexpand_file_name(outfile, Qnil);
1637 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1638 return wrong_type_argument(Qfile_writable_p, outfile);
1643 file = Fexpand_file_name(file, Qnil);
1644 if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1645 (fseek(fp, 0, SEEK_SET)))
1646 return wrong_type_argument(Qfile_readable_p, file);
1648 fseek(fp, 0, SEEK_END);
1649 file_size = ftell(fp);
1650 fseek(fp, 0, SEEK_SET);
1653 OpenSSL_add_all_algorithms();
1654 /* ENGINE_load_builtin_engines(); */
1655 /* atm, no support for different engines */
1656 ciph = EVP_get_cipherbyname(
1657 (char *)string_data(XSYMBOL(cipher)->name));
1661 error ("no such cipher");
1664 /* now allocate some output buffer externally */
1665 block_len = EVP_CIPHER_block_size(ciph);
1666 if (UNLIKELY(of != NULL)) {
1669 alloclen = file_size + block_len;
1671 XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1673 TO_EXTERNAL_FORMAT (LISP_STRING, key,
1674 C_STRING_ALLOCA, key_ext, OSSL_CODING);
1675 TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1676 C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1678 ciphctx = xnew(EVP_CIPHER_CTX);
1679 EVP_CIPHER_CTX_init(ciphctx);
1680 if (!EVP_DecryptInit(ciphctx, ciph,
1681 (unsigned char *)key_ext,
1682 (unsigned char *)iv_ext)) {
1685 error ("error in DecryptInit");
1691 string_len = fread(string_in, 1, 1024, fp);
1692 if (string_len < 0) {
1696 error("file corrupted");
1701 if (string_len > 0 &&
1702 !EVP_DecryptUpdate(ciphctx,
1704 string_in, string_len)) {
1707 error ("error in DecryptUpdate");
1711 fwrite(obp, 1, tmplen, of);
1716 } while (string_len > 0);
1718 /* Buffer passed to EVP_EncryptFinal() must be after data just
1719 * encrypted to avoid overwriting it.
1721 if (!EVP_DecryptFinal(ciphctx, obp, &tmplen)) {
1724 error ("error in DecryptFinal");
1728 fwrite(obp, 1, tmplen, of);
1730 /* added probable padding space to the length of the output buffer */
1732 EVP_CIPHER_CTX_cleanup(ciphctx);
1734 if (UNLIKELY(of != NULL)) {
1737 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1739 XMALLOC_UNBIND(outbuf, alloclen, speccount);
1756 /* This is an opaque object for storing PKEYs in lisp */
1757 Lisp_Object Qevp_pkeyp;
1760 mark_evp_pkey(Lisp_Object obj)
1762 /* avoid some warning */
1768 print_evp_pkey(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1774 pkey = XEVPPKEY(obj)->evp_pkey;
1775 x509 = XEVPPKEY(obj)->x509;
1777 write_c_string("#<OpenSSL", printcharfun);
1780 X509_NAME *iss = X509_get_issuer_name(x509);
1781 X509_NAME *sub = X509_get_subject_name(x509);
1782 write_c_string(" X509 Certificate", printcharfun);
1783 write_c_string(" iss:", printcharfun);
1784 write_c_string(X509_NAME_oneline(sub, NULL, 0), printcharfun);
1785 write_c_string(" sub:", printcharfun);
1786 write_c_string(X509_NAME_oneline(iss, NULL, 0), printcharfun);
1791 write_c_string(";", printcharfun);
1793 if (rsa_pkey_p(pkey))
1794 write_c_string(" RSA", printcharfun);
1795 else if (dsa_pkey_p(pkey))
1796 write_c_string(" DSA", printcharfun);
1797 else if (ec_pkey_p(pkey))
1798 write_c_string(" EC", printcharfun);
1800 if (ossl_pkey_has_private_data(pkey))
1801 write_c_string(" private/public key", printcharfun);
1802 else if (ossl_pkey_has_public_data(pkey))
1803 write_c_string(" public key", printcharfun);
1805 write_c_string(" empty key", printcharfun);
1807 if (EVP_PKEY_size(pkey) > 0) {
1808 snprintf(buf, 256, ", size %d", EVP_PKEY_size(pkey)*8);
1809 write_c_string(buf, printcharfun);
1813 write_c_string(">", printcharfun);
1815 /* avoid some warning */
1819 static Lisp_EVP_PKEY *
1820 allocate_evp_pkey(void)
1822 Lisp_EVP_PKEY *evp_pkey =
1823 alloc_lcrecord_type(Lisp_EVP_PKEY, &lrecord_evp_pkey);
1824 evp_pkey->evp_pkey = NULL;
1825 evp_pkey->x509 = NULL;
1830 finalise_evp_pkey(void *header, int for_disksave)
1832 Lisp_EVP_PKEY *evp_pkey = (Lisp_EVP_PKEY *) header;
1834 if (evp_pkey->evp_pkey) {
1835 EVP_PKEY_free(evp_pkey->evp_pkey);
1836 evp_pkey->evp_pkey = NULL;
1838 if (evp_pkey->x509) {
1839 X509_free(evp_pkey->x509);
1840 evp_pkey->x509 = NULL;
1843 /* avoid some warning */
1847 DEFINE_LRECORD_IMPLEMENTATION("evp_pkey", evp_pkey,
1848 mark_evp_pkey, print_evp_pkey,
1854 make_evp_pkey(EVP_PKEY *pkey, X509 *x509)
1856 Lisp_EVP_PKEY *lisp_pkey = allocate_evp_pkey();
1858 lisp_pkey->evp_pkey = pkey;
1859 lisp_pkey->x509 = x509;
1861 return wrap_evppkey(lisp_pkey);
1865 make_evp_pkey_pk(EVP_PKEY *pkey)
1867 return make_evp_pkey(pkey, NULL);
1871 make_evp_pkey_x509(X509 *x509)
1873 return make_evp_pkey(X509_get_pubkey(x509), x509);
1876 DEFUN("ossl-pkey-p", Fossl_pkey_p, 1, 1, 0, /*
1877 Return t iff OBJECT is a pkey, nil otherwise.
1881 if (EVPPKEYP(object))
1887 DEFUN("ossl-pkey-size", Fossl_pkey_size, 1, 1, 0, /*
1888 Return the size a public key PKEY in bits.
1894 CHECK_EVPPKEY(pkey);
1896 pk = (XEVPPKEY(pkey))->evp_pkey;
1898 return make_int(EVP_PKEY_size(pk)*8);
1902 ossl_pkey_has_public_data(EVP_PKEY *pkey)
1904 if (rsa_pkey_p(pkey)) {
1905 #ifndef OPENSSL_NO_RSA
1906 return rsa_pkey_has_public_data((pkey->pkey).rsa);
1910 } else if (dsa_pkey_p(pkey)) {
1911 #ifndef OPENSSL_NO_DSA
1912 return dsa_pkey_has_public_data((pkey->pkey).dsa);
1916 } else if (ec_pkey_p(pkey)) {
1917 #ifndef OPENSSL_NO_EC
1918 return ec_pkey_has_public_data((pkey->pkey).ec);
1922 } else if (dh_pkey_p(pkey)) {
1923 #ifndef OPENSSL_NO_DH
1924 return dh_pkey_has_public_data((pkey->pkey).dh);
1932 ossl_pkey_has_private_data(EVP_PKEY *pkey)
1934 if (rsa_pkey_p(pkey)) {
1935 #ifndef OPENSSL_NO_RSA
1936 return rsa_pkey_has_private_data((pkey->pkey).rsa);
1940 } else if (dsa_pkey_p(pkey)) {
1941 #ifndef OPENSSL_NO_DSA
1942 return dsa_pkey_has_private_data((pkey->pkey).dsa);
1946 } else if (ec_pkey_p(pkey)) {
1947 #ifndef OPENSSL_NO_EC
1948 return ec_pkey_has_private_data((pkey->pkey).ec);
1952 } else if (dh_pkey_p(pkey)) {
1953 #ifndef OPENSSL_NO_DH
1954 return dh_pkey_has_private_data((pkey->pkey).dh);
1962 DEFUN("ossl-pkey-private-p", Fossl_pkey_private_p, 1, 1, 0, /*
1963 Return non-nil if PKEY contains private data.
1965 This function is not native OpenSSL.
1971 if (!(EVPPKEYP(pkey)))
1974 pk = (XEVPPKEY(pkey))->evp_pkey;
1976 if (ossl_pkey_has_private_data(pk))
1982 DEFUN("ossl-pkey-get-public", Fossl_pkey_get_public, 1, 1, 0, /*
1983 Return a copy of PKEY stripped by the private data.
1985 This function is not native OpenSSL.
1992 CHECK_EVPPKEY(pkey);
1994 pk = (XEVPPKEY(pkey))->evp_pkey;
1995 if (!(ossl_pkey_has_public_data(pk)))
1996 error ("key must have public data");
1998 pkout = EVP_PKEY_new();
1999 if (rsa_pkey_p(pk)) {
2000 #ifndef OPENSSL_NO_RSA
2001 EVP_PKEY_assign_RSA(pkout, RSAPublicKey_dup((pk->pkey).rsa));
2003 } else if (dsa_pkey_p(pk)) {
2004 #ifndef OPENSSL_NO_DSA
2005 EVP_PKEY_assign_DSA(pkout, dsa_get_public(pk));
2007 } else if (ec_pkey_p(pk)) {
2008 #ifndef OPENSSL_NO_EC
2009 EVP_PKEY_assign_EC_KEY(pkout, ec_get_public(pk));
2012 error ("no method to strip private data yet");
2014 return make_evp_pkey_pk(pkout);
2019 rsa_pkey_p(EVP_PKEY *pkey)
2023 type = EVP_PKEY_type(pkey->type);
2025 #ifndef OPENSSL_NO_RSA
2026 return ((type == EVP_PKEY_RSA) ||
2027 (type == EVP_PKEY_RSA2));
2032 #ifndef OPENSSL_NO_RSA
2034 rsa_pkey_has_public_data(RSA *rsakey)
2036 return (!(rsakey->n == NULL) &&
2037 !(rsakey->e == NULL));
2040 rsa_pkey_has_private_data(RSA *rsakey)
2042 return (rsa_pkey_has_public_data(rsakey) &&
2043 !(rsakey->d == NULL));
2046 DEFUN("ossl-rsa-generate-key", Fossl_rsa_generate_key, 2, 2, 0, /*
2047 Return an RSA public key with of length BITS and exponent EXPO.
2059 error ("modulus size must be a non-zero positive integer");
2060 if (!(XINT(expo) % 2))
2061 error ("exponent must be an odd positive integer");
2063 pkey = EVP_PKEY_new();
2064 rsakey = RSA_generate_key(XINT(bits), XINT(expo), NULL, NULL);
2065 EVP_PKEY_assign_RSA(pkey, rsakey);
2067 return make_evp_pkey_pk(pkey);
2070 DEFUN("ossl-rsa-pkey-p", Fossl_rsa_pkey_p, 1, 1, 0, /*
2071 Return t iff PKEY is of RSA type.
2077 if (!EVPPKEYP(pkey))
2080 pk = (XEVPPKEY(pkey))->evp_pkey;
2088 DEFUN("ossl-rsa-subkey-p", Fossl_rsa_subkey_p, 2, 2, 0, /*
2089 Return t iff PKEY1 is a subkey of PKEY2.
2090 I.e. if PKEY1 has the same public key data as PKEY2 and
2091 PKEY2 has all private data.
2093 This function is not native OpenSSL.
2102 CHECK_EVPPKEY(pkey1);
2103 CHECK_EVPPKEY(pkey2);
2105 pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2106 pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2108 /* perform a type check first */
2109 if (!rsa_pkey_p(pk1))
2110 error ("pkey1 must be of RSA type");
2111 if (!rsa_pkey_p(pk2))
2112 error ("pkey2 must be of RSA type");
2114 rk1 = (pk1->pkey).rsa;
2115 rk2 = (pk2->pkey).rsa;
2117 if (rsa_pkey_has_private_data(rk2) &&
2118 rsa_pkey_has_public_data(rk1) &&
2119 (!BN_cmp(rk1->n, rk2->n)) &&
2120 (!BN_cmp(rk1->e, rk2->e)))
2125 #endif /* OPENSSL_NO_RSA */
2130 dsa_pkey_p(EVP_PKEY *pkey)
2134 type = EVP_PKEY_type(pkey->type);
2136 #ifndef OPENSSL_NO_DSA
2137 return ((type == EVP_PKEY_DSA) ||
2138 (type == EVP_PKEY_DSA1) ||
2139 (type == EVP_PKEY_DSA2) ||
2140 (type == EVP_PKEY_DSA3) ||
2141 (type == EVP_PKEY_DSA4));
2146 #ifndef OPENSSL_NO_DSA
2148 dsa_pkey_has_public_data(DSA *dsakey)
2150 return (!(dsakey->p == NULL) &&
2151 !(dsakey->q == NULL) &&
2152 !(dsakey->g == NULL) &&
2153 !(dsakey->pub_key == NULL));
2156 dsa_pkey_has_private_data(DSA *dsakey)
2158 return (dsa_pkey_has_public_data(dsakey) &&
2159 !(dsakey->priv_key == NULL));
2162 DEFUN("ossl-dsa-generate-key", Fossl_dsa_generate_key, 1, 2, 0, /*
2163 Return a DSA public key with of length BITS seeded with (optional) SEED.
2172 unsigned_long h_ret;
2179 error ("prime number size must be a non-zero positive integer");
2186 TO_EXTERNAL_FORMAT (LISP_STRING, seed,
2187 C_STRING_ALLOCA, seed_ext, OSSL_CODING);
2188 seed_len = OSSL_STRING_LENGTH(seed);
2191 pkey = EVP_PKEY_new();
2192 dsakey = DSA_generate_parameters(XINT(bits),
2193 (unsigned char*)seed_ext, seed_len,
2194 &counter_ret, &h_ret,
2196 if (!DSA_generate_key(dsakey))
2197 error ("error during generation of DSA key");
2199 EVP_PKEY_assign_DSA(pkey, dsakey);
2201 return make_evp_pkey_pk(pkey);
2204 DEFUN("ossl-dsa-pkey-p", Fossl_dsa_pkey_p, 1, 1, 0, /*
2205 Return t iff PKEY is of DSA type.
2211 if (!EVPPKEYP(pkey))
2214 pk = (XEVPPKEY(pkey))->evp_pkey;
2222 dsa_get_public(EVP_PKEY *pk)
2227 memcpy(key, (pk->pkey).dsa, sizeof(DSA));
2229 /* now kill the private data */
2230 key->priv_key = NULL;
2235 DEFUN("ossl-dsa-subkey-p", Fossl_dsa_subkey_p, 2, 2, 0, /*
2236 Return t iff PKEY1 is a subkey of PKEY2.
2237 I.e. if PKEY1 has the same public key data as PKEY2 and
2238 PKEY2 has all private data.
2240 This function is not native OpenSSL.
2249 CHECK_EVPPKEY(pkey1);
2250 CHECK_EVPPKEY(pkey2);
2252 pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2253 pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2255 /* perform a type check first */
2256 if (!dsa_pkey_p(pk1))
2257 error ("pkey1 must be of DSA type");
2258 if (!dsa_pkey_p(pk2))
2259 error ("pkey2 must be of DSA type");
2261 dk1 = (pk1->pkey).dsa;
2262 dk2 = (pk2->pkey).dsa;
2264 if (dsa_pkey_has_private_data(dk2) &&
2265 dsa_pkey_has_public_data(dk1) &&
2266 (!BN_cmp(dk1->p, dk2->p)) &&
2267 (!BN_cmp(dk1->q, dk2->q)) &&
2268 (!BN_cmp(dk1->g, dk2->g)) &&
2269 (!BN_cmp(dk1->pub_key, dk2->pub_key)))
2274 #endif /* OPENSSL_NO_DSA */
2279 ec_pkey_p(EVP_PKEY *pkey)
2283 type = EVP_PKEY_type(pkey->type);
2285 #ifndef OPENSSL_NO_EC
2286 return (type == EVP_PKEY_EC);
2291 #ifndef OPENSSL_NO_EC
2293 ec_pkey_has_public_data(EC_KEY *ec_key)
2295 return (!(EC_KEY_get0_group(ec_key) == NULL) &&
2296 !(EC_KEY_get0_public_key(ec_key) == NULL));
2299 ec_pkey_has_private_data(EC_KEY *ec_key)
2301 return (ec_pkey_has_public_data(ec_key) &&
2302 !(EC_KEY_get0_private_key(ec_key) == NULL));
2305 DEFUN("ossl-ec-available-curves", Fossl_ec_available_curves, 0, 0, 0, /*
2306 Return a list of builtin elliptic curves.
2310 EC_builtin_curve *curves = NULL;
2311 size_t crv_len = 0, n = 0;
2312 Lisp_Object lcurves;
2316 crv_len = EC_get_builtin_curves(NULL, 0);
2317 curves = OPENSSL_malloc(sizeof(EC_builtin_curve) * crv_len);
2320 error ("no curves defined");
2322 if (!EC_get_builtin_curves(curves, crv_len)) {
2323 OPENSSL_free(curves);
2324 error ("error during initialisation of curves");
2327 for (n = 0; n < crv_len; n++) {
2328 int nid = curves[n].nid;
2329 lcurves = Fcons(intern(OBJ_nid2sn(nid)), lcurves);
2332 OPENSSL_free(curves);
2338 ec_curve_by_name(char *name)
2340 return OBJ_sn2nid(name);
2343 DEFUN("ossl-ec-generate-key", Fossl_ec_generate_key, 1, 1, 0, /*
2344 Return a EC public key on CURVE.
2345 CURVE may be any symbol from `ossl-ec-available-curves'.
2347 At the moment we do not support creating custom curves.
2352 EC_KEY *eckey = EC_KEY_new();
2354 CHECK_SYMBOL(curve);
2356 pkey = EVP_PKEY_new();
2357 eckey = EC_KEY_new_by_curve_name(
2358 ec_curve_by_name((char *)string_data(XSYMBOL(curve)->name)));
2360 if ((eckey == NULL)) {
2361 error ("no such curve");
2364 if (!EC_KEY_generate_key(eckey))
2365 error ("error during generation of EC key");
2367 EVP_PKEY_assign_EC_KEY(pkey, eckey);
2369 return make_evp_pkey_pk(pkey);
2372 DEFUN("ossl-ec-pkey-p", Fossl_ec_pkey_p, 1, 1, 0, /*
2373 Return t iff PKEY is of EC type.
2380 if (!EVPPKEYP(pkey))
2383 pk = (XEVPPKEY(pkey))->evp_pkey;
2384 type = EVP_PKEY_type(pk->type);
2385 if (type == EVP_PKEY_EC)
2392 ec_get_public(EVP_PKEY *pk)
2396 key = EC_KEY_dup((pk->pkey).ec);
2398 /* now kill the private data */
2399 EC_KEY_set_private_key(key, NULL);
2403 #endif /* OPENSSL_NO_EC */
2408 dh_pkey_p(EVP_PKEY *pkey)
2412 type = EVP_PKEY_type(pkey->type);
2414 #ifndef OPENSSL_NO_DH
2415 return (type == EVP_PKEY_DH);
2420 #ifndef OPENSSL_NO_DH
2422 dh_pkey_has_public_data(DH *dhkey)
2424 return (!(dhkey->p == NULL) &&
2425 !(dhkey->g == NULL) &&
2426 !(dhkey->pub_key == NULL));
2429 dh_pkey_has_private_data(DH *dhkey)
2431 return (dh_pkey_has_public_data(dhkey) &&
2432 !(dhkey->priv_key == NULL));
2435 DEFUN("ossl-dh-pkey-p", Fossl_dh_pkey_p, 1, 1, 0, /*
2436 Return t iff PKEY is of DH type.
2442 if (!EVPPKEYP(pkey))
2445 pk = (XEVPPKEY(pkey))->evp_pkey;
2453 #endif /* OPENSSL_NO_DH */
2456 /* more general access functions */
2457 DEFUN("ossl-seal", Fossl_seal, 3, 3, 0, /*
2458 Return an envelope derived from encrypting STRING by CIPHER under PKEY
2459 with the hybrid technique.
2461 That is, create a random key/iv pair for the symmetric encryption with
2462 CIPHER and encrypt that key/iv asymmetrically with the provided public
2465 The envelope returned is a list
2466 \(encrypted_string encrypted_key encrypted_iv\)
2468 `encrypted_string' is the (symmetrically) encrypted message
2469 `encrypted_key' is the (asymmetrically) encrypted random key
2470 `encrypted_iv' is the (asymmetrically) encrypted random iv
2472 Note: You probably want to put a wrapping encoder function
2473 (like `base16-encode-string') around it, since this function
2474 returns binary string data.
2476 (cipher, string, pkey))
2478 /* declarations for the cipher */
2479 const EVP_CIPHER *ciph;
2480 EVP_CIPHER_CTX ciphctx;
2481 /* declarations for the pkey */
2484 unsigned char *ekey;
2487 /* buffer for the generated IV */
2488 char iv[EVP_MAX_IV_LENGTH];
2490 /* buffer for output */
2491 unsigned char *outbuf;
2492 unsigned int outlen;
2493 Lisp_Object l_outbuf;
2494 /* buffer for external string data */
2501 CHECK_SYMBOL(cipher);
2502 CHECK_STRING(string);
2503 CHECK_EVPPKEY(pkey);
2506 pk[0] = (XEVPPKEY(pkey))->evp_pkey;
2507 if (!ossl_pkey_has_public_data(pk[0])) {
2508 error ("cannot seal, key has no public key data");
2512 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2513 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2514 string_len = OSSL_STRING_LENGTH(string);
2516 OpenSSL_add_all_algorithms();
2517 ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2521 error ("no such cipher");
2525 /* alloc ekey buffer */
2526 ekey = (unsigned char*)xmalloc_atomic(EVP_PKEY_size(pk[0]));
2528 /* now allocate some output buffer externally
2529 * this one has to be at least EVP_CIPHER_block_size bigger
2530 * since block algorithms merely operate blockwise
2532 outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string) +
2533 EVP_CIPHER_block_size(ciph));
2535 EVP_CIPHER_CTX_init(&ciphctx);
2536 if (!(EVP_SealInit(&ciphctx, ciph,
2538 (unsigned char *)&iv,
2539 (EVP_PKEY **)&pk, npubk)==npubk)) {
2543 error ("error in SealInit");
2546 if (!EVP_SealUpdate(&ciphctx, outbuf, (int *)&outlen,
2547 (unsigned char*)string_ext, string_len)) {
2551 error ("error in SealUpdate");
2554 if (!EVP_SealFinal(&ciphctx, (unsigned char*)outbuf+outlen, &tmplen)) {
2558 error ("error in SealFinal");
2561 /* added probable padding space to the length of the output buffer */
2563 EVP_CIPHER_CTX_cleanup(&ciphctx);
2565 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2566 l_ekey = make_ext_string((char *)ekey, ekey_len, OSSL_CODING);
2567 l_iv = make_ext_string(iv,EVP_CIPHER_iv_length(ciph), OSSL_CODING);
2572 return list3(l_outbuf, l_ekey, l_iv);
2576 DEFUN("ossl-open", Fossl_open, 4, 5, 0, /*
2577 Return the deciphered message STRING from an envelope
2578 obtained by `ossl-seal'.
2580 CIPHER is the cipher to use (the same as in `ossl-seal')
2581 STRING is the encrypted message
2582 PKEY is the private key
2583 EKEY is the encrypted random key
2584 EIV is the encrypted iv
2586 (cipher, string, pkey, ekey, eiv))
2588 /* declarations for the cipher */
2589 const EVP_CIPHER *ciph;
2590 EVP_CIPHER_CTX ciphctx;
2591 /* declarations for the pkey */
2593 /* buffer for external ekey data */
2596 /* buffer for external eiv data */
2598 /* buffer for output */
2599 unsigned char *outbuf;
2600 unsigned int outlen;
2601 Lisp_Object l_outbuf;
2602 /* buffer for external string data */
2609 CHECK_SYMBOL(cipher);
2610 CHECK_STRING(string);
2611 CHECK_EVPPKEY(pkey);
2615 pk = (XEVPPKEY(pkey))->evp_pkey;
2616 if (!ossl_pkey_has_private_data(pk))
2617 error ("cannot open, key has no private key data");
2619 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2620 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2621 string_len = OSSL_STRING_LENGTH(string);
2622 TO_EXTERNAL_FORMAT (LISP_STRING, ekey,
2623 C_STRING_ALLOCA, ekey_ext, OSSL_CODING);
2624 ekey_len = OSSL_STRING_LENGTH(ekey);
2626 OpenSSL_add_all_algorithms();
2627 ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2631 error ("no such cipher");
2639 TO_EXTERNAL_FORMAT (LISP_STRING, eiv,
2640 C_STRING_ALLOCA, eiv_ext, OSSL_CODING);
2643 /* now allocate some output buffer externally */
2644 outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string));
2646 EVP_CIPHER_CTX_init(&ciphctx);
2647 if (!EVP_OpenInit(&ciphctx, ciph,
2648 (unsigned char*)ekey_ext,
2649 (unsigned int)ekey_len,
2650 (unsigned char*)eiv_ext, pk)) {
2653 error ("error in OpenInit");
2656 if (!EVP_OpenUpdate(&ciphctx, outbuf, (int *)&outlen,
2657 (unsigned char*)string_ext,
2658 (unsigned int)string_len)) {
2661 error ("error in OpenUpdate");
2664 if (!EVP_OpenFinal(&ciphctx, outbuf+outlen, &tmplen)) {
2667 error ("error in OpenFinal");
2670 /* added probable padding space to the length of the output buffer */
2672 EVP_CIPHER_CTX_cleanup(&ciphctx);
2674 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2683 DEFUN("ossl-sign", Fossl_sign, 3, 3, 0, /*
2684 Return a signature obtained by signing STRING under DIGEST with PKEY.
2686 That is, hash the message STRING with the message digest DIGEST and
2687 encrypt the result with the private key PKEY.
2689 Note: Due to some relationship between the public key system and the
2690 message digest you cannot use every digest algorithm with every
2692 The most certain results will be achieved using
2693 RSA keys with RSA-* digests, DSA keys with DSA-* digests.
2695 See `ossl-available-digests'.
2697 Note: You probably want to put a wrapping encoder function
2698 (like `base16-encode-string') around it, since this returns
2701 (digest, string, pkey))
2703 /* declarations for the cipher */
2706 /* declarations for the pkey */
2708 /* buffer for output */
2709 unsigned char *outbuf;
2710 unsigned int outlen;
2711 Lisp_Object l_outbuf;
2712 /* buffer for external string data */
2717 CHECK_SYMBOL(digest);
2718 CHECK_STRING(string);
2719 CHECK_EVPPKEY(pkey);
2722 pk = (XEVPPKEY(pkey))->evp_pkey;
2723 if (!ossl_pkey_has_private_data(pk)) {
2724 error ("cannot sign, key has no private key data");
2727 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2728 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2729 string_len = OSSL_STRING_LENGTH(string);
2731 OpenSSL_add_all_algorithms();
2732 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2736 error ("no such digest");
2740 /* now allocate some output buffer externally */
2741 outbuf = (unsigned char *)xmalloc_atomic(EVP_PKEY_size(pk));
2743 EVP_MD_CTX_init(&mdctx);
2744 if (!(EVP_SignInit(&mdctx, md))) {
2747 error ("error in SignInit");
2750 if (!EVP_SignUpdate(&mdctx, string_ext, string_len)) {
2753 error ("error in SignUpdate");
2756 if (!EVP_SignFinal(&mdctx, outbuf, &outlen, pk)) {
2759 error ("error in SignFinal");
2762 EVP_MD_CTX_cleanup(&mdctx);
2764 l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2772 DEFUN("ossl-verify", Fossl_verify, 4, 4, 0, /*
2773 Return t iff SIG is a valid signature of STRING under DIGEST obtained by PKEY.
2775 That is, hash the message STRING with the message digest DIGEST, then
2776 decrypt the signature SIG with the public key PKEY.
2777 Compare the results and return t iff both hashes are equal.
2779 DIGEST is the digest to use (the same as in `ossl-sign')
2780 STRING is the message
2781 SIG is the signature of message
2782 PKEY is the public key
2784 (digest, string, sig, pkey))
2786 /* declarations for the cipher */
2789 /* declarations for the pkey */
2791 /* buffer for external signature data */
2794 /* buffer for external string data */
2801 CHECK_SYMBOL(digest);
2802 CHECK_STRING(string);
2804 CHECK_EVPPKEY(pkey);
2807 pk = (XEVPPKEY(pkey))->evp_pkey;
2808 if (!ossl_pkey_has_public_data(pk))
2809 error ("cannot verify, key has no public key data");
2811 OpenSSL_add_all_algorithms();
2812 md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2816 error ("no such digest");
2820 TO_EXTERNAL_FORMAT (LISP_STRING, string,
2821 C_STRING_ALLOCA, string_ext, OSSL_CODING);
2822 string_len = OSSL_STRING_LENGTH(string);
2823 TO_EXTERNAL_FORMAT (LISP_STRING, sig,
2824 C_STRING_ALLOCA, sig_ext, OSSL_CODING);
2825 sig_len = OSSL_STRING_LENGTH(sig);
2827 EVP_MD_CTX_init(&mdctx);
2828 if (!EVP_VerifyInit(&mdctx, md)) {
2830 error ("error in VerifyInit");
2833 if (!EVP_VerifyUpdate(&mdctx, string_ext, string_len)) {
2835 error ("error in VerifyUpdate");
2838 result = EVP_VerifyFinal(&mdctx, (unsigned char*)sig_ext, sig_len, pk);
2841 error ("error in VerifyFinal");
2844 EVP_MD_CTX_cleanup(&mdctx);
2848 return result ? Qt : Qnil;
2857 DEFUN("ossl-pem-read-public-key", Fossl_pem_read_public_key, 1, 1, 0, /*
2858 Return a key (the public part) stored in a PEM structure from FILE.
2862 /* declarations for the pkey */
2871 file = Fexpand_file_name(file, Qnil);
2873 if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2874 error ("error opening file.");
2876 pk509 = PEM_read_X509(fp, NULL, NULL, NULL);
2877 pk = PEM_read_PUBKEY(fp, NULL, NULL, NULL);
2881 return make_evp_pkey(pk, pk509);
2884 DEFUN("ossl-pem-read-key", Fossl_pem_read_key, 1, 2, 0, /*
2885 Return a key stored in a PEM structure from FILE.
2886 If the (private part of the) key is protected with a password
2887 provide (optional) PASSWORD.
2891 /* declarations for the pkey */
2895 /* password pointer */
2900 file = Fexpand_file_name(file, Qnil);
2902 if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2903 error ("error opening file.");
2905 if (NILP(password)) {
2908 CHECK_STRING(password);
2909 pass = (char *)XSTRING_DATA(password);
2912 pk = PEM_read_PrivateKey(fp, NULL, NULL, pass);
2915 /* now maybe it is a public key only */
2916 return Fossl_pem_read_public_key(file);
2919 return make_evp_pkey_pk(pk);
2922 DEFUN("ossl-pem-write-public-key", Fossl_pem_write_public_key, 2, 2, 0, /*
2923 Write PKEY (the public part) in a PEM structure to FILE.
2927 /* declarations for the pkey */
2934 CHECK_EVPPKEY(pkey);
2936 file = Fexpand_file_name(file, Qnil);
2938 pk = XEVPPKEY(pkey)->evp_pkey;
2939 pk509 = XEVPPKEY(pkey)->x509;
2941 if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL)
2942 error ("error opening file.");
2944 if (!PEM_write_PUBKEY(fp, pk)) {
2946 error ("error writing PEM file.");
2954 DEFUN("ossl-pem-write-key", Fossl_pem_write_key, 2, 4, 0, /*
2955 Write PKEY in a PEM structure to FILE. The key itself is
2956 protected by (optional) CIPHER with PASSWORD.
2958 CIPHER can be set to nil and the key will not be encrypted.
2959 PASSWORD is ignored in this case.
2961 (file, pkey, cipher, password))
2963 const EVP_CIPHER *ciph;
2964 /* declarations for the pkey */
2969 /* password pointer */
2973 CHECK_EVPPKEY(pkey);
2975 file = Fexpand_file_name(file, Qnil);
2977 pk = XEVPPKEY(pkey)->evp_pkey;
2978 pk509 = XEVPPKEY(pkey)->x509;
2980 if (!ossl_pkey_has_private_data(pk))
2981 return Fossl_pem_write_public_key(file, pkey);
2983 CHECK_SYMBOL(cipher);
2985 OpenSSL_add_all_algorithms();
2991 ciph = EVP_get_cipherbyname(
2992 (char *)string_data(XSYMBOL(cipher)->name));
2995 error ("no such cipher");
2999 if (NILP(password)) {
3003 CHECK_STRING(password);
3004 pass = (char *)XSTRING_DATA(password);
3007 if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL) {
3009 error ("error opening file.");
3012 if (!PEM_write_PKCS8PrivateKey(fp, pk, ciph, NULL, 0, NULL, pass)) {
3015 error ("error writing PEM file.");
3025 ossl_pem_pkey_cb(BIO *bio, int cmd, const char *argp,
3026 int argi, long argl, long ret)
3029 void *foo = BIO_get_callback_arg(bio);
3031 if (!(key = (Lisp_Object)foo)) {
3035 if (BIO_CB_RETURN & cmd) {
3041 key = concat2(key, make_ext_string(argp, argi, OSSL_CODING));
3042 BIO_set_callback_arg(bio, (void*)key);
3050 DEFUN("ossl-pem-public-key",Fossl_pem_public_key, 1, 1, 0, /*
3051 Return PKEY as PEM encoded string.
3055 /* This function can GC */
3056 /* declarations for the pkey */
3062 struct gcpro gcpro1;
3066 CHECK_EVPPKEY(pkey);
3068 pk = (XEVPPKEY(pkey))->evp_pkey;
3070 if (!(b = BIO_new(BIO_s_null()))) {
3072 error("cannot open memory buffer");
3076 result = build_string("");
3077 BIO_set_callback(b, ossl_pem_pkey_cb);
3078 BIO_set_callback_arg(b, (void*)result);
3080 if (!PEM_write_bio_PUBKEY(b, pk)) {
3084 error ("error creating PEM string");
3089 void *foo = BIO_get_callback_arg(b);
3090 if (!(result = (Lisp_Object)foo)) {
3101 DEFUN("ossl-pem-key",Fossl_pem_key, 1, 3, 0, /*
3102 Return PKEY as PEM encoded string. The key itself is
3103 protected by (optional) CIPHER with PASSWORD.
3105 CIPHER can be set to nil and the key will not be encrypted.
3106 PASSWORD is ignored in this case.
3108 (pkey, cipher, password))
3110 /* This function can GC */
3111 /* declarations for the pkey */
3114 const EVP_CIPHER *ciph;
3118 struct gcpro gcpro1, gcpro2, gcpro3;
3120 GCPRO3(pkey, cipher, password);
3122 CHECK_EVPPKEY(pkey);
3124 pk = (XEVPPKEY(pkey))->evp_pkey;
3126 if (!ossl_pkey_has_private_data(pk)) {
3128 return Fossl_pem_public_key(pkey);
3131 CHECK_SYMBOL(cipher);
3133 OpenSSL_add_all_algorithms();
3139 ciph = EVP_get_cipherbyname(
3140 (char *)string_data(XSYMBOL(cipher)->name));
3144 error ("no such cipher");
3149 if (NILP(password)) {
3153 CHECK_STRING(password);
3154 pass = (char *)XSTRING_DATA(password);
3157 if (!(b = BIO_new(BIO_s_null()))) {
3159 error("cannot open memory buffer");
3163 result = build_string("");
3164 BIO_set_callback(b, ossl_pem_pkey_cb);
3165 BIO_set_callback_arg(b, (void*)result);
3167 if (!PEM_write_bio_PKCS8PrivateKey(b, pk, ciph, NULL, 0, NULL, pass)) {
3171 error ("error creating PEM string");
3176 void *foo = BIO_get_callback_arg(b);
3178 if (!(result = (Lisp_Object)foo)) {
3193 * The SSL support in this API is sorta high level since having
3194 * server hellos, handshakes and stuff like that is not what you want
3198 /* This is an opaque object for storing PKEYs in lisp */
3199 Lisp_Object Qssl_connp;
3202 make_ssl_conn(Lisp_SSL_CONN *ssl_conn)
3204 Lisp_Object lisp_ssl_conn;
3205 XSETSSLCONN(lisp_ssl_conn, ssl_conn);
3206 return lisp_ssl_conn;
3210 mark_ssl_conn(Lisp_Object obj)
3212 mark_object(XSSLCONN(obj)->parent);
3213 mark_object(XSSLCONN(obj)->pipe_instream);
3214 mark_object(XSSLCONN(obj)->pipe_outstream);
3216 mark_object(XSSLCONN(obj)->coding_instream);
3217 mark_object(XSSLCONN(obj)->coding_outstream);
3224 print_ssl_conn(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3229 conn = XSSLCONN(obj)->ssl_conn;
3230 parent = XSSLCONN(obj)->parent;
3232 write_c_string("#<OpenSSL socket layer: ", printcharfun);
3234 write_c_string("dead", printcharfun);
3236 write_c_string(SSL_get_version(conn), printcharfun);
3239 if (PROCESSP(parent)) {
3240 write_c_string(" on top of ", printcharfun);
3241 print_internal(parent, printcharfun, escapeflag);
3243 #endif /* HAVE_SOCKETS */
3245 #ifdef HAVE_POSTGRESQL
3246 if (PGCONNP(parent) &&
3247 PQstatus(XPGCONN(parent)->pgconn) == CONNECTION_OK) {
3248 write_c_string(" on top of ", printcharfun);
3249 print_internal(parent, printcharfun, escapeflag);
3251 #endif /* HAVE_POSTGRESQL */
3252 write_c_string(">", printcharfun);
3256 allocate_ssl_conn(void)
3258 Lisp_SSL_CONN *ssl_conn =
3259 alloc_lcrecord_type(Lisp_SSL_CONN, &lrecord_ssl_conn);
3261 /* the network process stuff */
3262 ssl_conn->parent = Qnil;
3263 ssl_conn->infd = -1;
3264 ssl_conn->outfd = -1;
3266 ssl_conn->connected_p = 0;
3267 ssl_conn->protected_p = 0;
3269 ssl_conn->pipe_instream = Qnil;
3270 ssl_conn->pipe_outstream = Qnil;
3272 ssl_conn->coding_instream = Qnil;
3273 ssl_conn->coding_outstream = Qnil;
3280 finalise_ssl_conn(void *header, int for_disksave)
3282 Lisp_SSL_CONN *ssl_conn = (Lisp_SSL_CONN *) header;
3284 if (!(ssl_conn->ssl_conn == NULL)) {
3285 if (ssl_conn->connected_p)
3286 SSL_shutdown(ssl_conn->ssl_conn);
3287 SSL_free(ssl_conn->ssl_conn);
3288 ssl_conn->ssl_conn = NULL;
3290 if (!(ssl_conn->ssl_ctx == NULL)) {
3291 SSL_CTX_free(ssl_conn->ssl_ctx);
3292 ssl_conn->ssl_ctx = NULL;
3294 ssl_conn->ssl_bio = NULL;
3296 if (PROCESSP(ssl_conn->parent)) {
3297 XPROCESS(ssl_conn->parent)->process_type = PROCESS_TYPE_NETWORK;
3298 XPROCESS(ssl_conn->parent)->process_type_data = Qnil;
3300 /* we leave the process alive, it's not our fault, but
3301 * we nullify its pointer
3303 ssl_conn->parent = Qnil;
3304 ssl_conn->infd = -1;
3305 ssl_conn->outfd = -1;
3307 ssl_conn->connected_p = 0;
3308 ssl_conn->protected_p = 0;
3310 /* free the lstream resources */
3311 #if 0 /* will lead to problems */
3312 if (LSTREAMP(ssl_conn->pipe_instream))
3313 Lstream_delete(XLSTREAM(ssl_conn->pipe_instream));
3314 if (LSTREAMP(ssl_conn->pipe_outstream))
3315 Lstream_delete(XLSTREAM(ssl_conn->pipe_outstream));
3317 ssl_conn->pipe_instream = Qnil;
3318 ssl_conn->pipe_outstream = Qnil;
3320 #if 0 /* will lead to problems */
3321 if (LSTREAMP(ssl_conn->coding_instream))
3322 Lstream_delete(XLSTREAM(ssl_conn->coding_instream));
3323 if (LSTREAMP(ssl_conn->coding_outstream))
3324 Lstream_delete(XLSTREAM(ssl_conn->coding_outstream));
3326 ssl_conn->coding_instream = Qnil;
3327 ssl_conn->coding_outstream = Qnil;
3330 /* avoid some warning */
3334 DEFINE_LRECORD_IMPLEMENTATION("ssl_conn", ssl_conn,
3335 mark_ssl_conn, print_ssl_conn,
3337 NULL, NULL, 0, Lisp_SSL_CONN);
3340 ssl_conn_alive_p(Lisp_SSL_CONN *ssl_conn)
3342 return ssl_conn->connected_p;
3346 get_process_infd(Lisp_Process * p)
3348 Lisp_Object instr, outstr;
3349 get_process_streams(p, &instr, &outstr);
3350 return Lstream_get_fd(XLSTREAM(instr));
3353 get_process_outfd(Lisp_Process * p)
3355 Lisp_Object instr, outstr;
3356 get_process_streams(p, &instr, &outstr);
3357 return Lstream_get_fd(XLSTREAM(outstr));
3361 event_stream_ssl_create_stream_pair(
3363 Lisp_Object *instream, Lisp_Object *outstream, int flags)
3365 *instream = make_ssl_input_stream(conn, flags);
3366 *outstream = make_ssl_output_stream(conn, flags);
3372 init_ssl_io_handles(Lisp_SSL_CONN *s, int flags)
3374 event_stream_ssl_create_stream_pair(
3375 s->ssl_conn, &s->pipe_instream, &s->pipe_outstream, flags);
3378 s->coding_instream = make_decoding_input_stream(
3379 XLSTREAM(s->pipe_instream), Fget_coding_system(
3380 Vcoding_system_for_read));
3381 Lstream_set_character_mode(XLSTREAM(s->coding_instream));
3382 s->coding_outstream = make_encoding_output_stream(
3383 XLSTREAM(s->pipe_outstream), Fget_coding_system(
3384 Vcoding_system_for_write));
3385 #endif /* FILE_CODING */
3388 /* Advanced step-by-step initialisation */
3389 #define OSSL_CHECK_PROCESS(process) \
3391 /* Make sure the process is really alive. */ \
3392 if (!EQ(XPROCESS(process)->status_symbol, Qrun)) \
3393 error("Network stream %s not alive", \
3394 XSTRING_DATA(XPROCESS(process)->name)); \
3395 /* Make sure the process is a network stream. */ \
3396 if (!network_connection_p(process)) \
3397 error("Process %s is not a network stream", \
3398 XSTRING_DATA(XPROCESS(process)->name)); \
3401 #ifdef OSSL_DEBUG_FLAG
3403 ossl_bio_dump_callback(BIO *bio, int cmd, const char *argp,
3404 int argi, long argl, long ret)
3408 out=(BIO *)BIO_get_callback_arg(bio);
3409 if (out == NULL) return(ret);
3411 if (cmd == (BIO_CB_READ|BIO_CB_RETURN))
3413 BIO_printf(out,"read from %p [%p] (%d bytes => %ld (0x%lX))\n",
3414 (void *)bio,argp,argi,ret,ret);
3415 BIO_dump(out,argp,(int)ret);
3418 else if (cmd == (BIO_CB_WRITE|BIO_CB_RETURN))
3420 BIO_printf(out,"write to %p [%p] (%d bytes => %ld (0x%lX))\n",
3421 (void *)bio,argp,argi,ret,ret);
3422 BIO_dump(out,argp,(int)ret);
3429 ossl_ssl_prepare_cmeth(Lisp_Object method)
3431 SSL_METHOD *meth = NULL;
3432 Lisp_SSL_CONN *lisp_ssl_conn;
3434 /* start preparing the conn object */
3436 SSL_load_error_strings();
3439 else if (EQ(method, Qssl2))
3440 meth = (SSL_METHOD *)SSLv2_client_method();
3441 else if (EQ(method, Qssl3))
3442 meth = (SSL_METHOD *)SSLv3_client_method();
3443 else if (EQ(method, Qssl23))
3444 meth = (SSL_METHOD *)SSLv23_client_method();
3445 else if (EQ(method, Qtls1))
3446 meth = (SSL_METHOD *)TLSv1_client_method();
3448 meth = (SSL_METHOD *)TLSv1_client_method();
3451 error("OSSL: not enough random data");
3453 /* now allocate this stuff, pump it and return */
3454 lisp_ssl_conn = allocate_ssl_conn();
3455 lisp_ssl_conn->ssl_meth = meth;
3456 lisp_ssl_conn->ssl_ctx = NULL;
3457 lisp_ssl_conn->ssl_conn = NULL;
3458 lisp_ssl_conn->ssl_bio = NULL;
3460 return make_ssl_conn(lisp_ssl_conn);
3464 ossl_ssl_prepare_smeth(Lisp_Object method)
3466 SSL_METHOD *meth = NULL;
3467 Lisp_SSL_CONN *lisp_ssl_conn;
3469 /* start preparing the conn object */
3471 SSL_load_error_strings();
3474 else if (EQ(method, Qssl2))
3475 meth = (SSL_METHOD *)SSLv2_server_method();
3476 else if (EQ(method, Qssl3))
3477 meth = (SSL_METHOD *)SSLv3_server_method();
3478 else if (EQ(method, Qssl23))
3479 meth = (SSL_METHOD *)SSLv23_server_method();
3480 else if (EQ(method, Qtls1))
3481 meth = (SSL_METHOD *)TLSv1_server_method();
3483 meth = (SSL_METHOD *)SSLv23_server_method();
3486 error("OSSL: not enough random data");
3488 /* now allocate this stuff, pump it and return */
3489 lisp_ssl_conn = allocate_ssl_conn();
3490 lisp_ssl_conn->ssl_meth = meth;
3491 lisp_ssl_conn->ssl_ctx = NULL;
3492 lisp_ssl_conn->ssl_conn = NULL;
3493 lisp_ssl_conn->ssl_bio = NULL;
3495 return make_ssl_conn(lisp_ssl_conn);
3499 ossl_ssl_prepare_ctx(Lisp_Object ssl_conn)
3501 /* SSL connection stuff */
3502 SSL_CTX *ctx = NULL;
3503 Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3505 ctx = SSL_CTX_new(lisp_ssl_conn->ssl_meth);
3507 error("OSSL: context initialisation failed");
3509 /* OpenSSL contains code to work-around lots of bugs and flaws in
3510 * various SSL-implementations. SSL_CTX_set_options() is used to enabled
3511 * those work-arounds. The man page for this option states that
3512 * SSL_OP_ALL enables all the work-arounds and that "It is usually safe
3513 * to use SSL_OP_ALL to enable the bug workaround options if
3514 * compatibility with somewhat broken implementations is desired."
3516 SSL_CTX_set_options(ctx, SSL_OP_ALL);
3518 lisp_ssl_conn->ssl_ctx = ctx;
3524 ossl_ssl_prepare(Lisp_Object ssl_conn, void(*fun)(SSL*))
3526 /* SSL connection stuff */
3529 #ifdef OSSL_DEBUG_FLAG
3530 BIO *bio_c_out = NULL;
3532 Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3534 /* now initialise a new connection context */
3535 conn = SSL_new(lisp_ssl_conn->ssl_ctx);
3536 if (conn == NULL || fun == NULL)
3537 error("OSSL: connection initialisation failed");
3539 /* always renegotiate */
3540 SSL_set_mode(conn, SSL_MODE_AUTO_RETRY);
3542 /* initialise the main connection BIO */
3543 bio = BIO_new(BIO_s_socket());
3545 #ifdef OSSL_DEBUG_FLAG
3546 /* this is a debug BIO which pukes tons of stuff to stderr */
3547 bio_c_out = BIO_new_fp(stderr, BIO_NOCLOSE);
3548 BIO_set_callback(bio, ossl_bio_dump_callback);
3549 BIO_set_callback_arg(bio, bio_c_out);
3552 /* connect SSL with the bio */
3553 SSL_set_bio(conn, bio, bio);
3554 /* turn into client or server */
3557 /* now allocate this stuff, pump it and return */
3558 lisp_ssl_conn->ssl_conn = conn;
3559 lisp_ssl_conn->ssl_bio = bio;
3561 /* create lstream handles */
3562 init_ssl_io_handles(lisp_ssl_conn, STREAM_NETWORK_CONNECTION);
3567 /* Injection of CA certificates */
3568 int ossl_ssl_inject_ca(Lisp_Object ssl_conn, Lisp_Object cacert)
3574 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3575 cert = XEVPPKEY(cacert)->evp_pkey;
3576 xc509 = XEVPPKEY(cacert)->x509;
3578 if (cert && !xc509) {
3580 X509_set_pubkey(xc509, cert);
3581 XEVPPKEY(cacert)->x509 = xc509;
3586 /* what about coding system issues? */
3587 if (!SSL_CTX_add_client_CA(ctx, xc509))
3593 int ossl_ssl_inject_ca_file(Lisp_Object ssl_conn, Lisp_Object cafile)
3597 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3599 /* what about coding system issues? */
3600 if (!SSL_CTX_load_verify_locations(
3601 ctx, (char*)XSTRING_DATA(cafile), NULL))
3607 int ossl_ssl_inject_ca_path(Lisp_Object ssl_conn, Lisp_Object capath)
3611 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3613 /* what about coding system issues? */
3614 if (!SSL_CTX_load_verify_locations(
3615 ctx, NULL, (char*)XSTRING_DATA(capath)))
3621 int ossl_ssl_inject_cert(Lisp_Object ssl_conn,
3622 Lisp_Object cert, Lisp_Object key)
3629 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3630 pkey = XEVPPKEY(key)->evp_pkey;
3631 xcert = XEVPPKEY(cert)->evp_pkey;
3632 xc509 = XEVPPKEY(cert)->x509;
3634 if (xcert && !xc509) {
3636 X509_set_pubkey(xc509, xcert);
3637 XEVPPKEY(cert)->x509 = xc509;
3642 if (SSL_CTX_use_certificate(ctx, xc509) <= 0)
3645 if (SSL_CTX_use_PrivateKey(ctx, pkey) <= 0)
3647 if (!SSL_CTX_check_private_key(ctx))
3653 int ossl_ssl_inject_cert_file(Lisp_Object ssl_conn,
3654 Lisp_Object cert, Lisp_Object key)
3658 ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3660 if (SSL_CTX_use_certificate_file(
3661 ctx, (char*)XSTRING_DATA(cert), SSL_FILETYPE_PEM) <= 0)
3663 if (SSL_CTX_use_PrivateKey_file(
3664 ctx, (char*)XSTRING_DATA(key), SSL_FILETYPE_PEM) <= 0)
3666 if (!SSL_CTX_check_private_key(ctx))
3672 Lisp_Object ossl_ssl_handshake(Lisp_Object ssl_conn, Lisp_Object process)
3674 /* This function can GC */
3675 /* SSL connection stuff */
3678 #if 0 && defined(OSSL_DEBUG_FLAG)
3679 BIO *bio_c_out = NULL;
3681 int ret, err, infd, outfd;
3683 struct gcpro gcpro1, gcpro2;
3685 /* Make sure we have a process, the alive check should be done in the
3686 function calling this here */
3687 CHECK_PROCESS(process);
3689 GCPRO2(ssl_conn, process);
3691 /* set the alternate one */
3692 event_stream_unselect_process(XPROCESS(process));
3695 /* just announce that we are very binary */
3696 Fset_process_coding_system(process, Qbinary, Qbinary);
3699 /* initialise the process' buffer for type-specific data,
3700 * we will store process input there */
3701 XPROCESS(process)->process_type_data = Qnil;
3703 /* retrieve the sockets of the process */
3704 infd = get_process_infd(XPROCESS(process));
3705 outfd = get_process_outfd(XPROCESS(process));
3707 /* push data to ssl_conn */
3708 XSSLCONN(ssl_conn)->parent = process;
3709 XSSLCONN(ssl_conn)->infd = infd;
3710 XSSLCONN(ssl_conn)->outfd = outfd;
3712 /* frob vars from ssl_conn */
3713 conn = XSSLCONN(ssl_conn)->ssl_conn;
3714 bio = XSSLCONN(ssl_conn)->ssl_bio;
3716 /* initialise the main connection BIO */
3717 BIO_set_fd(bio, infd, 0);
3719 /* now perform the actual handshake
3720 * this is a loop because of the genuine openssl concept to not handle
3721 * non-blocking I/O correctly */
3725 ret = SSL_do_handshake(conn);
3726 err = SSL_get_error(conn, ret);
3728 /* perform select() with timeout
3729 * 1 second at the moment */
3733 if (err == SSL_ERROR_NONE) {
3735 } else if (err == SSL_ERROR_WANT_READ) {
3737 OSSL_DEBUG("WANT_READ\n");
3740 FD_SET(infd, &read_fds);
3742 /* wait for socket to be readable */
3743 if (!(ret = select(infd+1, &read_fds, 0, NULL, &to))) {
3745 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3746 error("timeout during handshake");
3749 } else if (err == SSL_ERROR_WANT_WRITE) {
3751 OSSL_DEBUG("WANT_WRITE\n");
3752 FD_ZERO(&write_fds);
3753 FD_SET(outfd, &write_fds);
3755 /* wait for socket to be writable */
3756 if (!(ret = select(infd+1, &write_fds, 0, NULL, &to))) {
3758 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3759 error("timeout during handshake");
3762 } else if (err == SSL_ERROR_SSL) {
3763 /* close down the process object */
3764 Fdelete_process(process);
3767 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3768 error("handshake failed");
3771 OSSL_CRITICAL("\nUnknown error: %d\n"
3773 "sxemacs-devel@sxemacs.org\n\n", err);
3776 /* we used to check whether the connection is
3777 still alive, but this was perhaps a bad idea */
3778 try = BIO_read(bio, buf, 2);
3780 (try < 0 && !BIO_should_retry(bio))) {
3781 /* Handle closed connection */
3782 XPROCESS(process)->exit_code = 256;
3783 XPROCESS(process)->status_symbol = Qexit;
3786 /* close down the process object */
3787 Fdelete_process(process);
3791 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3792 error("unknown handshake error");
3797 /* marry the socket layer now */
3798 ossl_ssl_proselytise_process(ssl_conn, process);
3800 /* declare the whole pig connected */
3801 XSSLCONN(ssl_conn)->connected_p = 1;
3803 event_stream_select_process(XPROCESS(process));
3809 DEFUN("ossl-ssl-inject-cert", Fossl_ssl_inject_cert, 2, 3, 0, /*
3810 Add CERT as the local certificate of SSL-CONN.
3811 Optional argument KEY specifies a key file or evp-pkey, if
3812 CERT does not contain it.
3814 Both, CERT and KEY may be either a filename pointing to a
3815 PEM-encoded certificate and key respectively, or may be an
3818 (ssl_conn, cert, key))
3820 /* This function can GC */
3821 int (*fun)(Lisp_Object, Lisp_Object, Lisp_Object) = NULL;
3822 struct gcpro gcpro1, gcpro2, gcpro3;
3824 GCPRO3(ssl_conn, cert, key);
3826 CHECK_SSLCONN(ssl_conn);
3829 CHECK_EVPPKEY(cert);
3834 /* certificate and key preparation */
3835 if (STRINGP(cert)) {
3836 cert = Fexpand_file_name(cert, Qnil);
3837 if (NILP(Ffile_readable_p(cert)))
3842 key = Fexpand_file_name(key, Qnil);
3843 if (NILP(Ffile_readable_p(key)))
3847 if (STRINGP(cert) && NILP(key))
3849 else if (EVPPKEYP(cert) && NILP(key))
3852 /* certificate and key injection */
3853 if (!NILP(cert) && !NILP(key) &&
3854 STRINGP(cert) && STRINGP(key))
3855 fun = ossl_ssl_inject_cert_file;
3856 else if (!NILP(cert) && !NILP(key) &&
3857 EVPPKEYP(cert) && EVPPKEYP(key))
3858 fun = ossl_ssl_inject_cert;
3860 if (fun && fun(ssl_conn, cert, key)) {
3869 DEFUN("ossl-ssl-inject-ca", Fossl_ssl_inject_ca, 2, 2, 0, /*
3870 Add CA to the pile of certificate authorities of SSL-CONN.
3871 Also force a \(re\)verification of the remote peer certificate
3872 against CA. Return `t' if the injection was successful,
3875 CA may be either a file name pointing to a PEM-encoded
3876 CA certificate, or may be a directory containing a valid
3877 bunch of CA certificates according to OpenSSL's CA path
3878 layout, or may also be an evp-pkey object.
3882 /* This function can GC */
3883 int (*fun)(Lisp_Object, Lisp_Object) = NULL;
3885 struct gcpro gcpro1, gcpro2;
3887 GCPRO2(ssl_conn, ca);
3889 CHECK_SSLCONN(ssl_conn);
3895 ca = Fexpand_file_name(ca, Qnil);
3896 if (NILP(Ffile_readable_p(ca)))
3900 if (!NILP(ca) && STRINGP(ca)) {
3901 if (NILP(Ffile_directory_p(ca)))
3902 fun = ossl_ssl_inject_ca_file;
3904 fun = ossl_ssl_inject_ca_path;
3905 } else if (!NILP(ca) && EVPPKEYP(ca))
3906 fun = ossl_ssl_inject_ca;
3908 if (fun && fun(ssl_conn, ca) &&
3909 (conn = XSSLCONN(ssl_conn)->ssl_conn)) {
3910 ssl_verify_cert_chain(conn, SSL_get_peer_cert_chain(conn));
3919 DEFUN("ossl-ssl-handshake", Fossl_ssl_handshake, 1, 6, 0, /*
3920 Perform a handshake on the network connection PROCESS.
3922 Return a ssl-conn object, or `nil' if the handshake failed.
3923 In the latter case, most likely the remote site cannot handle
3924 the specified method, requires a client certificate, or cannot
3927 Optional argument METHOD indicates the SSL connection method,
3928 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
3930 Optional argument CA indicates a CA certificate.
3931 See `ossl-ssl-inject-ca'.
3933 Optional arguments CERT and KEY indicate a peer certificate
3934 and possibly a separate key file respectively.
3935 See `ossl-ssl-inject-peer-cert'.
3937 Optional argument SERVERP indicates whether to perform the
3938 handshake as a server if non-nil, and as a client otherwise.
3939 Note: In case of a handshake as server it is mandatory to provide
3940 a valid certificate and a corresponding key.
3942 (process, method, ca, cert, key, serverp))
3944 /* This function can GC */
3946 Lisp_Object ssl_conn, result;
3948 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
3950 GCPRO6(process, method, ca, cert, key, serverp);
3952 /* Make sure the process is really alive. */
3953 CHECK_PROCESS(process);
3954 OSSL_CHECK_PROCESS(process);
3956 /* create a ssl_conn object first */
3958 ssl_conn = ossl_ssl_prepare_cmeth(method);
3960 ssl_conn = ossl_ssl_prepare_smeth(method);
3962 /* create the context */
3963 ossl_ssl_prepare_ctx(ssl_conn);
3965 /* certificate and key preparation */
3966 Fossl_ssl_inject_cert(ssl_conn, cert, key);
3967 /* certificate authority preparation */
3968 Fossl_ssl_inject_ca(ssl_conn, ca);
3970 /* prepare for handshake */
3972 ossl_ssl_prepare(ssl_conn, SSL_set_connect_state);
3974 ossl_ssl_prepare(ssl_conn, SSL_set_accept_state);
3976 result = ossl_ssl_handshake(ssl_conn, process);
3982 DEFUN("ossl-ssl-connect", Fossl_ssl_connect, 0, MANY, 0, /*
3983 Perform a TLS or SSL handshake, return a ssl-conn object on
3984 success, or `nil' if the handshake failed.
3985 In the latter case, most likely the remote site cannot handle
3986 the specified method, requires a client certificate, or cannot
3997 Optional argument METHOD indicates the SSL connection method,
3998 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
4000 (int nargs, Lisp_Object *args))
4004 for (i = 0; i < nargs; i++);
4010 ossl_swap_process_streams(Lisp_SSL_CONN *s, Lisp_Process *p)
4012 Lisp_Object in, out;
4014 in = p->pipe_instream;
4015 out = p->pipe_outstream;
4017 p->pipe_instream = s->pipe_instream;
4018 p->pipe_outstream = s->pipe_outstream;
4020 s->pipe_instream = in;
4021 s->pipe_outstream = out;
4024 in = p->coding_instream;
4025 out = p->coding_outstream;
4027 p->coding_instream = s->coding_instream;
4028 p->coding_outstream = s->coding_outstream;
4030 s->coding_instream = in;
4031 s->coding_outstream = out;
4036 ossl_ssl_proselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4038 Lisp_Process *p = XPROCESS(process);
4039 Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4041 event_stream_unselect_process(p);
4043 /* put the streams we have in the ssl-conn object into the process
4044 object; actually these swap their places */
4045 if (p->process_type != PROCESS_TYPE_SSL)
4046 ossl_swap_process_streams(s, p);
4048 /* somehow we gotta link the network-process with the ss-layer
4049 * otherwise it'd be easy to open a network stream then
4050 * a ss-layer on top of it and then via `delete-process'
4051 * all the work is void while the ss-layer still exists
4053 p->process_type = PROCESS_TYPE_SSL;
4054 p->process_type_data = ssl_conn;
4056 event_stream_select_process(p);
4062 ossl_ssl_unproselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4064 Lisp_Process *p = XPROCESS(process);
4065 Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4067 /* put the streams we have in the ssl-conn object into the process
4068 object (they should be the former process streams) */
4069 if (p->process_type == PROCESS_TYPE_SSL)
4070 ossl_swap_process_streams(s, p);
4072 /* somehow we gotta link the network-process with the ss-layer
4073 * otherwise it'd be easy to open a network stream then
4074 * a ss-layer on top of it and then via `delete-process'
4075 * all the work is void while the ss-layer still exists
4077 XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
4078 XPROCESS(process)->process_type_data = Qnil;
4083 DEFUN("ossl-ssl-proselytise-process", Fossl_ssl_proselytise_process,
4085 Convert the underlying process of SSL-CONN into a secure
4086 network connection object.
4090 Lisp_Object process;
4092 CHECK_SSLCONN(ssl_conn);
4094 process = XSSLCONN(ssl_conn)->parent;
4095 if (!PROCESSP(process)) {
4096 error("no process associated with this connection");
4100 /* Make sure the process is really alive. */
4101 OSSL_CHECK_PROCESS(process);
4103 ossl_ssl_proselytise_process(ssl_conn, process);
4108 DEFUN("ossl-ssl-unproselytise-process", Fossl_ssl_unproselytise_process,
4110 Convert the underlying process of SSL-CONN into an ordinary
4111 network connection object.
4115 Lisp_Object process;
4117 CHECK_SSLCONN(ssl_conn);
4119 process = XSSLCONN(ssl_conn)->parent;
4120 if (!PROCESSP(process)) {
4121 error("no process associated with this connection");
4125 /* Make sure the process is really alive. */
4126 OSSL_CHECK_PROCESS(process);
4128 /* Castrate the process and make it a network process again */
4129 ossl_ssl_unproselytise_process(ssl_conn, process);
4134 DEFUN("ossl-ssl-finish", Fossl_ssl_finish, 1, 1, 0, /*
4135 Finish an SSL connection SSL-CONN.
4137 Note: This may also finish the network connection.
4141 Lisp_Object process;
4143 CHECK_SSLCONN(ssl_conn);
4145 if (XSSLCONN(ssl_conn)->protected_p)
4146 error ("Cannot finish protected SSL connection");
4148 process = XSSLCONN(ssl_conn)->parent;
4149 if (PROCESSP(process))
4150 ossl_ssl_unproselytise_process(ssl_conn, process);
4152 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
4156 DEFUN("ossl-ssl-read", Fossl_ssl_read, 2, 2, 0, /*
4157 Return the cleartext of STRING which is assumed to be a complete
4158 block of data sent through SSL-CONN.
4162 /* network stream stuff */
4164 Lisp_Object process;
4166 Lisp_Object result = Qnil;
4168 CHECK_SSLCONN(ssl_conn);
4169 CHECK_STRING(string);
4171 if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4172 error("SSL connection dead");
4174 conn = XSSLCONN(ssl_conn)->ssl_conn;
4175 process = XSSLCONN(ssl_conn)->parent;
4177 /* Make sure the process is really alive. */
4178 OSSL_CHECK_PROCESS(process);
4183 DEFUN("ossl-ssl-write", Fossl_ssl_write, 2, 2, 0, /*
4184 Send STRING to the tunnel SSL-CONN.
4188 /* network stream stuff */
4190 Lisp_Object process, proc_filter;
4195 CHECK_SSLCONN(ssl_conn);
4196 CHECK_STRING(string);
4198 if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4199 error("SSL connection dead");
4201 conn = XSSLCONN(ssl_conn)->ssl_conn;
4202 process = XSSLCONN(ssl_conn)->parent;
4204 /* Make sure the process is really alive. */
4205 OSSL_CHECK_PROCESS(process);
4207 switch (XPROCESS(process)->process_type) {
4208 case PROCESS_TYPE_NETWORK:
4209 /* ssl streams reside in ssl-conn object atm */
4210 out = XLSTREAM(DATA_OUTSTREAM(XSSLCONN(ssl_conn)));
4212 case PROCESS_TYPE_SSL:
4213 /* ssl streams reside in process object, snarf from there */
4214 out = XLSTREAM(DATA_OUTSTREAM(XPROCESS(process)));
4218 error("unable to write");
4221 /* store the original process filter */
4222 proc_filter = XPROCESS(process)->filter;
4224 ret = Lstream_write(out, XSTRING_DATA(string), XSTRING_LENGTH(string));
4227 switch (SSL_get_error(conn, ret)) {
4228 case SSL_ERROR_NONE:
4230 case SSL_ERROR_WANT_WRITE:
4231 error("Connection wants write");
4232 case SSL_ERROR_WANT_READ:
4233 error("Connection wants read");
4235 error("Severe SSL connection error");
4238 /* restore the original process filter */
4239 return (SSL_pending(conn) == 0) ? Qt : Qnil;
4242 /* convenience functions */
4243 DEFUN("ossl-ssl-parent", Fossl_ssl_parent, 1, 1, 0, /*
4244 Return the underlying parent layer of SSL-CONN.
4248 CHECK_SSLCONN(ssl_conn);
4250 return XSSLCONN(ssl_conn)->parent;
4253 DEFUN("ossl-ssl-cert", Fossl_ssl_cert, 1, 1, 0, /*
4254 Return the local peer's certificate of SSL-CONN if present,
4259 /* SSL connection stuff */
4263 CHECK_SSLCONN(ssl_conn);
4265 conn = XSSLCONN(ssl_conn)->ssl_conn;
4266 cert = SSL_get_certificate(conn);
4269 return make_evp_pkey_x509(cert);
4274 DEFUN("ossl-ssl-peer-cert", Fossl_ssl_peer_cert, 1, 1, 0, /*
4275 Return the remote peer's certificate of SSL-CONN if present,
4280 /* SSL connection stuff */
4284 CHECK_SSLCONN(ssl_conn);
4286 conn = XSSLCONN(ssl_conn)->ssl_conn;
4287 cert = SSL_get_peer_certificate(conn);
4290 return make_evp_pkey_x509(cert);
4295 DEFUN("ossl-ssl-peer-cert-chain", Fossl_ssl_peer_cert_chain, 1, 1, 0, /*
4296 Return the certificate chain of SSL-CONN as a list of
4302 /* SSL connection stuff */
4306 Lisp_Object result = Qnil;
4308 CHECK_SSLCONN(ssl_conn);
4310 conn = XSSLCONN(ssl_conn)->ssl_conn;
4311 sk = SSL_get_peer_cert_chain(conn);
4316 for (i=0; i<sk_X509_num(sk); i++) {
4317 X509 *cert = sk_X509_value(sk, i);
4319 result = Fcons(make_evp_pkey_x509(cert), result);
4326 DEFUN("ossl-ssl-cert-store", Fossl_ssl_cert_store, 1, 1, 0, /*
4327 Return the X509 cert store of SSL-CONN.
4331 X509_STORE *sto = NULL;
4337 #if 0 /* just thoughts */
4338 int SSL_get_verify_mode(const SSL *s);
4339 int SSL_get_verify_depth(const SSL *s);
4342 DEFUN("ossl-ssl-verify-certificate", Fossl_ssl_verify_certificate,
4344 Return a verify code of SSL-CONN.
4346 The result is a cons cell with the numeric verify code in
4347 the car and a verbose string in the cdr.
4352 /* SSL connection stuff */
4355 Lisp_Object result = Qnil;
4357 CHECK_SSLCONN(ssl_conn);
4359 conn = XSSLCONN(ssl_conn)->ssl_conn;
4360 vrc = SSL_get_verify_result(conn);
4364 build_string(X509_verify_cert_error_string(vrc)));
4369 DEFUN("ossl-ssl-cipher-version", Fossl_ssl_cipher_version, 1, 1, 0, /*
4370 Return the protocol version of the tunnel SSL-CONN.
4374 /* SSL connection stuff */
4376 const SSL_CIPHER *ciph;
4377 /* network stream stuff */
4378 Lisp_SSL_CONN *lisp_ssl_conn;
4380 CHECK_SSLCONN(ssl_conn);
4381 lisp_ssl_conn = XSSLCONN(ssl_conn);
4383 conn = lisp_ssl_conn->ssl_conn;
4387 ciph = SSL_get_current_cipher(conn);
4389 if (!(ciph == NULL))
4390 return Fmake_symbol(
4391 build_string(SSL_CIPHER_get_version(ciph)));
4396 DEFUN("ossl-ssl-cipher-name", Fossl_ssl_cipher_name, 1, 1, 0, /*
4397 Return the name of the current cipher used in the tunnel SSL-CONN.
4401 /* SSL connection stuff */
4403 const SSL_CIPHER *ciph;
4404 /* network stream stuff */
4405 Lisp_SSL_CONN *lisp_ssl_conn;
4407 CHECK_SSLCONN(ssl_conn);
4408 lisp_ssl_conn = XSSLCONN(ssl_conn);
4410 conn = lisp_ssl_conn->ssl_conn;
4414 ciph = SSL_get_current_cipher(conn);
4416 if (!(ciph == NULL))
4417 return intern(SSL_CIPHER_get_name(ciph));
4422 DEFUN("ossl-ssl-cipher-names", Fossl_ssl_cipher_names, 1, 1, 0, /*
4423 Return the names of all supported ciphers in the tunnel SSL-CONN.
4428 /* SSL connection stuff */
4430 STACK_OF(SSL_CIPHER) *ciphs;
4431 Lisp_Object result = Qnil;
4433 CHECK_SSLCONN(ssl_conn);
4435 conn = XSSLCONN(ssl_conn)->ssl_conn;
4439 ciphs = SSL_get_ciphers(conn);
4441 for (i=sk_SSL_CIPHER_num(ciphs)-1; i>=0; i--) {
4442 SSL_CIPHER *ciph = sk_SSL_CIPHER_value(ciphs, i);
4444 result = Fcons(intern(SSL_CIPHER_get_name(ciph)), result);
4450 DEFUN("ossl-ssl-cipher-bits", Fossl_ssl_cipher_bits, 1, 1, 0, /*
4451 Return the number of effective bits of the current cipher in SSL-CONN.
4455 /* SSL connection stuff */
4457 const SSL_CIPHER *ciph;
4458 int alg_bits, strength_bits;
4459 /* network stream stuff */
4460 Lisp_SSL_CONN *lisp_ssl_conn;
4462 CHECK_SSLCONN(ssl_conn);
4463 lisp_ssl_conn = XSSLCONN(ssl_conn);
4465 conn = lisp_ssl_conn->ssl_conn;
4469 ciph = SSL_get_current_cipher(conn);
4471 if (!(ciph == NULL)) {
4472 strength_bits = SSL_CIPHER_get_bits(ciph, &alg_bits);
4473 /* what do we want to do with alg_bits? */
4474 return make_int(strength_bits);
4479 DEFUN("ossl-ssl-cipher-description", Fossl_ssl_cipher_description, 1, 1, 0, /*
4480 Return a description of the current cipher used in the tunnel SSL-CONN.
4484 /* SSL connection stuff */
4486 const SSL_CIPHER *ciph;
4487 /* network stream stuff */
4488 Lisp_SSL_CONN *lisp_ssl_conn;
4490 CHECK_SSLCONN(ssl_conn);
4491 lisp_ssl_conn = XSSLCONN(ssl_conn);
4493 conn = lisp_ssl_conn->ssl_conn;
4497 ciph = SSL_get_current_cipher(conn);
4499 if (!(ciph == NULL))
4500 return build_string(SSL_CIPHER_description(ciph, NULL, 0));
4506 /* X509 cert handling */
4507 DEFUN("ossl-x509-subject", Fossl_x509_subject, 1, 1, 0, /*
4508 Return the certificate subject of CERT (an evp-pkey object).
4510 This will return a string in LDAP syntax.
4516 CHECK_EVPPKEY(cert);
4518 pk509 = XEVPPKEY(cert)->x509;
4521 X509_NAME *sub = X509_get_subject_name(pk509);
4522 return build_string(X509_NAME_oneline(sub, NULL, 0));
4527 DEFUN("ossl-x509-issuer", Fossl_x509_issuer, 1, 1, 0, /*
4528 Return the certificate issuer of CERT (an evp-pkey object),
4529 that is the organisation which signed the certificate.
4531 This will return a string in LDAP syntax.
4537 CHECK_EVPPKEY(cert);
4539 pk509 = XEVPPKEY(cert)->x509;
4542 X509_NAME *iss = X509_get_issuer_name(pk509);
4543 return build_string(X509_NAME_oneline(iss, NULL, 0));
4548 DEFUN("ossl-x509-serial", Fossl_x509_serial, 1, 1, 0, /*
4549 Return the certificate serial of CERT (an evp-pkey object).
4555 CHECK_EVPPKEY(cert);
4557 pk509 = XEVPPKEY(cert)->x509;
4560 ASN1_INTEGER *ser = X509_get_serialNumber(pk509);
4561 return make_integer(ASN1_INTEGER_get(ser));
4566 DEFUN("ossl-x509-not-before", Fossl_x509_not_before, 1, 1, 0, /*
4567 Return the certificate valid-not-before time of CERT.
4573 CHECK_EVPPKEY(cert);
4575 pk509 = XEVPPKEY(cert)->x509;
4578 ASN1_TIME *nbf = X509_get_notBefore(pk509);
4579 return build_string((char*)nbf->data);
4584 DEFUN("ossl-x509-not-after", Fossl_x509_not_after, 1, 1, 0, /*
4585 Return the certificate valid-not-after time of CERT.
4591 CHECK_EVPPKEY(cert);
4593 pk509 = XEVPPKEY(cert)->x509;
4596 ASN1_TIME *nbf = X509_get_notAfter(pk509);
4597 return build_string((char*)nbf->data);
4602 DEFUN("ossl-x509-signature-type", Fossl_x509_signature_type, 1, 1, 0, /*
4603 Return the signature type of CERT.
4609 CHECK_EVPPKEY(cert);
4611 pk509 = XEVPPKEY(cert)->x509;
4614 int ty = X509_get_signature_type(pk509);
4615 Lisp_Object result = Qnil;
4619 result = intern("none");
4621 #ifndef OPENSSL_NO_RSA
4623 result = intern("rsa");
4626 result = intern("rsa2");
4629 #ifndef OPENSSL_NO_DSA
4631 result = intern("dsa");
4634 result = intern("dsa1");
4637 result = intern("dsa2");
4640 result = intern("dsa3");
4643 result = intern("dsa4");
4646 #ifndef OPENSSL_NO_DH
4648 result = intern("dh");
4651 #ifndef OPENSSL_NO_EC
4653 result = intern("ec");
4657 result = intern("unknown");
4672 * Initialisation stuff
4675 void syms_of_openssl(void)
4677 INIT_LRECORD_IMPLEMENTATION(evp_pkey);
4678 INIT_LRECORD_IMPLEMENTATION(ssl_conn);
4680 defsymbol(&Qopenssl, "openssl");
4681 defsymbol(&Qevp_pkeyp, "ossl-pkey-p");
4683 DEFSUBR(Fossl_version);
4684 DEFSUBR(Fossl_available_digests);
4685 DEFSUBR(Fossl_available_ciphers);
4686 DEFSUBR(Fossl_digest_size);
4687 DEFSUBR(Fossl_digest_bits);
4688 DEFSUBR(Fossl_digest_block_size);
4689 DEFSUBR(Fossl_cipher_key_length);
4690 DEFSUBR(Fossl_cipher_bits);
4691 DEFSUBR(Fossl_cipher_iv_length);
4692 DEFSUBR(Fossl_cipher_block_size);
4693 DEFSUBR(Fossl_cipher_mode);
4695 DEFSUBR(Fossl_rand_bytes);
4696 DEFSUBR(Fossl_rand_bytes_egd);
4698 DEFSUBR(Fossl_digest);
4699 DEFSUBR(Fossl_digest_file);
4701 DEFSUBR(Fossl_hmac);
4702 DEFSUBR(Fossl_hmac_file);
4704 DEFSUBR(Fossl_bytes_to_key);
4705 DEFSUBR(Fossl_encrypt);
4706 DEFSUBR(Fossl_encrypt_file);
4707 DEFSUBR(Fossl_decrypt);
4708 DEFSUBR(Fossl_decrypt_file);
4711 DEFSUBR(Fossl_pkey_p);
4712 DEFSUBR(Fossl_pkey_size);
4713 DEFSUBR(Fossl_pkey_private_p);
4714 DEFSUBR(Fossl_pkey_get_public);
4716 #ifndef OPENSSL_NO_RSA
4718 DEFSUBR(Fossl_rsa_generate_key);
4719 DEFSUBR(Fossl_rsa_pkey_p);
4720 DEFSUBR(Fossl_rsa_subkey_p);
4721 #endif /* OPENSSL_NO_RSA */
4722 #ifndef OPENSSL_NO_DSA
4724 DEFSUBR(Fossl_dsa_generate_key);
4725 DEFSUBR(Fossl_dsa_pkey_p);
4726 DEFSUBR(Fossl_dsa_subkey_p);
4727 #endif /* OPENSSL_NO_DSA */
4728 #ifndef OPENSSL_NO_EC
4730 DEFSUBR(Fossl_ec_available_curves);
4731 DEFSUBR(Fossl_ec_generate_key);
4732 DEFSUBR(Fossl_ec_pkey_p);
4733 #endif /* OPENSSL_NO_EC */
4734 #ifndef OPENSSL_NO_DH
4736 /* DEFSUBR(Fossl_ec_generate_key); */
4737 DEFSUBR(Fossl_dh_pkey_p);
4739 DEFSUBR(Fossl_seal);
4740 DEFSUBR(Fossl_open);
4742 DEFSUBR(Fossl_sign);
4743 DEFSUBR(Fossl_verify);
4746 DEFSUBR(Fossl_pem_read_public_key);
4747 DEFSUBR(Fossl_pem_read_key);
4748 DEFSUBR(Fossl_pem_write_public_key);
4749 DEFSUBR(Fossl_pem_write_key);
4750 DEFSUBR(Fossl_pem_public_key);
4751 DEFSUBR(Fossl_pem_key);
4754 defsymbol(&Qssl_connp, "ossl-ssl-conn-p");
4755 defsymbol(&Qssl2, "ssl2");
4756 defsymbol(&Qssl23, "ssl23");
4757 defsymbol(&Qssl3, "ssl3");
4758 defsymbol(&Qtls1, "tls1");
4760 DEFSUBR(Fossl_ssl_handshake);
4761 DEFSUBR(Fossl_ssl_inject_ca);
4762 DEFSUBR(Fossl_ssl_inject_cert);
4763 DEFSUBR(Fossl_ssl_proselytise_process);
4764 DEFSUBR(Fossl_ssl_unproselytise_process);
4765 DEFSUBR(Fossl_ssl_connect);
4766 DEFSUBR(Fossl_ssl_finish);
4767 DEFSUBR(Fossl_ssl_read);
4768 DEFSUBR(Fossl_ssl_write);
4769 DEFSUBR(Fossl_ssl_parent);
4770 DEFSUBR(Fossl_ssl_cert);
4771 DEFSUBR(Fossl_ssl_peer_cert);
4772 DEFSUBR(Fossl_ssl_peer_cert_chain);
4773 DEFSUBR(Fossl_ssl_verify_certificate);
4774 DEFSUBR(Fossl_ssl_cipher_version);
4775 DEFSUBR(Fossl_ssl_cipher_name);
4776 DEFSUBR(Fossl_ssl_cipher_names);
4777 DEFSUBR(Fossl_ssl_cipher_bits);
4778 DEFSUBR(Fossl_ssl_cipher_description);
4781 DEFSUBR(Fossl_x509_subject);
4782 DEFSUBR(Fossl_x509_issuer);
4783 DEFSUBR(Fossl_x509_serial);
4784 DEFSUBR(Fossl_x509_not_before);
4785 DEFSUBR(Fossl_x509_not_after);
4786 DEFSUBR(Fossl_x509_signature_type);
4789 void vars_of_openssl(void)
4793 #ifndef OPENSSL_NO_RSA
4794 Fprovide(intern("openssl-rsa"));
4796 #ifndef OPENSSL_NO_DSA
4797 Fprovide(intern("openssl-dsa"));
4799 #ifndef OPENSSL_NO_EC
4800 Fprovide(intern("openssl-ec"));
4802 #ifndef OPENSSL_NO_DH
4803 Fprovide(intern("openssl-dh"));
4806 Fprovide(intern("openssl-ssl"));