Coverity inspired security fixes from Nelson
[sxemacs] / src / openssl.c
1 /*
2   openssl.c -- Emacs Lisp binding to OpenSSL ciphers and digests
3   Copyright (C) 2005, 2006 Sebastian Freundt
4
5   Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
6
7 This file is part of SXEmacs
8
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.
13
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.
18
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/>. */
21
22
23 /* Copyright (C) 1995-1998 Eric Young (eay@cryptsoft.com)
24  * All rights reserved.
25  *
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.
29  * 
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).
36  * 
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.
43  * 
44  * Redistribution and use in source and binary forms, with or without
45  * modification, are permitted provided that the following conditions
46  * are met:
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)"
61  * 
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
72  * SUCH DAMAGE.
73  * 
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.]
78  */
79
80 /* General overview:
81  * openssl provides an assortment of cryptographic routines and interfaces
82  * to access them.
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.
87  *
88  *
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
100  * 
101  *  In addition, we are trying hard to provide not only an exact elisp
102  *  copy of openssl, but also a _comprehensive_ one
103  *
104  * 
105  * * src/openssl.c: functions overview:
106  *
107  * - General
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
113  *
114  * - RAND
115  *  ossl-rand-bytes - generation of (pseudo) randomness
116  *
117  * - MD
118  *  ossl-digest - gateway to digest functions
119  *
120  * - HMAC
121  *  ossl-hmac - gateway to message authentication codes
122  *
123  * - CIPHER
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
127  *
128  * - PKEY
129  * + General
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
134  * + RSA
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
138  * + DSA
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
142  * + EC
143  *  ossl-ec-generate-key - constructor of EC public keys
144  *  ossl-ec-pkey-p - discriminator of EC public keys
145  * + DH
146  *  ossl-dh-pkey-p - discriminator of DH public keys
147  *
148  * - HYBRID
149  *  ossl-seal - gateway to public key hybrid (envelope) encryption
150  *  ossl-open - gateway to public key hybrid (envelope) decryption
151  *
152  * - SIGN
153  *  ossl-sign - gateway to public key signature
154  *  ossl-verify - gateway to public key signature verification
155  *
156  * - PEM
157  *  ossl-pem-read-public-key
158  *  ossl-pem-read-key
159  *  ossl-pem-write-public-key
160  *  ossl-pem-write-key
161  *
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
166  *  ossl-read - 
167  *  ossl-write -
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
174  *
175  * 
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
180  *
181  *
182  * * Roadmap:
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
191  *     Goals:
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
196  *        world)
197  *
198  *
199  * * Bugs:
200  *  - any function using or needing random data assumes you have /dev/urandom
201  *
202  *
203  * * Examples:
204  *
205  *  - RAND:
206  *    (ossl-rand-bytes 8)
207  *    (base16-encode-string (ossl-rand-bytes 16))
208  *
209  *  - MD:
210  *    (ossl-available-digests)
211  *
212  *    (ossl-digest 'MD5 "test")
213  *    (base16-encode-string (ossl-digest 'MD5 "test"))
214  *    ;; compare to
215  *    (md5 "test")
216  *
217  *    (base64-encode-string (ossl-digest 'SHA1 "test"))
218  *
219  *    (base16-encode-string (ossl-digest 'RIPEMD160 "test"))
220  *
221  *  - HMAC:
222  *    (ossl-hmac 'md5 "testmess" "testpass")
223  *
224  *    (base16-encode-string (ossl-hmac 'dsa-sha1 "testmess" "testpass"))
225  *
226  *  - CIPHER:
227  *    ;; retrieve a list of available cipher algorithms first
228  *    (ossl-available-ciphers)
229  *
230  *    ;; generate a key/iv pair (iv = initialisation vector)
231  *    ;; from a password
232  *    (ossl-bytes-to-key 'AES-256-ECB 'RIPEMD160 nil "password" 1)
233  *
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))
239  *    ;; in contrast:
240  *    (ossl-decrypt 'BF-ECB enc (car key) (cdr key))
241  *      ;; this one yields an error since BF-CBC is not BF-ECB
242  *
243  *  - PKEY:
244  *  + General:
245  *    ;; SOMETHING HERE
246  *
247  *  + RSA:
248  *    ;; generate an rsa key of size 2048
249  *    (setq pkey (ossl-rsa-generate-key 2048 17))
250  *    (ossl-rsa-pkey-p pkey)
251  *
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)
258  *
259  *  + DSA:
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)
265  *
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)
273  *
274  *  + EC:
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))
283  *
284  *  + DH:
285  *  Note: For these functions you must have enabled DH in your OpenSSL lib
286  *    ;; not yet
287  *
288  *  - HYBRID 
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))
292  *    ;; behold also:
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
295  *    ;; but:
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!
299  *
300  *  - SIGN
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)
304  *    ;; and behold:
305  *    (ossl-verify 'DSA-SHA1 "this is not MY msg" sig key)
306  *
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)
311  *    ;; and behold:
312  *    (ossl-verify 'RSA-SHA1 "this is MY msg" sig2 key)
313  *
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)
317  *
318  *  - PEM
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)
323  *
324  *  - SSL
325  *    ;; no examples yet
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)
333  *    (ossl-finish m)
334  *
335  */
336
337 #include <config.h>
338
339 #include "lisp.h"
340
341 #include "buffer.h"
342 #include "sysdep.h"
343 #include "lrecord.h"
344 #include "lstream.h"
345 #include "opaque.h"
346
347 #ifdef HAVE_SOCKETS
348 #include "events/events.h"
349 #include "process.h"
350 #include "procimpl.h"
351 #endif
352
353 #include <errno.h>
354
355 #include "openssl.h"
356
357 #ifdef FILE_CODING
358 #include "mule/file-coding.h"
359 #endif
360
361 #ifdef HAVE_POSTGRESQL
362 #include "database/postgresql.h"
363 #endif
364
365 #define OSSL_CODING Qbinary
366
367 #define OSSL_STRING_LENGTH XSTRING_CHAR_LENGTH
368
369 static Lisp_Object Qopenssl;
370
371 #define __OSSL_DEBUG__(args...)         fprintf(stderr, "OSSL " args)
372 #ifndef OSSL_DEBUG_FLAG
373 #define OSSL_DEBUG(args...)
374 #else
375 #define OSSL_DEBUG(args...)             __OSSL_DEBUG__(args)
376 #endif
377 #define OSSL_DEBUG_CTX(args...)         OSSL_DEBUG("[connection]: " args)
378 #define OSSL_CRITICAL(args...)          __OSSL_DEBUG__("CRITICAL: " args)
379
380 \f
381 int ossl_pkey_has_public_data(EVP_PKEY *pkey);
382 int ossl_pkey_has_private_data(EVP_PKEY *pkey);
383
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);
388 #endif
389
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);
395 #endif
396
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);
403 #endif
404
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);
410 #endif
411
412 #ifdef OSSL_DEBUG_FLAG
413 static long ossl_bio_dump_callback(BIO*, int, const char*, int, long, long);
414 #endif
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);
422
423 Lisp_Object Qssl2, Qssl23, Qssl3, Qtls1;
424
425 extern Lisp_Object Qfile_readable_p;
426 extern Lisp_Object Qfile_writable_p;
427
428 /*
429  *
430  * AUXILIARY
431  * 
432  */
433 DEFUN("ossl-version", Fossl_version, 0, 0, 0, /*
434 Return a descriptive version number of the OpenSSL in use.
435 */
436       ())
437 {
438         return build_string(SSLeay_version(SSLEAY_VERSION));
439 }
440
441
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.
445 */
446       ())
447 {
448         int nid;
449         Lisp_Object digests;
450
451         digests = Qnil;
452
453         OpenSSL_add_all_digests();
454
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);
458                 if (digest) {
459                         digests = Fcons(intern(OBJ_nid2sn(nid)), digests);
460                 }
461         }
462
463         EVP_cleanup();
464
465         return digests;
466 }
467
468
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.
472 */
473       ())
474 {
475         int nid;
476         Lisp_Object ciphers;
477
478         OpenSSL_add_all_ciphers();
479
480         ciphers = Qnil;
481
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);
485                 if (cipher) {
486                         ciphers = Fcons(intern(OBJ_nid2sn(nid)), ciphers);
487                 }
488         }
489
490         EVP_cleanup();
491
492         return ciphers;
493 }
494
495
496 #define ossl_digest_fun(var, fun)                                       \
497 {                                                                       \
498         int __kl;                                                       \
499         const EVP_MD *__md;                                             \
500                                                                         \
501         OpenSSL_add_all_digests();                                      \
502                                                                         \
503         __md = EVP_get_digestbyname(                                    \
504                 (char *)string_data(XSYMBOL(var)->name));               \
505                                                                         \
506         if (!__md) {                                                    \
507                 EVP_cleanup();                                          \
508                 return -1;                                              \
509         }                                                               \
510                                                                         \
511         __kl = fun(__md);                                               \
512                                                                         \
513         EVP_cleanup();                                                  \
514                                                                         \
515         return __kl;                                                    \
516 } while (0);
517
518 static int
519 ossl_digest_size(Lisp_Object digest)
520 {
521         ossl_digest_fun(digest, EVP_MD_size);
522 }
523
524 static int
525 ossl_digest_block_size(Lisp_Object digest)
526 {
527         ossl_digest_fun(digest, EVP_MD_block_size);
528 }
529
530 DEFUN("ossl-digest-size", Fossl_digest_size, 1, 1, 0, /*
531 Return the hash length of DIGEST in bytes.
532 */
533       (digest))
534 {
535         int size = ossl_digest_size(digest);
536
537         if (size < 0)
538                 error ("no such cipher");
539
540         return make_int(size);
541 }
542
543 /* deprecated */
544 DEFUN("ossl-digest-bits", Fossl_digest_bits, 1, 1, 0, /*
545 Return the number of effective output bits of DIGEST.
546 */
547       (digest))
548 {
549         int size = ossl_digest_size(digest);
550
551         if (size < 0)
552                 error ("no such digest");
553
554         return make_int(size*8);
555 }
556
557 DEFUN("ossl-digest-block-size", Fossl_digest_block_size, 1, 1, 0, /*
558 Return the block size of DIGEST in bytes.
559 */
560       (digest))
561 {
562         int size = ossl_digest_block_size(digest);
563
564         if (size < 0)
565                 error ("no such digest");
566
567         return make_int(size);
568 }
569
570
571 #define ossl_cipher_fun(var, fun)                                       \
572 {                                                                       \
573         int __kl;                                                       \
574         const EVP_CIPHER *__ciph;                                       \
575                                                                         \
576         OpenSSL_add_all_ciphers();                                      \
577                                                                         \
578         __ciph = EVP_get_cipherbyname(                                  \
579                 (char *)string_data(XSYMBOL(var)->name));               \
580                                                                         \
581         if (!__ciph) {                                                  \
582                 EVP_cleanup();                                          \
583                 return -1;                                              \
584         }                                                               \
585                                                                         \
586         __kl = fun(__ciph);                                             \
587                                                                         \
588         EVP_cleanup();                                                  \
589                                                                         \
590         return __kl;                                                    \
591 } while (0);
592
593 static int
594 ossl_cipher_key_length(Lisp_Object cipher)
595 {
596         ossl_cipher_fun(cipher, EVP_CIPHER_key_length);
597 }
598
599 static int
600 ossl_cipher_iv_length(Lisp_Object cipher)
601 {
602         ossl_cipher_fun(cipher, EVP_CIPHER_iv_length);
603 }
604
605 static int
606 ossl_cipher_block_size(Lisp_Object cipher)
607 {
608         ossl_cipher_fun(cipher, EVP_CIPHER_block_size);
609 }
610
611 static int
612 ossl_cipher_mode(Lisp_Object cipher)
613 {
614         ossl_cipher_fun(cipher, EVP_CIPHER_mode);
615 }
616
617 DEFUN("ossl-cipher-key-length", Fossl_cipher_key_length, 1, 1, 0, /*
618 Return the effective key length of CIPHER in bytes.
619 */
620       (cipher))
621 {
622         int size = ossl_cipher_key_length(cipher);
623
624         if (size < 0)
625                 error ("no such cipher");
626
627         return make_int(size);
628 }
629
630 /* deprecated */
631 DEFUN("ossl-cipher-bits", Fossl_cipher_bits, 1, 1, 0, /*
632 Return the effective key size of CIPHER in bits.
633 */
634       (cipher))
635 {
636         int size = ossl_cipher_key_length(cipher);
637
638         if (size < 0)
639                 error ("no such cipher");
640
641         return make_int(size*8);
642 }
643
644 DEFUN("ossl-cipher-iv-length", Fossl_cipher_iv_length, 1, 1, 0, /*
645 Return the initialisation vector length of CIPHER in bytes.
646 */
647       (cipher))
648 {
649         int size = ossl_cipher_iv_length(cipher);
650
651         if (size < 0)
652                 error ("no such cipher");
653
654         return make_int(size);
655 }
656
657 DEFUN("ossl-cipher-block-size", Fossl_cipher_block_size, 1, 1, 0, /*
658 Return the block size of CIPHER in bytes.
659 */
660       (cipher))
661 {
662         int size = ossl_cipher_block_size(cipher);
663
664         if (size < 0)
665                 error ("no such cipher");
666
667         return make_int(size);
668 }
669
670 DEFUN("ossl-cipher-mode", Fossl_cipher_mode, 1, 1, 0, /*
671 Return the operation mode of CIPHER.
672 */
673       (cipher))
674 {
675         Lisp_Object result = Qnil;
676         int mode = ossl_cipher_mode(cipher);
677
678         if (mode < 0)
679                 error ("no such cipher");
680
681         switch (mode) {
682         case EVP_CIPH_STREAM_CIPHER:
683                 result = intern("stream");
684                 break;
685         case EVP_CIPH_ECB_MODE:
686                 result = intern("ecb");
687                 break;
688         case EVP_CIPH_CBC_MODE:
689                 result = intern("cbc");
690                 break;
691         case EVP_CIPH_CFB_MODE:
692                 result = intern("cfb");
693                 break;
694         case EVP_CIPH_OFB_MODE:
695                 result = intern("ofb");
696                 break;
697         default:
698                 result = intern("cbc");
699                 break;
700         }
701
702         return result;
703 }
704
705 \f
706 /*
707  * 
708  * RAND
709  * 
710  */
711 DEFUN("ossl-rand-bytes", Fossl_rand_bytes, 1, 1, 0, /*
712 Return COUNT bytes of randomness.
713
714 Note: You probably want to put a wrapping encoder function
715 \(like `base16-encode-string'\) around it, since this returns
716 binary string data.
717 */
718       (count))
719 {
720         char *outbuf;
721         Lisp_Object l_outbuf;
722         int count_ext;
723
724         int speccount = specpdl_depth(), res;
725
726         CHECK_NATNUM(count);
727         count_ext = (int)XINT(count);
728
729         /* now allocate some output buffer externally */
730         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, count_ext, char);
731
732         res = RAND_bytes((unsigned char*)outbuf, count_ext);
733         if (!res) {
734                 error("RAND_bytes did not have enough seed "
735                       "to perform operation");
736                 return Qnil;
737         } else if (res < 0) {
738                 error("RAND_bytes failed");
739                 return Qnil;
740         }
741
742         l_outbuf = make_ext_string(outbuf, count_ext, OSSL_CODING);
743         XMALLOC_UNBIND(outbuf, count_ext, speccount);
744
745         return l_outbuf;
746 }
747
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.
751
752 Note: You probably want to put a wrapping encoder function
753 \(like `base16-encode-string'\) around it, since this returns
754 binary string data.
755 */
756       (count, egd))
757 {
758         /* This function can GC */
759         char *outbuf;
760         Lisp_Object l_outbuf;
761         int count_ext;
762         int speccount = specpdl_depth(), res;
763         /* gc cruft */
764         struct gcpro gcpro1, gcpro2;
765
766         GCPRO2(count, egd);
767
768         CHECK_NATNUM(count);
769         if (!NILP(egd)) {
770                 CHECK_STRING(egd);
771                 egd = Fexpand_file_name(egd, Qnil);
772                 if (NILP(Ffile_exists_p(egd)))
773                         egd = Qnil;
774         }
775         count_ext = XINT(count);
776
777         /* now allocate some output buffer externally */
778         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, count_ext, char);
779
780         if (!NILP(egd)) {
781                 res = RAND_query_egd_bytes((char*)XSTRING_DATA(egd),
782                                            (unsigned char*)outbuf, count_ext);
783         } else {
784                 res = RAND_query_egd_bytes("/var/run/egd-pool",
785                                            (unsigned char*)outbuf, count_ext);
786         }
787         if (!res) {
788                 UNGCPRO;
789                 error("RAND_query_egd_bytes did not have enough seed "
790                       "to perform operation");
791                 return Qnil;
792         } else if (res < 0) {
793                 UNGCPRO;
794                 error("RAND_query_egd_bytes failed");
795                 return Qnil;
796         }
797
798         l_outbuf = make_ext_string(outbuf, count_ext, OSSL_CODING);
799         XMALLOC_UNBIND(outbuf, count_ext, speccount);
800
801         UNGCPRO;
802         return l_outbuf;
803 }
804
805 /*
806  *
807  * DIGEST HANDLING
808  *
809  */
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'.
814
815 Note: You probably want to put a wrapping encoder function
816 \(like `base16-encode-string'\) around it, since this returns
817 binary string data.
818 */
819       (digest, string))
820 {
821         EVP_MD_CTX *mdctx;
822         const EVP_MD *md;
823         char md_value[EVP_MAX_MD_SIZE];
824         unsigned int md_len;
825
826         CHECK_SYMBOL(digest);
827         CHECK_STRING(string);
828
829         OpenSSL_add_all_digests();
830         md = EVP_get_digestbyname(
831                 (char *)string_data(XSYMBOL(digest)->name));
832
833         if (!md) {
834                 EVP_cleanup();
835                 error ("no such digest");
836         }
837
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);
845
846         EVP_cleanup();
847         xfree(mdctx);
848
849         return make_ext_string(md_value, md_len, OSSL_CODING);
850 }
851
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'.
856
857 Note: You probably want to put a wrapping encoder function
858 \(like `base16-encode-string'\) around it, since this returns
859 binary string data.
860 */
861       (digest, file))
862 {
863         EVP_MD_CTX *mdctx;
864         const EVP_MD *md;
865         unsigned char md_value[EVP_MAX_MD_SIZE];
866         unsigned int md_len, md_blocksize;
867         ssize_t n;
868         /* input file */
869         FILE *fp;
870
871
872         CHECK_SYMBOL(digest);
873         CHECK_STRING(file);
874
875
876         file = Fexpand_file_name(file, Qnil);
877
878         if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
879             (fseek(fp, 0, SEEK_SET))) {
880                 if (fp)
881                         fclose(fp);
882                 return wrong_type_argument(Qfile_readable_p, file);
883         }
884
885         OpenSSL_add_all_digests();
886         md = EVP_get_digestbyname(
887                 (char *)string_data(XSYMBOL(digest)->name));
888
889         if (!md) {
890                 EVP_cleanup();
891                 fclose(fp);
892                 error ("no such digest");
893         }
894
895         mdctx = xnew(EVP_MD_CTX);
896         EVP_MD_CTX_init(mdctx);
897         md_blocksize = (unsigned int)(EVP_MD_block_size(md) / 8);
898
899         EVP_DigestInit_ex(mdctx, md, NULL);
900
901         /* we reuse md_value here for streaming over fp */
902         do {
903                 n = fread(md_value, 1, EVP_MAX_MD_SIZE, fp);
904                 if (n < 0) {
905                         EVP_cleanup();
906                         fclose(fp);
907                         xfree(mdctx);
908                         error("file corrupted");
909                         return Qnil;
910                 }
911                 EVP_DigestUpdate(mdctx, md_value, n);
912         } while (n > 0);
913
914         EVP_DigestFinal_ex(mdctx, md_value, &md_len);
915         EVP_MD_CTX_cleanup(mdctx);
916
917         EVP_cleanup();
918         xfree(mdctx);
919         fclose(fp);
920
921         return make_ext_string((char *)md_value, md_len, OSSL_CODING);
922 }
923
924
925 /* 
926  *
927  * HMAC (aka keyed hashes)
928  * 
929  */
930 DEFUN("ossl-hmac", Fossl_hmac, 3, 3, 0, /*
931 Return the message authentication code of MSG
932 using the hash function DIGEST and the key PASSWORD.
933
934 Note: You probably want to put a wrapping encoder function
935 \(like `base16-encode-string'\) around it, since this returns
936 binary string data.
937 */
938       (digest, msg, password))
939 {
940         const EVP_MD *md;
941         HMAC_CTX *hmacctx;
942
943         /* buffer for the ciphertext */
944         unsigned char outbuf[EVP_MAX_MD_SIZE];
945         unsigned int outlen;
946         /* buffer for external password */
947         char *password_ext;
948         unsigned int password_len;
949 #if 0   /* why? */
950         /* buffer for external message */
951         char *msg_ext;
952         unsigned int msg_len;
953 #endif
954
955         CHECK_SYMBOL(digest);
956         CHECK_STRING(msg);
957         CHECK_STRING(password);
958
959         OpenSSL_add_all_digests();
960         md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
961
962         if (!md) {
963                 EVP_cleanup();
964                 error ("no such digest");
965         }
966
967         TO_EXTERNAL_FORMAT (LISP_STRING, password,
968                             C_STRING_ALLOCA, password_ext, OSSL_CODING);
969         password_len = OSSL_STRING_LENGTH(password);
970
971 #if 0   /* i wonder why */
972         TO_EXTERNAL_FORMAT (LISP_STRING, msg,
973                             C_STRING_ALLOCA, msg_ext, OSSL_CODING);
974         msg_len = OSSL_STRING_LENGTH(msg);
975 #endif
976
977         hmacctx = xnew(HMAC_CTX);
978         HMAC_CTX_init(hmacctx);
979         HMAC_Init(hmacctx, password_ext, password_len, md);
980         HMAC_Update(hmacctx, (unsigned char*)XSTRING_DATA(msg),
981                     XSTRING_LENGTH(msg));
982         HMAC_Final(hmacctx, outbuf, &outlen);
983         HMAC_CTX_cleanup(hmacctx);
984         xfree(hmacctx);
985
986         EVP_cleanup();
987
988         return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
989 }
990
991 DEFUN("ossl-hmac-file", Fossl_hmac_file, 3, 3, 0, /*
992 Return the message authentication code of the contents of FILE
993 using the hash function DIGEST and the key PASSWORD.
994
995 Note: You probably want to put a wrapping encoder function
996 \(like `base16-encode-string'\) around it, since this returns
997 binary string data.
998 */
999       (digest, file, password))
1000 {
1001         const EVP_MD *md;
1002         HMAC_CTX *hmacctx;
1003
1004         /* buffer for the ciphertext */
1005         unsigned char outbuf[EVP_MAX_MD_SIZE];
1006         unsigned int outlen;
1007         ssize_t n;
1008         /* buffer for external password */
1009         char *password_ext;
1010         unsigned int password_len;
1011         /* input file */
1012         FILE *fp;
1013
1014         CHECK_SYMBOL(digest);
1015         CHECK_STRING(file);
1016         CHECK_STRING(password);
1017
1018         file = Fexpand_file_name(file, Qnil);
1019
1020         if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1021             (fseek(fp, 0, SEEK_SET))) {
1022                 if (fp)
1023                         fclose(fp);
1024                 return wrong_type_argument(Qfile_readable_p, file);
1025         }
1026
1027
1028         OpenSSL_add_all_digests();
1029         md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
1030
1031         if (!md) {
1032                 EVP_cleanup();
1033                 error ("no such digest");
1034         }
1035
1036         TO_EXTERNAL_FORMAT (LISP_STRING, password,
1037                             C_STRING_ALLOCA, password_ext, OSSL_CODING);
1038         password_len = OSSL_STRING_LENGTH(password);
1039
1040         hmacctx = xnew(HMAC_CTX);
1041         HMAC_CTX_init(hmacctx);
1042         HMAC_Init(hmacctx, password_ext, password_len, md);
1043
1044         /* we reuse md_value here for streaming over fp */
1045         do {
1046                 n = fread(outbuf, 1, EVP_MAX_MD_SIZE, fp);
1047                 if (n < 0) {
1048                         EVP_cleanup();
1049                         fclose(fp);
1050                         xfree(hmacctx);
1051                         error("file corrupted");
1052                         return Qnil;
1053                 }
1054                 HMAC_Update(hmacctx, outbuf, n);
1055         } while (n > 0);
1056
1057         HMAC_Final(hmacctx, outbuf, &outlen);
1058         HMAC_CTX_cleanup(hmacctx);
1059         xfree(hmacctx);
1060
1061         EVP_cleanup();
1062         fclose(fp);
1063
1064         return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1065 }
1066
1067
1068 /* 
1069  * 
1070  * SYMMETRIC CIPHER
1071  * 
1072  */
1073 DEFUN("ossl-bytes-to-key", Fossl_bytes_to_key, 5, 5, 0, /*
1074 Derive a key and initialisation vector (iv) suitable for a cipher.
1075 Return a string KEY being the key. The initialisation vector is
1076 put into KEY's property list as 'iv.
1077
1078 CIPHER \(a symbol\) is the cipher to derive the key and IV for.
1079 Valid ciphers can be obtained by `ossl-available-ciphers'.
1080
1081 DIGEST \(a symbol\) is the message digest to use.
1082 Valid digests can be obtained by `ossl-available-digests'.
1083
1084 SALT \(string or `nil'\) is used as a salt in the derivation.
1085 Use `nil' here to indicate that no salt is used.
1086
1087 PASSWORD is an arbitrary string which is processed to derive a
1088 unique key and IV.
1089
1090 COUNT \(a positive integer\) is the iteration count to use. This
1091 indicates how often the hash algorithm is called recursively.
1092
1093 Note: You probably want to put a wrapping encoder function 
1094 \(like `base16-encode-string'\) around it, since this returns
1095 binary string data.
1096 */
1097       (cipher, digest, salt, password, count))
1098 {
1099         const EVP_MD *md;
1100         const EVP_CIPHER *ciph;
1101         const char *salt_ext;
1102
1103         char *password_ext;
1104         unsigned int password_len;
1105
1106         char key[EVP_MAX_KEY_LENGTH];
1107         char iv[EVP_MAX_IV_LENGTH];
1108
1109         Lisp_Object result;
1110
1111         CHECK_STRING(password);
1112         CHECK_SYMBOL(cipher);
1113         CHECK_SYMBOL(digest);
1114         CHECK_NATNUM(count);
1115
1116
1117         if (!XINT(count))
1118                 error ("count has to be a non-zero positive integer");
1119
1120         OpenSSL_add_all_algorithms();
1121         md = EVP_get_digestbyname(
1122                 (char *)string_data(XSYMBOL(digest)->name));
1123         ciph = EVP_get_cipherbyname(
1124                 (char *)string_data(XSYMBOL(cipher)->name));
1125
1126         if (!ciph) {
1127                 EVP_cleanup();
1128                 error ("no such cipher");
1129         }
1130
1131         if (!md) {
1132                 EVP_cleanup();
1133                 error ("no such digest");
1134         }
1135
1136         if (NILP(salt)) {
1137                 salt_ext = NULL;
1138         } else {
1139                 CHECK_STRING(salt);
1140                 TO_EXTERNAL_FORMAT (LISP_STRING, salt,
1141                                     C_STRING_ALLOCA, salt_ext, OSSL_CODING);
1142                 salt_ext = NULL;
1143         }
1144
1145         TO_EXTERNAL_FORMAT (LISP_STRING, password,
1146                             C_STRING_ALLOCA, password_ext, OSSL_CODING);
1147         password_len = OSSL_STRING_LENGTH(password);
1148
1149         EVP_BytesToKey(ciph, md, (const unsigned char *)salt_ext,
1150                        (const unsigned char *)password_ext, password_len,
1151                        XINT(count),
1152                        (unsigned char *)key,
1153                        (unsigned char *)iv);
1154
1155         EVP_cleanup();
1156
1157         result = make_ext_string(key, EVP_CIPHER_key_length(ciph), OSSL_CODING);
1158         Fput(result, intern("iv"),
1159              make_ext_string(iv, EVP_CIPHER_iv_length(ciph), OSSL_CODING));
1160
1161         return result;
1162 }
1163
1164
1165 DEFUN("ossl-encrypt", Fossl_encrypt, 3, 4, 0,   /*
1166 Return the cipher of STRING computed by CIPHER under KEY.
1167
1168 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1169 you have compiled. See `ossl-available-ciphers'.
1170
1171 STRING is the text to be encrypted.
1172
1173 KEY should be a key generated suitably for this cipher, for example 
1174 by `ossl-bytes-to-key'.
1175
1176 Optional fourth argument IV should be an initialisation vector
1177 suitable for this cipher. Normally the initialisation vector from
1178 KEY's property list is used. However, if IV is
1179 non-nil, use this IV instead.
1180
1181 Note: You probably want to put a wrapping encoder function
1182 \(like `base16-encode-string'\) around it, since this returns
1183 binary string data.
1184 */
1185       (cipher, string, key, iv))
1186 {
1187         /* buffer for the external string */
1188         char *string_ext;
1189         unsigned int string_len;
1190         /* buffer for the ciphertext */
1191         char *outbuf;
1192         int outlen;
1193         Lisp_Object l_outbuf;
1194         /* buffer for key */
1195         char *key_ext;
1196         /* buffer for iv */
1197         char *iv_ext;
1198
1199         /* declarations for the cipher */
1200         const EVP_CIPHER *ciph;
1201         EVP_CIPHER_CTX *ciphctx;
1202
1203         int tmplen;
1204         int speccount = specpdl_depth();
1205         Charcount alloclen;
1206
1207         /* frob the IV from the plist of key maybe */
1208         if (NILP(iv))
1209                 iv = Fget(key, intern("iv"), Qnil);
1210
1211         CHECK_SYMBOL(cipher);
1212         CHECK_STRING(string);
1213         CHECK_STRING(key);
1214         CHECK_STRING(iv);
1215
1216         TO_EXTERNAL_FORMAT(LISP_STRING, string,
1217                            C_STRING_ALLOCA, string_ext, OSSL_CODING);
1218         string_len = OSSL_STRING_LENGTH(string);
1219
1220         if (string_len <= 0)
1221                 error ("string must be of non-zero positive length.");
1222
1223         OpenSSL_add_all_algorithms();
1224         /* ENGINE_load_builtin_engines(); */
1225         /* atm, no support for different engines */
1226         ciph = EVP_get_cipherbyname(
1227                 (char *)string_data(XSYMBOL(cipher)->name));
1228
1229         if (!ciph) {
1230                 EVP_cleanup();
1231                 error ("no such cipher");
1232         }
1233
1234         /* now allocate some output buffer externally
1235          * this one has to be at least EVP_CIPHER_block_size bigger
1236          * since block algorithms merely operate blockwise
1237          */
1238         alloclen = XSTRING_LENGTH(string) + EVP_CIPHER_block_size(ciph);
1239         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1240
1241         TO_EXTERNAL_FORMAT(LISP_STRING, key,
1242                             C_STRING_ALLOCA, key_ext, OSSL_CODING);
1243         TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1244                            C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1245
1246         ciphctx = xnew(EVP_CIPHER_CTX);
1247         EVP_CIPHER_CTX_init(ciphctx);
1248         if (!EVP_EncryptInit(ciphctx, ciph,
1249                              (unsigned char *)key_ext,
1250                              (unsigned char *)iv_ext)) {
1251                 EVP_cleanup();
1252                 xfree(ciphctx);
1253                 error ("error in EncryptInit");
1254         }
1255         if (!EVP_EncryptUpdate(ciphctx,
1256                                (unsigned char *)outbuf, &outlen,
1257                                (unsigned char *)string_ext, string_len)) {
1258                 EVP_cleanup();
1259                 xfree(ciphctx);
1260                 error ("error in EncryptUpdate");
1261         }
1262         /* Buffer passed to EVP_EncryptFinal() must be after data just
1263          * encrypted to avoid overwriting it.
1264          */
1265         if (!EVP_EncryptFinal(ciphctx,
1266                               (unsigned char *)outbuf+outlen, &tmplen)) {
1267                 EVP_cleanup();
1268                 xfree(ciphctx);
1269                 error ("error in EncryptFinal");
1270         }
1271         /* added probable padding space to the length of the output buffer */
1272         outlen += tmplen;
1273         EVP_CIPHER_CTX_cleanup(ciphctx);
1274
1275         l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1276         XMALLOC_UNBIND(outbuf, alloclen, speccount);
1277
1278         EVP_cleanup();
1279         xfree(ciphctx);
1280
1281         return l_outbuf;
1282 }
1283
1284 DEFUN("ossl-encrypt-file", Fossl_encrypt_file, 3, 5, 0, /*
1285 Return the encrypted contents of FILE computed by CIPHER under KEY.
1286
1287 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1288 you have compiled. See `ossl-available-ciphers'.
1289
1290 FILE is the file to be encrypted.
1291
1292 Third argument KEY should be a key generated suitably for this
1293 cipher, for example by `ossl-bytes-to-key'.
1294
1295 Optional fourth argument IV should be an initialisation vector
1296 suitable for this cipher. Normally the initialisation vector from
1297 KEY's property list is used. However, if IV is
1298 non-nil, use this IV instead.
1299
1300 Optional fifth argument OUTFILE may specify a file to have the
1301 encrypted data redirected.
1302
1303 Note: You probably want to put a wrapping encoder function
1304 \(like `base16-encode-string'\) around it, since this returns
1305 binary string data.
1306 */
1307       (cipher, file, key, iv, outfile))
1308 {
1309         /* buffer for the external string */
1310         unsigned char string_in[1024];
1311         ssize_t string_len;
1312         unsigned int block_len;
1313         unsigned long file_size;
1314         /* buffer for the ciphertext */
1315         unsigned char *outbuf;
1316         unsigned char *obp;
1317         int outlen;
1318         Lisp_Object l_outbuf;
1319         /* buffer for key */
1320         char *key_ext;
1321         /* buffer for iv */
1322         char *iv_ext;
1323
1324         /* input file */
1325         FILE *fp;
1326         /* output file */
1327         FILE *of;
1328
1329         /* declarations for the cipher */
1330         const EVP_CIPHER *ciph;
1331         EVP_CIPHER_CTX *ciphctx;
1332
1333         int tmplen;
1334         int speccount = specpdl_depth();
1335         Charcount alloclen;
1336
1337         /* frob the IV from the plist of key maybe */
1338         if (NILP(iv))
1339                 iv = Fget(key, intern("iv"), Qnil);
1340
1341         CHECK_SYMBOL(cipher);
1342         CHECK_STRING(file);
1343         CHECK_STRING(key);
1344         CHECK_STRING(iv);
1345
1346         if (!NILP(outfile)) {
1347                 CHECK_STRING(outfile);
1348                 outfile = Fexpand_file_name(outfile, Qnil);
1349                 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1350                         return wrong_type_argument(Qfile_writable_p, outfile);
1351         } else {
1352                 of = NULL;
1353         }
1354
1355         file = Fexpand_file_name(file, Qnil);
1356         if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1357             (fseek(fp, 0, SEEK_SET))) {
1358                 if (fp)
1359                         fclose(fp);
1360                 if (of)
1361                         fclose(of);
1362                 return wrong_type_argument(Qfile_readable_p, file);
1363         }
1364
1365         fseek(fp, 0, SEEK_END);
1366         file_size = ftell(fp); 
1367         fseek(fp, 0, SEEK_SET);
1368
1369
1370         OpenSSL_add_all_algorithms();
1371         /* ENGINE_load_builtin_engines(); */
1372         /* atm, no support for different engines */
1373         ciph = EVP_get_cipherbyname(
1374                 (char *)string_data(XSYMBOL(cipher)->name));
1375
1376         if (!ciph) {
1377                 EVP_cleanup();
1378                 fclose(fp);
1379                 if (of)
1380                         fclose(of);
1381                 error ("no such cipher");
1382         }
1383
1384         /* now allocate some output buffer externally
1385          * this one has to be at least EVP_CIPHER_block_size bigger
1386          * since block algorithms merely operate blockwise
1387          */
1388         block_len = EVP_CIPHER_block_size(ciph);
1389         if (UNLIKELY(of != NULL)) {
1390                 alloclen = 2048;
1391         } else {
1392                 alloclen = file_size + block_len;
1393         }
1394         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1395
1396         TO_EXTERNAL_FORMAT(LISP_STRING, key,
1397                            C_STRING_ALLOCA, key_ext, OSSL_CODING);
1398         TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1399                            C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1400
1401         ciphctx = xnew(EVP_CIPHER_CTX);
1402         EVP_CIPHER_CTX_init(ciphctx);
1403         if (!EVP_EncryptInit(ciphctx, ciph,
1404                              (unsigned char *)key_ext,
1405                              (unsigned char *)iv_ext)) {
1406                 EVP_cleanup();
1407                 fclose(fp);
1408                 if (of)
1409                         fclose(of);
1410                 xfree(ciphctx);
1411                 error("error in EncryptInit");
1412         }
1413
1414         obp = outbuf;
1415         outlen = 0;
1416         do {
1417                 string_len = fread(string_in, 1, 1024, fp);
1418                 if (string_len < 0) {
1419                         EVP_cleanup();
1420                         fclose(fp);
1421                         if (of)
1422                                 fclose(of);
1423                         xfree(ciphctx);
1424                         error("file corrupted");
1425                         return Qnil;
1426                 }
1427
1428                 tmplen = 0;
1429                 if (string_len > 0 &&
1430                     !EVP_EncryptUpdate(ciphctx,
1431                                        obp, &tmplen,
1432                                        string_in, string_len)) {
1433                         EVP_cleanup();
1434                         fclose(fp);
1435                         if (of)
1436                                 fclose(of);
1437                         xfree(ciphctx);
1438                         error("error in EncryptUpdate");
1439                 }
1440
1441                 if (of)
1442                         fwrite(obp, 1, tmplen, of);
1443                 else
1444                         obp += tmplen;
1445
1446                 outlen += tmplen;
1447         } while (string_len > 0);
1448
1449         /* Buffer passed to EVP_EncryptFinal() must be after data just
1450          * encrypted to avoid overwriting it.
1451          */
1452         if (!EVP_EncryptFinal(ciphctx, obp, &tmplen)) {
1453                 EVP_cleanup();
1454                 fclose(fp);
1455                 if (of)
1456                         fclose(of);
1457                 xfree(ciphctx);
1458                 error("error in EncryptFinal");
1459         }
1460
1461         if (of)
1462                 fwrite(obp, 1, tmplen, of);
1463
1464         /* added probable padding space to the length of the output buffer */
1465         outlen += tmplen;
1466         EVP_CIPHER_CTX_cleanup(ciphctx);
1467
1468         if (UNLIKELY(of != NULL)) {
1469                 l_outbuf = outfile;
1470         } else {
1471                 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1472         }
1473         XMALLOC_UNBIND(outbuf, alloclen, speccount);
1474
1475         EVP_cleanup();
1476         xfree(ciphctx);
1477         fclose(fp);
1478         if (of)
1479                 fclose(of);
1480
1481         return l_outbuf;
1482 }
1483 /* testcase:
1484  (setq k (ossl-bytes-to-key 'AES-256-OFB 'SHA1 nil "password" 1))
1485  (ossl-encrypt-file 'AES-256-OFB "~/.gnus" k nil "/tmp/gnus-enc")
1486  (ossl-decrypt-file 'AES-256-OFB "/tmp/gnus-enc" k nil "/tmp/gnus-dec")
1487 */
1488
1489
1490 DEFUN("ossl-decrypt", Fossl_decrypt, 3, 4, 0,   /*
1491 Return the deciphered version of STRING computed by CIPHER under KEY.
1492
1493 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1494 you have compiled. See `ossl-available-ciphers'.
1495
1496 STRING is the text to be decrypted.
1497
1498 KEY should be a key generated suitably for this
1499 cipher, for example by `ossl-bytes-to-key'.
1500
1501 Optional fourth argument IV should be an initialisation vector
1502 suitable for this cipher. Normally the initialisation vector from
1503 KEY's property list is used. However, if IV is
1504 non-nil, use this IV instead.
1505 */
1506       (cipher, string, key, iv))
1507 {
1508         /* buffer for the external string */
1509         char *string_ext;
1510         unsigned int string_len;
1511         /* buffer for the deciphered text */
1512         char *outbuf;
1513         int outlen;
1514         Lisp_Object l_outbuf;
1515         /* buffer for key */
1516         char *key_ext;
1517         /* buffer for iv */
1518         char *iv_ext;
1519
1520         /* declarations for the decipher */
1521         const EVP_CIPHER *ciph;
1522         EVP_CIPHER_CTX *ciphctx;
1523
1524         int tmplen;
1525         int speccount = specpdl_depth();
1526         Charcount alloclen;
1527
1528         /* frob the IV from the plist of key maybe */
1529         if (NILP(iv))
1530                 iv = Fget(key, intern("iv"), Qnil);
1531
1532         CHECK_SYMBOL(cipher);
1533         CHECK_STRING(string);
1534         CHECK_STRING(key);
1535         CHECK_STRING(iv);
1536
1537         TO_EXTERNAL_FORMAT(LISP_STRING, string,
1538                            C_STRING_ALLOCA, string_ext, OSSL_CODING);
1539         string_len = OSSL_STRING_LENGTH(string);
1540
1541         if (!string_len) 
1542                 error ("string must be of non-zero positive length.");
1543
1544         OpenSSL_add_all_algorithms();
1545         /* ENGINE_load_builtin_engines(); */
1546         /* atm, no support for different engines */
1547         ciph = EVP_get_cipherbyname(
1548                 (char *)string_data(XSYMBOL(cipher)->name));
1549
1550         if (!ciph) {
1551                 EVP_cleanup();
1552                 error ("no such cipher");
1553         }
1554
1555         /* now allocate some output buffer externally */
1556         alloclen = XSTRING_LENGTH(string);
1557         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1558
1559         TO_EXTERNAL_FORMAT (LISP_STRING, key,
1560                             C_STRING_ALLOCA, key_ext, OSSL_CODING);
1561         TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1562                             C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1563
1564         ciphctx = xnew(EVP_CIPHER_CTX);
1565         EVP_CIPHER_CTX_init(ciphctx);
1566         if (!EVP_DecryptInit(ciphctx, ciph,
1567                              (unsigned char *)key_ext,
1568                              (unsigned char *)iv_ext)) {
1569                 EVP_cleanup();
1570                 xfree(ciphctx);
1571                 error ("error in DecryptInit");
1572         }
1573         if (!EVP_DecryptUpdate(ciphctx,
1574                                (unsigned char *)outbuf, &outlen,
1575                                (unsigned char *)string_ext,string_len)) {
1576                 EVP_cleanup();
1577                 xfree(ciphctx);
1578                 error ("error in DecryptUpdate");
1579         }
1580         /* Buffer passed to EVP_EncryptFinal() must be after data just
1581          * encrypted to avoid overwriting it.
1582          */
1583         if (!EVP_DecryptFinal(ciphctx,
1584                               (unsigned char *)outbuf+outlen, &tmplen)) {
1585                 EVP_cleanup();
1586                 xfree(ciphctx);
1587                 error ("error in DecryptFinal");
1588         }
1589         /* added probable padding space to the length of the output buffer */
1590         outlen += tmplen;
1591         EVP_CIPHER_CTX_cleanup(ciphctx);
1592
1593         l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1594         XMALLOC_UNBIND(outbuf, alloclen, speccount);
1595
1596         EVP_cleanup();
1597         xfree(ciphctx);
1598
1599         return l_outbuf;
1600 }
1601
1602 DEFUN("ossl-decrypt-file", Fossl_decrypt_file, 3, 5, 0, /*
1603 Return the deciphered version of FILE computed by CIPHER under KEY.
1604
1605 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1606 you have compiled. See `ossl-available-ciphers'.
1607
1608 FILE is the file to be decrypted.
1609
1610 Third argument KEY should be a key generated suitably for this
1611 cipher, for example by `ossl-bytes-to-key'.
1612
1613 Optional fourth argument IV should be an initialisation vector
1614 suitable for this cipher. Normally the initialisation vector from
1615 KEY's property list is used. However, if IV is
1616 non-nil, use this IV instead.
1617
1618 Optional fifth argument OUTFILE may specify a file to have the
1619 encrypted data redirected.
1620 */
1621       (cipher, file, key, iv, outfile))
1622 {
1623         /* buffer for the external string */
1624         unsigned char string_in[1024];
1625         ssize_t string_len;
1626         unsigned int block_len;
1627         unsigned long file_size;
1628         /* buffer for the deciphered text */
1629         unsigned char *outbuf;
1630         unsigned char *obp;
1631         int outlen;
1632         Lisp_Object l_outbuf;
1633         /* buffer for key */
1634         char *key_ext;
1635         /* buffer for iv */
1636         char *iv_ext;
1637
1638         /* input file */
1639         FILE *fp;
1640         /* output file */
1641         FILE *of;
1642
1643         /* declarations for the decipher */
1644         const EVP_CIPHER *ciph;
1645         EVP_CIPHER_CTX *ciphctx;
1646
1647         int tmplen;
1648         int speccount = specpdl_depth();
1649         Charcount alloclen;
1650
1651         /* frob the IV from the plist of key maybe */
1652         if (NILP(iv))
1653                 iv = Fget(key, intern("iv"), Qnil);
1654
1655         CHECK_SYMBOL(cipher);
1656         CHECK_STRING(file);
1657         CHECK_STRING(key);
1658         CHECK_STRING(iv);
1659
1660         if (!NILP(outfile)) {
1661                 CHECK_STRING(outfile);
1662                 outfile = Fexpand_file_name(outfile, Qnil);
1663                 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1664                         return wrong_type_argument(Qfile_writable_p, outfile);
1665         } else {
1666                 of = NULL;
1667         }
1668
1669         file = Fexpand_file_name(file, Qnil);
1670         if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1671             (fseek(fp, 0, SEEK_SET))) {
1672                 if (fp)
1673                         fclose(fp);
1674                 if (of)
1675                         fclose(of);
1676                 return wrong_type_argument(Qfile_readable_p, file);
1677         }
1678
1679         fseek(fp, 0, SEEK_END);
1680         file_size = ftell(fp); 
1681         fseek(fp, 0, SEEK_SET);
1682
1683
1684         OpenSSL_add_all_algorithms();
1685         /* ENGINE_load_builtin_engines(); */
1686         /* atm, no support for different engines */
1687         ciph = EVP_get_cipherbyname(
1688                 (char *)string_data(XSYMBOL(cipher)->name));
1689
1690         if (!ciph) {
1691                 EVP_cleanup();
1692                 fclose(fp);
1693                 if (of)
1694                         fclose(of);
1695                 error ("no such cipher");
1696         }
1697
1698         /* now allocate some output buffer externally */
1699         block_len = EVP_CIPHER_block_size(ciph);
1700         if (UNLIKELY(of != NULL)) {
1701                 alloclen = 2048;
1702         } else {
1703                 alloclen = file_size + block_len;
1704         }
1705         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1706
1707         TO_EXTERNAL_FORMAT (LISP_STRING, key,
1708                             C_STRING_ALLOCA, key_ext, OSSL_CODING);
1709         TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1710                             C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1711
1712         ciphctx = xnew(EVP_CIPHER_CTX);
1713         EVP_CIPHER_CTX_init(ciphctx);
1714         if (!EVP_DecryptInit(ciphctx, ciph,
1715                              (unsigned char *)key_ext,
1716                              (unsigned char *)iv_ext)) {
1717                 EVP_cleanup();
1718                 fclose(fp);
1719                 if (of)
1720                         fclose(of);
1721                 xfree(ciphctx);
1722                 error ("error in DecryptInit");
1723         }
1724
1725         obp = outbuf;
1726         outlen = 0;
1727         do {
1728                 string_len = fread(string_in, 1, 1024, fp);
1729                 if (string_len < 0) {
1730                         EVP_cleanup();
1731                         fclose(fp);
1732                         if (of)
1733                                 fclose(of);
1734                         xfree(ciphctx);
1735                         error("file corrupted");
1736                         return Qnil;
1737                 }
1738
1739                 tmplen = 0;
1740                 if (string_len > 0 &&
1741                     !EVP_DecryptUpdate(ciphctx,
1742                                        obp, &tmplen,
1743                                        string_in, string_len)) {
1744                         EVP_cleanup();
1745                         fclose(fp);
1746                         if (of)
1747                                 fclose(of);
1748                         xfree(ciphctx);
1749                         error ("error in DecryptUpdate");
1750                 }
1751
1752                 if (of)
1753                         fwrite(obp, 1, tmplen, of);
1754                 else
1755                         obp += tmplen;
1756
1757                 outlen += tmplen;
1758         } while (string_len > 0);
1759
1760         /* Buffer passed to EVP_EncryptFinal() must be after data just
1761          * encrypted to avoid overwriting it.
1762          */
1763         if (!EVP_DecryptFinal(ciphctx, obp, &tmplen)) {
1764                 EVP_cleanup();
1765                 fclose(fp);
1766                 if (of)
1767                         fclose(of);
1768                 xfree(ciphctx);
1769                 error ("error in DecryptFinal");
1770         }
1771
1772         if (of)
1773                 fwrite(obp, 1, tmplen, of);
1774
1775         /* added probable padding space to the length of the output buffer */
1776         outlen += tmplen;
1777         EVP_CIPHER_CTX_cleanup(ciphctx);
1778
1779         if (UNLIKELY(of != NULL)) {
1780                 l_outbuf = outfile;
1781         } else {
1782                 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1783         }
1784         XMALLOC_UNBIND(outbuf, alloclen, speccount);
1785
1786         EVP_cleanup();
1787         xfree(ciphctx);
1788         fclose(fp);
1789         if (of)
1790                 fclose(of);
1791
1792         return l_outbuf;
1793 }
1794
1795
1796 /* 
1797  * 
1798  * ASYMMETRIC CIPHER
1799  * 
1800  */
1801 /* This is an opaque object for storing PKEYs in lisp */
1802 Lisp_Object Qevp_pkeyp;
1803
1804 static Lisp_Object
1805 mark_evp_pkey(Lisp_Object obj)
1806 {
1807         /* avoid some warning */
1808         if (obj);
1809         return Qnil;
1810 }
1811
1812 static void
1813 print_evp_pkey(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1814 {
1815         EVP_PKEY *pkey;
1816         X509 *x509;
1817
1818         pkey = XEVPPKEY(obj)->evp_pkey;
1819         x509 = XEVPPKEY(obj)->x509;
1820
1821         write_c_string("#<OpenSSL", printcharfun);
1822
1823         if (x509) {
1824                 X509_NAME *iss = X509_get_issuer_name(x509);
1825                 X509_NAME *sub = X509_get_subject_name(x509);
1826                 write_c_string(" X509 Certificate", printcharfun); 
1827                 write_c_string(" iss:", printcharfun);
1828                 write_c_string(X509_NAME_oneline(sub, NULL, 0), printcharfun);
1829                 write_c_string(" sub:", printcharfun);
1830                 write_c_string(X509_NAME_oneline(iss, NULL, 0), printcharfun);
1831         }
1832
1833         if (pkey) {
1834                 if (x509)
1835                         write_c_string(";", printcharfun);
1836
1837                 if (rsa_pkey_p(pkey))
1838                         write_c_string(" RSA", printcharfun); 
1839                 else if (dsa_pkey_p(pkey))
1840                         write_c_string(" DSA", printcharfun); 
1841                 else if (ec_pkey_p(pkey))
1842                         write_c_string(" EC", printcharfun); 
1843
1844                 if (ossl_pkey_has_private_data(pkey))
1845                         write_c_string(" private/public key", printcharfun); 
1846                 else if (ossl_pkey_has_public_data(pkey))
1847                         write_c_string(" public key", printcharfun); 
1848                 else
1849                         write_c_string(" empty key", printcharfun); 
1850
1851                 if (EVP_PKEY_size(pkey) > 0) {
1852                         write_fmt_str(printcharfun, ", size %d", EVP_PKEY_size(pkey)*8);
1853                 }
1854         }
1855
1856         write_c_string(">", printcharfun); 
1857
1858         /* avoid some warning */
1859         if (escapeflag);
1860 }
1861
1862 static Lisp_EVP_PKEY *
1863 allocate_evp_pkey(void)
1864 {
1865         Lisp_EVP_PKEY *evp_pkey =
1866                 alloc_lcrecord_type(Lisp_EVP_PKEY, &lrecord_evp_pkey);
1867         evp_pkey->evp_pkey = NULL;
1868         evp_pkey->x509 = NULL;
1869         return evp_pkey;
1870 }
1871
1872 static void
1873 finalise_evp_pkey(void *header, int for_disksave)
1874 {
1875         Lisp_EVP_PKEY *evp_pkey = (Lisp_EVP_PKEY *) header;
1876
1877         if (evp_pkey->evp_pkey) {
1878                 EVP_PKEY_free(evp_pkey->evp_pkey);
1879                 evp_pkey->evp_pkey = NULL;
1880         }
1881         if (evp_pkey->x509) {
1882                 X509_free(evp_pkey->x509);
1883                 evp_pkey->x509 = NULL;
1884         }
1885
1886         /* avoid some warning */
1887         if (for_disksave);
1888 }
1889
1890 DEFINE_LRECORD_IMPLEMENTATION("evp_pkey", evp_pkey,
1891                               mark_evp_pkey, print_evp_pkey,
1892                               finalise_evp_pkey,
1893                               NULL, NULL, 0,
1894                               Lisp_EVP_PKEY);
1895
1896 static Lisp_Object
1897 make_evp_pkey(EVP_PKEY *pkey, X509 *x509)
1898 {
1899         Lisp_EVP_PKEY *lisp_pkey = allocate_evp_pkey();
1900
1901         lisp_pkey->evp_pkey = pkey;
1902         lisp_pkey->x509 = x509;
1903
1904         return wrap_evppkey(lisp_pkey);
1905 }
1906
1907 static Lisp_Object
1908 make_evp_pkey_pk(EVP_PKEY *pkey)
1909 {
1910         return make_evp_pkey(pkey, NULL);
1911 }
1912
1913 static Lisp_Object
1914 make_evp_pkey_x509(X509 *x509)
1915 {
1916         return make_evp_pkey(X509_get_pubkey(x509), x509);
1917 }
1918
1919 DEFUN("ossl-pkey-p", Fossl_pkey_p, 1, 1, 0, /*
1920 Return t iff OBJECT is a pkey, nil otherwise.
1921 */
1922       (object))
1923 {
1924         if (EVPPKEYP(object))
1925                 return Qt;
1926         else
1927                 return Qnil;
1928 }
1929
1930 DEFUN("ossl-pkey-size", Fossl_pkey_size, 1, 1, 0, /*
1931 Return the size a public key PKEY in bits. 
1932 */
1933       (pkey))
1934 {
1935         EVP_PKEY *pk;
1936
1937         CHECK_EVPPKEY(pkey);
1938
1939         pk = (XEVPPKEY(pkey))->evp_pkey;
1940
1941         return make_int(EVP_PKEY_size(pk)*8);
1942 }
1943
1944 int
1945 ossl_pkey_has_public_data(EVP_PKEY *pkey)
1946 {
1947         if (rsa_pkey_p(pkey)) {
1948 #ifndef OPENSSL_NO_RSA
1949                 return rsa_pkey_has_public_data((pkey->pkey).rsa);
1950 #else
1951                 return 0;
1952 #endif
1953         } else if (dsa_pkey_p(pkey)) {
1954 #ifndef OPENSSL_NO_DSA
1955                 return dsa_pkey_has_public_data((pkey->pkey).dsa);
1956 #else
1957                 return 0;
1958 #endif
1959         } else if (ec_pkey_p(pkey)) {
1960 #ifndef OPENSSL_NO_EC
1961                 return ec_pkey_has_public_data((pkey->pkey).ec);
1962 #else
1963                 return 0;
1964 #endif
1965         } else if (dh_pkey_p(pkey)) {
1966 #ifndef OPENSSL_NO_DH
1967                 return dh_pkey_has_public_data((pkey->pkey).dh);
1968 #else
1969                 return 0;
1970 #endif
1971         } else
1972                 return 0;
1973 }
1974 int
1975 ossl_pkey_has_private_data(EVP_PKEY *pkey)
1976 {
1977         if (rsa_pkey_p(pkey)) {
1978 #ifndef OPENSSL_NO_RSA
1979                 return rsa_pkey_has_private_data((pkey->pkey).rsa);
1980 #else
1981                 return 0;
1982 #endif
1983         } else if (dsa_pkey_p(pkey)) {
1984 #ifndef OPENSSL_NO_DSA
1985                 return dsa_pkey_has_private_data((pkey->pkey).dsa);
1986 #else
1987                 return 0;
1988 #endif
1989         } else if (ec_pkey_p(pkey)) {
1990 #ifndef OPENSSL_NO_EC
1991                 return ec_pkey_has_private_data((pkey->pkey).ec);
1992 #else
1993                 return 0;
1994 #endif
1995         } else if (dh_pkey_p(pkey)) {
1996 #ifndef OPENSSL_NO_DH
1997                 return dh_pkey_has_private_data((pkey->pkey).dh);
1998 #else
1999                 return 0;
2000 #endif
2001         } else
2002                 return 0;
2003 }
2004
2005 DEFUN("ossl-pkey-private-p", Fossl_pkey_private_p, 1, 1, 0, /*
2006 Return non-nil if PKEY contains private data.
2007
2008 This function is not native OpenSSL.
2009 */
2010       (pkey))
2011 {
2012         EVP_PKEY *pk;
2013
2014         if (!(EVPPKEYP(pkey)))
2015                 return Qnil;
2016
2017         pk = (XEVPPKEY(pkey))->evp_pkey;
2018
2019         if (ossl_pkey_has_private_data(pk))
2020                 return Qt;
2021
2022         return Qnil;
2023 }
2024
2025 DEFUN("ossl-pkey-get-public", Fossl_pkey_get_public, 1, 1, 0, /*
2026 Return a copy of PKEY stripped by the private data.
2027
2028 This function is not native OpenSSL.
2029 */
2030       (pkey))
2031 {
2032         EVP_PKEY *pk;
2033         EVP_PKEY *pkout;
2034
2035         CHECK_EVPPKEY(pkey);
2036
2037         pk = (XEVPPKEY(pkey))->evp_pkey;
2038         if (!(ossl_pkey_has_public_data(pk)))
2039                 error ("key must have public data");
2040
2041         pkout = EVP_PKEY_new();
2042         if (rsa_pkey_p(pk)) {
2043 #ifndef OPENSSL_NO_RSA
2044                 EVP_PKEY_assign_RSA(pkout, RSAPublicKey_dup((pk->pkey).rsa));
2045 #endif
2046         } else if (dsa_pkey_p(pk)) {
2047 #ifndef OPENSSL_NO_DSA
2048                 EVP_PKEY_assign_DSA(pkout, dsa_get_public(pk));
2049 #endif
2050         } else if (ec_pkey_p(pk)) {
2051 #ifndef OPENSSL_NO_EC
2052                 EVP_PKEY_assign_EC_KEY(pkout, ec_get_public(pk));
2053 #endif
2054         } else
2055                 error ("no method to strip private data yet");
2056
2057         return make_evp_pkey_pk(pkout);
2058 }
2059
2060 /* RSA */
2061 int
2062 rsa_pkey_p(EVP_PKEY *pkey)
2063 {
2064         int type;
2065
2066         type = EVP_PKEY_type(pkey->type);
2067
2068 #ifndef OPENSSL_NO_RSA
2069         return ((type == EVP_PKEY_RSA) ||
2070                 (type == EVP_PKEY_RSA2));
2071 #else
2072         return 0;
2073 #endif
2074 }
2075 #ifndef OPENSSL_NO_RSA
2076 int
2077 rsa_pkey_has_public_data(RSA *rsakey)
2078 {
2079         return (!(rsakey->n == NULL) &&
2080                 !(rsakey->e == NULL));
2081 }
2082 int
2083 rsa_pkey_has_private_data(RSA *rsakey)
2084 {
2085         return (rsa_pkey_has_public_data(rsakey) &&
2086                 !(rsakey->d == NULL));
2087 }
2088
2089 DEFUN("ossl-rsa-generate-key", Fossl_rsa_generate_key, 2, 2, 0, /*
2090 Return an RSA public key with of length BITS and exponent EXPO.
2091 */
2092       (bits, expo))
2093 {
2094         EVP_PKEY *pkey;
2095         RSA *rsakey;
2096
2097         CHECK_NATNUM(bits);
2098         CHECK_NATNUM(expo);
2099
2100
2101         if (!XINT(bits))
2102                 error ("modulus size must be a non-zero positive integer");
2103         if (!(XINT(expo) % 2))
2104                 error ("exponent must be an odd positive integer");
2105
2106         pkey = EVP_PKEY_new();
2107         rsakey = RSA_generate_key(XINT(bits), XINT(expo), NULL, NULL);
2108         EVP_PKEY_assign_RSA(pkey, rsakey);
2109
2110         return make_evp_pkey_pk(pkey);
2111 }
2112
2113 DEFUN("ossl-rsa-pkey-p", Fossl_rsa_pkey_p, 1, 1, 0, /*
2114 Return t iff PKEY is of RSA type.
2115 */
2116       (pkey))
2117 {
2118         EVP_PKEY *pk;
2119
2120         if (!EVPPKEYP(pkey))
2121                 return Qnil;
2122
2123         pk = (XEVPPKEY(pkey))->evp_pkey;
2124
2125         if (rsa_pkey_p(pk))
2126                 return Qt;
2127         else
2128                 return Qnil;
2129 }
2130
2131 DEFUN("ossl-rsa-subkey-p", Fossl_rsa_subkey_p, 2, 2, 0, /*
2132 Return t iff PKEY1 is a subkey of PKEY2.
2133 I.e. if PKEY1 has the same public key data as PKEY2 and
2134 PKEY2 has all private data.
2135
2136 This function is not native OpenSSL.
2137 */
2138       (pkey1, pkey2))
2139 {
2140         EVP_PKEY *pk1;
2141         EVP_PKEY *pk2;
2142         RSA *rk1;
2143         RSA *rk2;
2144
2145         CHECK_EVPPKEY(pkey1);
2146         CHECK_EVPPKEY(pkey2);
2147
2148         pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2149         pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2150
2151         /* perform a type check first */
2152         if (!rsa_pkey_p(pk1))
2153                 error ("pkey1 must be of RSA type");
2154         if (!rsa_pkey_p(pk2))
2155                 error ("pkey2 must be of RSA type");
2156         
2157         rk1 = (pk1->pkey).rsa;
2158         rk2 = (pk2->pkey).rsa;
2159
2160         if (rsa_pkey_has_private_data(rk2) &&
2161             rsa_pkey_has_public_data(rk1) &&
2162             (!BN_cmp(rk1->n, rk2->n)) &&
2163             (!BN_cmp(rk1->e, rk2->e)))
2164                 return Qt;
2165         else
2166                 return Qnil;
2167 }
2168 #endif /* OPENSSL_NO_RSA */
2169
2170
2171 /* DSA */
2172 int
2173 dsa_pkey_p(EVP_PKEY *pkey)
2174 {
2175         int type;
2176
2177         type = EVP_PKEY_type(pkey->type);
2178
2179 #ifndef OPENSSL_NO_DSA
2180         return ((type == EVP_PKEY_DSA) ||
2181                 (type == EVP_PKEY_DSA1) ||
2182                 (type == EVP_PKEY_DSA2) ||
2183                 (type == EVP_PKEY_DSA3) ||
2184                 (type == EVP_PKEY_DSA4));
2185 #else
2186         return 0;
2187 #endif
2188 }
2189 #ifndef OPENSSL_NO_DSA
2190 int
2191 dsa_pkey_has_public_data(DSA *dsakey)
2192 {
2193         return (!(dsakey->p == NULL) &&
2194                 !(dsakey->q == NULL) &&
2195                 !(dsakey->g == NULL) &&
2196                 !(dsakey->pub_key == NULL));
2197 }
2198 int
2199 dsa_pkey_has_private_data(DSA *dsakey)
2200 {
2201         return (dsa_pkey_has_public_data(dsakey) &&
2202                 !(dsakey->priv_key == NULL));
2203 }
2204
2205 DEFUN("ossl-dsa-generate-key", Fossl_dsa_generate_key, 1, 2, 0, /*
2206 Return a DSA public key with of length BITS seeded with (optional) SEED.
2207 */
2208       (bits, seed))
2209 {
2210         EVP_PKEY *pkey;
2211         DSA *dsakey;
2212         char *seed_ext;
2213         int seed_len;
2214         int counter_ret;
2215         unsigned_long h_ret;
2216
2217
2218         CHECK_NATNUM(bits);
2219
2220
2221         if (!XINT(bits))
2222                 error ("prime number size must be a non-zero positive integer");
2223
2224         if (NILP(seed)) {
2225                 seed_ext = NULL;
2226                 seed_len = 0;
2227         } else {
2228                 CHECK_STRING(seed);
2229                 TO_EXTERNAL_FORMAT (LISP_STRING, seed,
2230                                     C_STRING_ALLOCA, seed_ext, OSSL_CODING);
2231                 seed_len = OSSL_STRING_LENGTH(seed);
2232         }
2233
2234         pkey = EVP_PKEY_new();
2235         dsakey = DSA_generate_parameters(XINT(bits),
2236                                          (unsigned char*)seed_ext, seed_len,
2237                                          &counter_ret, &h_ret,
2238                                          NULL, NULL);
2239         if (!DSA_generate_key(dsakey))
2240                 error ("error during generation of DSA key");
2241
2242         EVP_PKEY_assign_DSA(pkey, dsakey);
2243
2244         return make_evp_pkey_pk(pkey);
2245 }
2246
2247 DEFUN("ossl-dsa-pkey-p", Fossl_dsa_pkey_p, 1, 1, 0, /*
2248 Return t iff PKEY is of DSA type.
2249 */
2250       (pkey))
2251 {
2252         EVP_PKEY *pk;
2253
2254         if (!EVPPKEYP(pkey))
2255                 return Qnil;
2256
2257         pk = (XEVPPKEY(pkey))->evp_pkey;
2258         if (dsa_pkey_p(pk))
2259                 return Qt;
2260         else
2261                 return Qnil;
2262 }
2263
2264 DSA *
2265 dsa_get_public(EVP_PKEY *pk)
2266 {
2267         DSA *key;
2268
2269         key = DSA_new();
2270         memcpy(key, (pk->pkey).dsa, sizeof(DSA));
2271
2272         /* now kill the private data */
2273         key->priv_key = NULL;
2274
2275         return key;
2276 }
2277
2278 DEFUN("ossl-dsa-subkey-p", Fossl_dsa_subkey_p, 2, 2, 0, /*
2279 Return t iff PKEY1 is a subkey of PKEY2.
2280 I.e. if PKEY1 has the same public key data as PKEY2 and
2281 PKEY2 has all private data.
2282
2283 This function is not native OpenSSL.
2284 */
2285       (pkey1, pkey2))
2286 {
2287         EVP_PKEY *pk1;
2288         EVP_PKEY *pk2;
2289         DSA *dk1;
2290         DSA *dk2;
2291
2292         CHECK_EVPPKEY(pkey1);
2293         CHECK_EVPPKEY(pkey2);
2294
2295         pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2296         pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2297
2298         /* perform a type check first */
2299         if (!dsa_pkey_p(pk1))
2300                 error ("pkey1 must be of DSA type");
2301         if (!dsa_pkey_p(pk2))
2302                 error ("pkey2 must be of DSA type");
2303         
2304         dk1 = (pk1->pkey).dsa;
2305         dk2 = (pk2->pkey).dsa;
2306
2307         if (dsa_pkey_has_private_data(dk2) &&
2308             dsa_pkey_has_public_data(dk1) &&
2309             (!BN_cmp(dk1->p, dk2->p)) &&
2310             (!BN_cmp(dk1->q, dk2->q)) &&
2311             (!BN_cmp(dk1->g, dk2->g)) &&
2312             (!BN_cmp(dk1->pub_key, dk2->pub_key)))
2313                 return Qt;
2314         else
2315                 return Qnil;
2316 }
2317 #endif /* OPENSSL_NO_DSA */
2318
2319
2320 /* EC */
2321 int
2322 ec_pkey_p(EVP_PKEY *pkey)
2323 {
2324         int type;
2325
2326         type = EVP_PKEY_type(pkey->type);
2327
2328 #ifndef OPENSSL_NO_EC
2329         return (type == EVP_PKEY_EC);
2330 #else
2331         return 0;
2332 #endif
2333 }
2334 #ifndef OPENSSL_NO_EC
2335 int
2336 ec_pkey_has_public_data(EC_KEY *ec_key)
2337 {
2338         return (!(EC_KEY_get0_group(ec_key) == NULL) &&
2339                 !(EC_KEY_get0_public_key(ec_key) == NULL));
2340 }
2341 int
2342 ec_pkey_has_private_data(EC_KEY *ec_key)
2343 {
2344         return (ec_pkey_has_public_data(ec_key) &&
2345                 !(EC_KEY_get0_private_key(ec_key) == NULL));
2346 }
2347
2348 DEFUN("ossl-ec-available-curves", Fossl_ec_available_curves, 0, 0, 0, /*
2349 Return a list of builtin elliptic curves.
2350 */
2351       ())
2352 {
2353         EC_builtin_curve *curves = NULL;
2354         size_t crv_len = 0, n = 0;
2355         Lisp_Object lcurves;
2356
2357         lcurves = Qnil;
2358
2359         crv_len = EC_get_builtin_curves(NULL, 0);
2360         curves = OPENSSL_malloc(sizeof(EC_builtin_curve) * crv_len);
2361
2362         if (curves == NULL)
2363                 error ("no curves defined");
2364
2365         if (!EC_get_builtin_curves(curves, crv_len)) {
2366                 OPENSSL_free(curves);
2367                 error ("error during initialisation of curves");
2368         }
2369
2370         for (n = 0; n < crv_len; n++) {
2371                 int nid = curves[n].nid;
2372                 lcurves = Fcons(intern(OBJ_nid2sn(nid)), lcurves);
2373         }
2374
2375         OPENSSL_free(curves);
2376
2377         return lcurves;
2378 }
2379
2380 int
2381 ec_curve_by_name(char *name)
2382 {
2383         return OBJ_sn2nid(name);
2384 }
2385
2386 DEFUN("ossl-ec-generate-key", Fossl_ec_generate_key, 1, 1, 0, /*
2387 Return a EC public key on CURVE.
2388 CURVE may be any symbol from `ossl-ec-available-curves'.
2389
2390 At the moment we do not support creating custom curves.
2391 */
2392       (curve))
2393 {
2394         EVP_PKEY *pkey;
2395         EC_KEY *eckey;
2396
2397         CHECK_SYMBOL(curve);
2398
2399         pkey = EVP_PKEY_new();
2400         eckey = EC_KEY_new_by_curve_name(
2401                 ec_curve_by_name((char *)string_data(XSYMBOL(curve)->name)));
2402
2403         if (eckey == NULL) {
2404                 error ("no such curve");
2405         }
2406
2407         if (!EC_KEY_generate_key(eckey))
2408                 error ("error during generation of EC key");
2409
2410         EVP_PKEY_assign_EC_KEY(pkey, eckey);
2411
2412         return make_evp_pkey_pk(pkey);
2413 }
2414
2415 DEFUN("ossl-ec-pkey-p", Fossl_ec_pkey_p, 1, 1, 0, /*
2416 Return t iff PKEY is of EC type.
2417 */
2418       (pkey))
2419 {
2420         EVP_PKEY *pk;
2421         int type;
2422
2423         if (!EVPPKEYP(pkey))
2424                 return Qnil;
2425
2426         pk = (XEVPPKEY(pkey))->evp_pkey;
2427         type = EVP_PKEY_type(pk->type);
2428         if (type == EVP_PKEY_EC)
2429                 return Qt;
2430         else
2431                 return Qnil;
2432 }
2433
2434 EC_KEY *
2435 ec_get_public(EVP_PKEY *pk)
2436 {
2437         EC_KEY *key;
2438
2439         key = EC_KEY_dup((pk->pkey).ec);
2440
2441         /* now kill the private data */
2442         EC_KEY_set_private_key(key, NULL);
2443
2444         return key;
2445 }
2446 #endif /* OPENSSL_NO_EC */
2447
2448
2449 /* DH */
2450 int
2451 dh_pkey_p(EVP_PKEY *pkey)
2452 {
2453         int type;
2454
2455         type = EVP_PKEY_type(pkey->type);
2456
2457 #ifndef OPENSSL_NO_DH
2458         return (type == EVP_PKEY_DH);
2459 #else
2460         return 0;
2461 #endif
2462 }
2463 #ifndef OPENSSL_NO_DH
2464 int
2465 dh_pkey_has_public_data(DH *dhkey)
2466 {
2467         return (!(dhkey->p == NULL) &&
2468                 !(dhkey->g == NULL) &&
2469                 !(dhkey->pub_key == NULL));
2470 }
2471 int
2472 dh_pkey_has_private_data(DH *dhkey)
2473 {
2474         return (dh_pkey_has_public_data(dhkey) &&
2475                 !(dhkey->priv_key == NULL));
2476 }
2477
2478 DEFUN("ossl-dh-pkey-p", Fossl_dh_pkey_p, 1, 1, 0, /*
2479 Return t iff PKEY is of DH type.
2480 */
2481       (pkey))
2482 {
2483         EVP_PKEY *pk;
2484
2485         if (!EVPPKEYP(pkey))
2486                 return Qnil;
2487
2488         pk = (XEVPPKEY(pkey))->evp_pkey;
2489
2490         if (dh_pkey_p(pk))
2491                 return Qt;
2492         else
2493                 return Qnil;
2494 }
2495
2496 #endif /* OPENSSL_NO_DH */
2497
2498
2499 /* more general access functions */
2500 DEFUN("ossl-seal", Fossl_seal, 3, 3, 0, /*
2501 Return an envelope derived from encrypting STRING by CIPHER under PKEY
2502 with the hybrid technique.
2503
2504 That is, create a random key/iv pair for the symmetric encryption with 
2505 CIPHER and encrypt that key/iv asymmetrically with the provided public
2506 key.
2507
2508 The envelope returned is a list 
2509 \(encrypted_string encrypted_key encrypted_iv\)
2510 where
2511 `encrypted_string' is the (symmetrically) encrypted message
2512 `encrypted_key' is the (asymmetrically) encrypted random key
2513 `encrypted_iv' is the (asymmetrically) encrypted random iv
2514
2515 Note: You probably want to put a wrapping encoder function
2516 (like `base16-encode-string') around it, since this function
2517 returns binary string data.
2518 */
2519       (cipher, string, pkey))
2520 {
2521         /* declarations for the cipher */
2522         const EVP_CIPHER *ciph;
2523         EVP_CIPHER_CTX ciphctx;
2524         /* declarations for the pkey */
2525         EVP_PKEY *pk[1];
2526         int npubk;
2527         unsigned char *ekey;
2528         int ekey_len;
2529         Lisp_Object l_ekey;
2530         /* buffer for the generated IV */
2531         char iv[EVP_MAX_IV_LENGTH];
2532         Lisp_Object l_iv;
2533         /* buffer for output */
2534         unsigned char *outbuf;
2535         unsigned int outlen;
2536         Lisp_Object l_outbuf;
2537         /* buffer for external string data */
2538         char *string_ext;
2539         int string_len;
2540
2541         int tmplen;
2542
2543
2544         CHECK_SYMBOL(cipher);
2545         CHECK_STRING(string);
2546         CHECK_EVPPKEY(pkey);
2547
2548
2549         pk[0] = (XEVPPKEY(pkey))->evp_pkey;
2550         if (!ossl_pkey_has_public_data(pk[0])) {
2551                 error ("cannot seal, key has no public key data");
2552         }
2553         npubk = 1;
2554
2555         TO_EXTERNAL_FORMAT (LISP_STRING, string,
2556                             C_STRING_ALLOCA, string_ext, OSSL_CODING);
2557         string_len = OSSL_STRING_LENGTH(string);
2558
2559         OpenSSL_add_all_algorithms();
2560         ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2561
2562         if (!ciph) {
2563                 EVP_cleanup();
2564                 error ("no such cipher");
2565                 return Qnil;
2566         }
2567
2568         /* alloc ekey buffer */
2569         ekey = (unsigned char*)xmalloc_atomic(EVP_PKEY_size(pk[0]));
2570
2571         /* now allocate some output buffer externally
2572          * this one has to be at least EVP_CIPHER_block_size bigger
2573          * since block algorithms merely operate blockwise
2574          */
2575         outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string) +
2576                                                  EVP_CIPHER_block_size(ciph));
2577
2578         EVP_CIPHER_CTX_init(&ciphctx);
2579         if (!(EVP_SealInit(&ciphctx, ciph,
2580                            &ekey, &ekey_len,
2581                            (unsigned char *)&iv,
2582                            (EVP_PKEY **)&pk, npubk)==npubk)) {
2583                 EVP_cleanup();
2584                 xfree(outbuf);
2585                 xfree(ekey);
2586                 error ("error in SealInit");
2587                 return Qnil;
2588         }
2589         if (!EVP_SealUpdate(&ciphctx, outbuf, (int *)&outlen,
2590                             (unsigned char*)string_ext, string_len)) {
2591                 EVP_cleanup();
2592                 xfree(outbuf);
2593                 xfree(ekey);
2594                 error ("error in SealUpdate");
2595                 return Qnil;
2596         }
2597         if (!EVP_SealFinal(&ciphctx, (unsigned char*)outbuf+outlen, &tmplen)) {
2598                 EVP_cleanup();
2599                 xfree(outbuf);
2600                 xfree(ekey);
2601                 error ("error in SealFinal");
2602                 return Qnil;
2603         }
2604         /* added probable padding space to the length of the output buffer */
2605         outlen += tmplen;
2606         EVP_CIPHER_CTX_cleanup(&ciphctx);
2607
2608         l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2609         l_ekey = make_ext_string((char *)ekey, ekey_len, OSSL_CODING);
2610         l_iv = make_ext_string(iv,EVP_CIPHER_iv_length(ciph), OSSL_CODING);
2611         xfree(outbuf);
2612         xfree(ekey);
2613         EVP_cleanup();
2614
2615         return list3(l_outbuf, l_ekey, l_iv);
2616 }
2617
2618
2619 DEFUN("ossl-open", Fossl_open, 4, 5, 0, /*
2620 Return the deciphered message STRING from an envelope
2621 obtained by `ossl-seal'.
2622
2623 CIPHER is the cipher to use (the same as in `ossl-seal')
2624 STRING is the encrypted message
2625 PKEY is the private key
2626 EKEY is the encrypted random key
2627 EIV is the encrypted iv
2628 */
2629       (cipher, string, pkey, ekey, eiv))
2630 {
2631         /* declarations for the cipher */
2632         const EVP_CIPHER *ciph;
2633         EVP_CIPHER_CTX ciphctx;
2634         /* declarations for the pkey */
2635         EVP_PKEY *pk;
2636         /* buffer for external ekey data */
2637         char *ekey_ext;
2638         int ekey_len;
2639         /* buffer for external eiv data */
2640         char *eiv_ext;
2641         /* buffer for output */
2642         unsigned char *outbuf;
2643         unsigned int outlen;
2644         Lisp_Object l_outbuf;
2645         /* buffer for external string data */
2646         char *string_ext;
2647         int string_len;
2648
2649         int tmplen;
2650
2651
2652         CHECK_SYMBOL(cipher);
2653         CHECK_STRING(string);
2654         CHECK_EVPPKEY(pkey);
2655         CHECK_STRING(ekey);
2656
2657
2658         pk = (XEVPPKEY(pkey))->evp_pkey;
2659         if (!ossl_pkey_has_private_data(pk))
2660                 error ("cannot open, key has no private key data");
2661
2662         TO_EXTERNAL_FORMAT (LISP_STRING, string,
2663                             C_STRING_ALLOCA, string_ext, OSSL_CODING);
2664         string_len = OSSL_STRING_LENGTH(string);
2665         TO_EXTERNAL_FORMAT (LISP_STRING, ekey,
2666                             C_STRING_ALLOCA, ekey_ext, OSSL_CODING);
2667         ekey_len = OSSL_STRING_LENGTH(ekey);
2668
2669         OpenSSL_add_all_algorithms();
2670         ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2671
2672         if (!ciph) {
2673                 EVP_cleanup();
2674                 error ("no such cipher");
2675                 return Qnil;
2676         }
2677
2678         if (NILP(eiv)) {
2679                 eiv_ext = NULL;
2680         } else {
2681                 CHECK_STRING(eiv);
2682                 TO_EXTERNAL_FORMAT (LISP_STRING, eiv,
2683                                     C_STRING_ALLOCA, eiv_ext, OSSL_CODING);
2684         }
2685
2686         /* now allocate some output buffer externally */
2687         outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string));
2688
2689         EVP_CIPHER_CTX_init(&ciphctx);
2690         if (!EVP_OpenInit(&ciphctx, ciph,
2691                           (unsigned char*)ekey_ext,
2692                           (unsigned int)ekey_len,
2693                           (unsigned char*)eiv_ext, pk)) {
2694                 EVP_cleanup();
2695                 xfree(outbuf);
2696                 error ("error in OpenInit");
2697                 return Qnil;
2698         }
2699         if (!EVP_OpenUpdate(&ciphctx, outbuf, (int *)&outlen,
2700                             (unsigned char*)string_ext,
2701                             (unsigned int)string_len)) {
2702                 EVP_cleanup();
2703                 xfree(outbuf);
2704                 error ("error in OpenUpdate");
2705                 return Qnil;
2706         }
2707         if (!EVP_OpenFinal(&ciphctx, outbuf+outlen, &tmplen)) {
2708                 EVP_cleanup();
2709                 xfree(outbuf);
2710                 error ("error in OpenFinal");
2711                 return Qnil;
2712         }
2713         /* added probable padding space to the length of the output buffer */
2714         outlen += tmplen;
2715         EVP_CIPHER_CTX_cleanup(&ciphctx);
2716
2717         l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2718         xfree(outbuf);
2719
2720         EVP_cleanup();
2721
2722         return l_outbuf;
2723 }
2724
2725
2726 DEFUN("ossl-sign", Fossl_sign, 3, 3, 0, /*
2727 Return a signature obtained by signing STRING under DIGEST with PKEY.
2728
2729 That is, hash the message STRING with the message digest DIGEST and
2730 encrypt the result with the private key PKEY.
2731
2732 Note: Due to some relationship between the public key system and the
2733 message digest you cannot use every digest algorithm with every 
2734 private key type.
2735 The most certain results will be achieved using
2736 RSA keys with RSA-* digests, DSA keys with DSA-* digests.
2737
2738 See `ossl-available-digests'.
2739
2740 Note: You probably want to put a wrapping encoder function
2741 (like `base16-encode-string') around it, since this returns
2742 binary string data.
2743 */
2744       (digest, string, pkey))
2745 {
2746         /* declarations for the cipher */
2747         const EVP_MD *md;
2748         EVP_MD_CTX mdctx;
2749         /* declarations for the pkey */
2750         EVP_PKEY *pk;
2751         /* buffer for output */
2752         unsigned char *outbuf;
2753         unsigned int outlen;
2754         Lisp_Object l_outbuf;
2755         /* buffer for external string data */
2756         char *string_ext;
2757         int string_len;
2758
2759
2760         CHECK_SYMBOL(digest);
2761         CHECK_STRING(string);
2762         CHECK_EVPPKEY(pkey);
2763
2764
2765         pk = (XEVPPKEY(pkey))->evp_pkey;
2766         if (!ossl_pkey_has_private_data(pk)) {
2767                 error ("cannot sign, key has no private key data");
2768         }
2769
2770         TO_EXTERNAL_FORMAT (LISP_STRING, string,
2771                             C_STRING_ALLOCA, string_ext, OSSL_CODING);
2772         string_len = OSSL_STRING_LENGTH(string);
2773
2774         OpenSSL_add_all_algorithms();
2775         md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2776
2777         if (!md) {
2778                 EVP_cleanup();
2779                 error ("no such digest");
2780                 return Qnil;
2781         }
2782
2783         /* now allocate some output buffer externally */
2784         outbuf = (unsigned char *)xmalloc_atomic(EVP_PKEY_size(pk));
2785
2786         EVP_MD_CTX_init(&mdctx);
2787         if (!(EVP_SignInit(&mdctx, md))) {
2788                 EVP_cleanup();
2789                 xfree(outbuf);
2790                 error ("error in SignInit");
2791                 return Qnil;
2792         }
2793         if (!EVP_SignUpdate(&mdctx, string_ext, string_len)) {
2794                 EVP_cleanup();
2795                 xfree(outbuf);
2796                 error ("error in SignUpdate");
2797                 return Qnil;
2798         }
2799         if (!EVP_SignFinal(&mdctx, outbuf, &outlen, pk)) {
2800                 EVP_cleanup();
2801                 xfree(outbuf);
2802                 error ("error in SignFinal");
2803                 return Qnil;
2804         }
2805         EVP_MD_CTX_cleanup(&mdctx);
2806
2807         l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2808         xfree(outbuf);
2809
2810         EVP_cleanup();
2811
2812         return l_outbuf;
2813 }
2814
2815 DEFUN("ossl-verify", Fossl_verify, 4, 4, 0, /*
2816 Return t iff SIG is a valid signature of STRING under DIGEST obtained by PKEY.
2817
2818 That is, hash the message STRING with the message digest DIGEST, then
2819 decrypt the signature SIG with the public key PKEY.
2820 Compare the results and return t iff both hashes are equal.
2821
2822 DIGEST is the digest to use (the same as in `ossl-sign')
2823 STRING is the message
2824 SIG is the signature of message
2825 PKEY is the public key
2826 */
2827       (digest, string, sig, pkey))
2828 {
2829         /* declarations for the cipher */
2830         const EVP_MD *md;
2831         EVP_MD_CTX mdctx;
2832         /* declarations for the pkey */
2833         EVP_PKEY *pk;
2834         /* buffer for external signature data */
2835         char *sig_ext;
2836         int sig_len;
2837         /* buffer for external string data */
2838         char *string_ext;
2839         int string_len;
2840
2841         int result;
2842
2843
2844         CHECK_SYMBOL(digest);
2845         CHECK_STRING(string);
2846         CHECK_STRING(sig);
2847         CHECK_EVPPKEY(pkey);
2848
2849
2850         pk = (XEVPPKEY(pkey))->evp_pkey;
2851         if (!ossl_pkey_has_public_data(pk))
2852                 error ("cannot verify, key has no public key data");
2853
2854         OpenSSL_add_all_algorithms();
2855         md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2856
2857         if (!md) {
2858                 EVP_cleanup();
2859                 error ("no such digest");
2860                 return Qnil;
2861         }
2862
2863         TO_EXTERNAL_FORMAT (LISP_STRING, string,
2864                             C_STRING_ALLOCA, string_ext, OSSL_CODING);
2865         string_len = OSSL_STRING_LENGTH(string);
2866         TO_EXTERNAL_FORMAT (LISP_STRING, sig,
2867                             C_STRING_ALLOCA, sig_ext, OSSL_CODING);
2868         sig_len = OSSL_STRING_LENGTH(sig);
2869
2870         EVP_MD_CTX_init(&mdctx);
2871         if (!EVP_VerifyInit(&mdctx, md)) {
2872                 EVP_cleanup();
2873                 error ("error in VerifyInit");
2874                 return Qnil;
2875         }
2876         if (!EVP_VerifyUpdate(&mdctx, string_ext, string_len)) {
2877                 EVP_cleanup();
2878                 error ("error in VerifyUpdate");
2879                 return Qnil;
2880         }
2881         result = EVP_VerifyFinal(&mdctx, (unsigned char*)sig_ext, sig_len, pk);
2882         if (result == -1) {
2883                 EVP_cleanup();
2884                 error ("error in VerifyFinal");
2885                 return Qnil;
2886         }
2887         EVP_MD_CTX_cleanup(&mdctx);
2888
2889         EVP_cleanup();
2890
2891         return result ? Qt : Qnil;
2892 }
2893
2894
2895 /*
2896  *
2897  * PEM
2898  *
2899  */
2900 DEFUN("ossl-pem-read-public-key", Fossl_pem_read_public_key, 1, 1, 0, /*
2901 Return a key (the public part) stored in a PEM structure from FILE.
2902 */
2903       (file))
2904 {
2905         /* declarations for the pkey */
2906         EVP_PKEY *pk;
2907         X509 *pk509;
2908
2909         /* output file */
2910         FILE *fp;
2911
2912         CHECK_STRING(file);
2913
2914         file = Fexpand_file_name(file, Qnil);
2915
2916         if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2917                 error ("error opening file.");
2918
2919         pk509 = PEM_read_X509(fp, NULL, NULL, NULL);
2920         pk = PEM_read_PUBKEY(fp, NULL, NULL, NULL);
2921
2922         fclose(fp);
2923
2924         return make_evp_pkey(pk, pk509);
2925 }
2926
2927 DEFUN("ossl-pem-read-key", Fossl_pem_read_key, 1, 2, 0, /*
2928 Return a key stored in a PEM structure from FILE.
2929 If the (private part of the) key is protected with a password
2930 provide (optional) PASSWORD.
2931 */
2932       (file, password))
2933 {
2934         /* declarations for the pkey */
2935         EVP_PKEY *pk;
2936         /* output file */
2937         FILE *fp;
2938         /* password pointer */
2939         char *pass;
2940
2941         CHECK_STRING(file);
2942
2943         file = Fexpand_file_name(file, Qnil);
2944
2945         if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2946                 error ("error opening file.");
2947
2948         if (NILP(password)) {
2949                 pass = NULL;
2950         } else {
2951                 CHECK_STRING(password);
2952                 pass = (char *)XSTRING_DATA(password);
2953         }
2954
2955         pk = PEM_read_PrivateKey(fp, NULL, NULL, pass);
2956         fclose(fp);
2957         if (pk == NULL) {
2958                 /* now maybe it is a public key only */
2959                 return Fossl_pem_read_public_key(file);
2960         }
2961
2962         return make_evp_pkey_pk(pk);
2963 }
2964
2965 DEFUN("ossl-pem-write-public-key", Fossl_pem_write_public_key, 2, 2, 0, /*
2966 Write PKEY (the public part) in a PEM structure to FILE.
2967 */
2968       (file, pkey))
2969 {
2970         /* declarations for the pkey */
2971         EVP_PKEY *pk;
2972         X509 *pk509;
2973         /* output file */
2974         FILE *fp;
2975
2976         CHECK_STRING(file);
2977         CHECK_EVPPKEY(pkey);
2978
2979         file = Fexpand_file_name(file, Qnil);
2980
2981         pk = XEVPPKEY(pkey)->evp_pkey;
2982         pk509 = XEVPPKEY(pkey)->x509;
2983
2984         if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL)
2985                 error ("error opening file.");
2986
2987         if (!PEM_write_PUBKEY(fp, pk)) {
2988                 fclose(fp);
2989                 error ("error writing PEM file.");
2990         }
2991
2992         fclose(fp);
2993
2994         return file;
2995 }
2996
2997 DEFUN("ossl-pem-write-key", Fossl_pem_write_key, 2, 4, 0, /*
2998 Write PKEY in a PEM structure to FILE. The key itself is
2999 protected by (optional) CIPHER with PASSWORD.
3000
3001 CIPHER can be set to nil and the key will not be encrypted.
3002 PASSWORD is ignored in this case.
3003 */
3004       (file, pkey, cipher, password))
3005 {
3006         const EVP_CIPHER *ciph;
3007         /* declarations for the pkey */
3008         EVP_PKEY *pk;
3009         X509 *pk509;
3010         /* output file */
3011         FILE *fp;
3012         /* password pointer */
3013         char *pass;
3014
3015         CHECK_STRING(file);
3016         CHECK_EVPPKEY(pkey);
3017
3018         file = Fexpand_file_name(file, Qnil);
3019
3020         pk = XEVPPKEY(pkey)->evp_pkey;
3021         pk509 = XEVPPKEY(pkey)->x509;
3022
3023         if (!ossl_pkey_has_private_data(pk))
3024                 return Fossl_pem_write_public_key(file, pkey);
3025
3026         CHECK_SYMBOL(cipher);
3027
3028         OpenSSL_add_all_algorithms();
3029         
3030         if (NILP(cipher)) {
3031                 ciph = NULL;
3032                 pass = NULL;
3033         } else {
3034                 ciph = EVP_get_cipherbyname(
3035                         (char *)string_data(XSYMBOL(cipher)->name));
3036                 if (!ciph) {
3037                         EVP_cleanup();
3038                         error ("no such cipher");
3039                 }
3040         }
3041
3042         if (NILP(password)) {
3043                 ciph = NULL;
3044                 pass = NULL;
3045         } else {
3046                 CHECK_STRING(password);
3047                 pass = (char *)XSTRING_DATA(password);
3048         }
3049
3050         if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL) {
3051                 EVP_cleanup();
3052                 error ("error opening file.");
3053         }
3054
3055         if (!PEM_write_PKCS8PrivateKey(fp, pk, ciph, NULL, 0, NULL, pass)) {
3056                 EVP_cleanup();
3057                 fclose(fp);
3058                 error ("error writing PEM file.");
3059         }
3060
3061         EVP_cleanup();
3062         fclose(fp);
3063
3064         return file;
3065 }
3066
3067 static long
3068 ossl_pem_pkey_cb(BIO *bio, int cmd, const char *argp,
3069                  int argi, long argl, long ret)
3070 {
3071         Lisp_Object key;
3072         void *foo = BIO_get_callback_arg(bio);
3073
3074         if (!(key = (Lisp_Object)foo)) {
3075                 return ret;
3076         }
3077
3078         if (BIO_CB_RETURN & cmd) {
3079                 return ret;
3080         }
3081
3082         switch (cmd) {
3083         case BIO_CB_WRITE:
3084                 key = concat2(key, make_ext_string(argp, argi, OSSL_CODING));
3085                 BIO_set_callback_arg(bio, (void*)key);
3086                 break;
3087         default:
3088                 return ret;
3089         }
3090         return ret;
3091 }
3092
3093 DEFUN("ossl-pem-public-key",Fossl_pem_public_key, 1, 1, 0, /*
3094 Return PKEY as PEM encoded string.
3095 */
3096       (pkey))
3097 {
3098         /* This function can GC */
3099         /* declarations for the pkey */
3100         EVP_PKEY *pk;
3101         Lisp_Object result;
3102         /* bio stuff */
3103         BIO *b;
3104         /* gc stuff */
3105         struct gcpro gcpro1;
3106
3107         GCPRO1(pkey);
3108
3109         CHECK_EVPPKEY(pkey);
3110
3111         pk = (XEVPPKEY(pkey))->evp_pkey;
3112
3113         if (!(b = BIO_new(BIO_s_null()))) {
3114                 UNGCPRO;
3115                 error("cannot open memory buffer");
3116                 return Qnil;
3117         }
3118
3119         result = build_string("");
3120         BIO_set_callback(b, ossl_pem_pkey_cb);
3121         BIO_set_callback_arg(b, (void*)result);
3122
3123         if (!PEM_write_bio_PUBKEY(b, pk)) {
3124                 EVP_cleanup();
3125                 BIO_free(b);
3126                 UNGCPRO;
3127                 error ("error creating PEM string");
3128                 return Qnil;
3129         }
3130
3131         {
3132                 void *foo = BIO_get_callback_arg(b);
3133                 if (!(result = (Lisp_Object)foo)) {
3134                         result = Qnil;
3135                 }
3136         }
3137
3138         BIO_free(b);
3139
3140         UNGCPRO;
3141         return result;
3142 }
3143
3144 DEFUN("ossl-pem-key",Fossl_pem_key, 1, 3, 0, /*
3145 Return PKEY as PEM encoded string.   The key itself is
3146 protected by (optional) CIPHER with PASSWORD.
3147
3148 CIPHER can be set to nil and the key will not be encrypted.
3149 PASSWORD is ignored in this case.
3150 */
3151       (pkey, cipher, password))
3152 {
3153         /* This function can GC */
3154         /* declarations for the pkey */
3155         EVP_PKEY *pk;
3156         Lisp_Object result;
3157         const EVP_CIPHER *ciph;
3158         char *pass;
3159         /* bio stuff */
3160         BIO *b;
3161         struct gcpro gcpro1, gcpro2, gcpro3;
3162
3163         GCPRO3(pkey, cipher, password);
3164
3165         CHECK_EVPPKEY(pkey);
3166
3167         pk = (XEVPPKEY(pkey))->evp_pkey;
3168
3169         if (!ossl_pkey_has_private_data(pk)) {
3170                 UNGCPRO;
3171                 return Fossl_pem_public_key(pkey);
3172         }
3173
3174         CHECK_SYMBOL(cipher);
3175
3176         OpenSSL_add_all_algorithms();
3177         
3178         if (NILP(cipher)) {
3179                 ciph = NULL;
3180                 pass = NULL;
3181         } else {
3182                 ciph = EVP_get_cipherbyname(
3183                         (char *)string_data(XSYMBOL(cipher)->name));
3184                 if (!ciph) {
3185                         EVP_cleanup();
3186                         UNGCPRO;
3187                         error ("no such cipher");
3188                         return Qnil;
3189                 }
3190         }
3191
3192         if (NILP(password)) {
3193                 ciph = NULL;
3194                 pass = NULL;
3195         } else {
3196                 CHECK_STRING(password);
3197                 pass = (char *)XSTRING_DATA(password);
3198         }
3199
3200         if (!(b = BIO_new(BIO_s_null()))) {
3201                 UNGCPRO;
3202                 error("cannot open memory buffer");
3203                 return Qnil;
3204         }
3205
3206         result = build_string("");
3207         BIO_set_callback(b, ossl_pem_pkey_cb);
3208         BIO_set_callback_arg(b, (void*)result);
3209
3210         if (!PEM_write_bio_PKCS8PrivateKey(b, pk, ciph, NULL, 0, NULL, pass)) {
3211                 EVP_cleanup();
3212                 BIO_free(b);
3213                 UNGCPRO;
3214                 error ("error creating PEM string");
3215                 return Qnil;
3216         }
3217
3218         {
3219                 void *foo = BIO_get_callback_arg(b);
3220
3221                 if (!(result = (Lisp_Object)foo)) {
3222                         result = Qnil;
3223                 }
3224         }
3225
3226         BIO_free(b);
3227
3228         UNGCPRO;
3229         return result;
3230 }
3231
3232 \f
3233 /*
3234  *
3235  * SSL
3236  * The SSL support in this API is sorta high level since having
3237  * server hellos, handshakes and stuff like that is not what you want
3238  * to do in elisp.
3239  *
3240  */
3241 /* This is an opaque object for storing PKEYs in lisp */
3242 Lisp_Object Qssl_connp;
3243
3244 Lisp_Object
3245 make_ssl_conn(Lisp_SSL_CONN *ssl_conn)
3246 {
3247         Lisp_Object lisp_ssl_conn;
3248         XSETSSLCONN(lisp_ssl_conn, ssl_conn);
3249         return lisp_ssl_conn;
3250 }
3251
3252 static Lisp_Object
3253 mark_ssl_conn(Lisp_Object obj)
3254 {
3255         mark_object(XSSLCONN(obj)->parent);
3256         mark_object(XSSLCONN(obj)->pipe_instream);
3257         mark_object(XSSLCONN(obj)->pipe_outstream);
3258 #ifdef FILE_CODING
3259         mark_object(XSSLCONN(obj)->coding_instream);
3260         mark_object(XSSLCONN(obj)->coding_outstream);
3261 #endif
3262
3263         return Qnil;
3264 }
3265
3266 static void
3267 print_ssl_conn(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3268 {
3269         SSL *conn;
3270         Lisp_Object parent;
3271
3272         conn = XSSLCONN(obj)->ssl_conn;
3273         parent = XSSLCONN(obj)->parent;
3274
3275         write_c_string("#<OpenSSL socket layer: ", printcharfun);
3276         if (conn == NULL) 
3277                 write_c_string("dead", printcharfun);
3278         else
3279                 write_c_string(SSL_get_version(conn), printcharfun);
3280
3281 #ifdef HAVE_SOCKETS
3282         if (PROCESSP(parent)) {
3283                 write_c_string(" on top of ", printcharfun);
3284                 print_internal(parent, printcharfun, escapeflag);
3285         }
3286 #endif  /* HAVE_SOCKETS */
3287
3288 #ifdef HAVE_POSTGRESQL
3289         if (PGCONNP(parent) &&
3290             PQstatus(XPGCONN(parent)->pgconn) == CONNECTION_OK) {
3291                 write_c_string(" on top of ", printcharfun);
3292                 print_internal(parent, printcharfun, escapeflag);
3293         }
3294 #endif  /* HAVE_POSTGRESQL */
3295         write_c_string(">", printcharfun);
3296 }
3297
3298 Lisp_SSL_CONN *
3299 allocate_ssl_conn(void)
3300 {
3301         Lisp_SSL_CONN *ssl_conn =
3302                 alloc_lcrecord_type(Lisp_SSL_CONN, &lrecord_ssl_conn);
3303
3304         /* the network process stuff */
3305         ssl_conn->parent = Qnil;
3306         ssl_conn->infd = -1;
3307         ssl_conn->outfd = -1;
3308
3309         ssl_conn->connected_p = 0;
3310         ssl_conn->protected_p = 0;
3311
3312         ssl_conn->pipe_instream = Qnil;
3313         ssl_conn->pipe_outstream = Qnil;
3314 #if FILE_CODING
3315         ssl_conn->coding_instream = Qnil;
3316         ssl_conn->coding_outstream = Qnil;
3317 #endif
3318
3319         return ssl_conn;
3320 }
3321
3322 static void
3323 finalise_ssl_conn(void *header, int for_disksave)
3324 {
3325         Lisp_SSL_CONN *ssl_conn = (Lisp_SSL_CONN *) header;
3326
3327         if (!(ssl_conn->ssl_conn == NULL)) {
3328                 if (ssl_conn->connected_p)
3329                         SSL_shutdown(ssl_conn->ssl_conn);
3330                 SSL_free(ssl_conn->ssl_conn);
3331                 ssl_conn->ssl_conn = NULL;
3332         }
3333         if (!(ssl_conn->ssl_ctx == NULL)) {
3334                 SSL_CTX_free(ssl_conn->ssl_ctx);
3335                 ssl_conn->ssl_ctx = NULL;
3336         }
3337         ssl_conn->ssl_bio = NULL;
3338
3339         if (PROCESSP(ssl_conn->parent)) {
3340                 XPROCESS(ssl_conn->parent)->process_type = PROCESS_TYPE_NETWORK;
3341                 XPROCESS(ssl_conn->parent)->process_type_data = Qnil;
3342         }
3343         /* we leave the process alive, it's not our fault, but
3344          * we nullify its pointer
3345          */
3346         ssl_conn->parent = Qnil;
3347         ssl_conn->infd = -1;
3348         ssl_conn->outfd = -1;
3349
3350         ssl_conn->connected_p = 0;
3351         ssl_conn->protected_p = 0;
3352
3353         /* free the lstream resources */
3354 #if 0                           /* will lead to problems */
3355         if (LSTREAMP(ssl_conn->pipe_instream))
3356                 Lstream_delete(XLSTREAM(ssl_conn->pipe_instream));
3357         if (LSTREAMP(ssl_conn->pipe_outstream))
3358                 Lstream_delete(XLSTREAM(ssl_conn->pipe_outstream));
3359 #endif
3360         ssl_conn->pipe_instream = Qnil;
3361         ssl_conn->pipe_outstream = Qnil;
3362 #if FILE_CODING
3363 #if 0                           /* will lead to problems */
3364         if (LSTREAMP(ssl_conn->coding_instream))
3365                 Lstream_delete(XLSTREAM(ssl_conn->coding_instream));
3366         if (LSTREAMP(ssl_conn->coding_outstream))
3367                 Lstream_delete(XLSTREAM(ssl_conn->coding_outstream));
3368 #endif
3369         ssl_conn->coding_instream = Qnil;
3370         ssl_conn->coding_outstream = Qnil;
3371 #endif
3372
3373         /* avoid some warning */
3374         if (for_disksave);
3375 }
3376
3377 DEFINE_LRECORD_IMPLEMENTATION("ssl_conn", ssl_conn,
3378                               mark_ssl_conn, print_ssl_conn,
3379                               finalise_ssl_conn,
3380                               NULL, NULL, 0, Lisp_SSL_CONN);
3381
3382 static int
3383 ssl_conn_alive_p(Lisp_SSL_CONN *ssl_conn)
3384 {
3385         return ssl_conn->connected_p;
3386 }
3387
3388 static int
3389 get_process_infd(Lisp_Process * p)
3390 {
3391         Lisp_Object instr, outstr;
3392         get_process_streams(p, &instr, &outstr);
3393         return Lstream_get_fd(XLSTREAM(instr));
3394 }
3395 static int
3396 get_process_outfd(Lisp_Process * p)
3397 {
3398         Lisp_Object instr, outstr;
3399         get_process_streams(p, &instr, &outstr);
3400         return Lstream_get_fd(XLSTREAM(outstr));
3401 }
3402
3403 static int
3404 event_stream_ssl_create_stream_pair(
3405         SSL *conn,
3406         Lisp_Object *instream, Lisp_Object *outstream, int flags)
3407 {
3408         *instream = make_ssl_input_stream(conn, flags);
3409         *outstream = make_ssl_output_stream(conn, flags);
3410
3411         return 0;
3412 }
3413
3414 static void
3415 init_ssl_io_handles(Lisp_SSL_CONN *s, int flags)
3416 {
3417         event_stream_ssl_create_stream_pair(
3418                 s->ssl_conn, &s->pipe_instream, &s->pipe_outstream, flags);
3419
3420 #ifdef FILE_CODING
3421         s->coding_instream = make_decoding_input_stream(
3422                 XLSTREAM(s->pipe_instream), Fget_coding_system(
3423                         Vcoding_system_for_read));
3424         Lstream_set_character_mode(XLSTREAM(s->coding_instream));
3425         s->coding_outstream = make_encoding_output_stream(
3426                 XLSTREAM(s->pipe_outstream), Fget_coding_system(
3427                         Vcoding_system_for_write));
3428 #endif /* FILE_CODING */
3429 }
3430
3431 /* Advanced step-by-step initialisation */
3432 #define OSSL_CHECK_PROCESS(process)                                     \
3433 {                                                                       \
3434         /* Make sure the process is really alive.  */                   \
3435         if (!EQ(XPROCESS(process)->status_symbol, Qrun))                \
3436                 error("Network stream %s not alive",                    \
3437                       XSTRING_DATA(XPROCESS(process)->name));           \
3438         /* Make sure the process is a network stream. */                \
3439         if (!network_connection_p(process))                             \
3440                 error("Process %s is not a network stream",             \
3441                       XSTRING_DATA(XPROCESS(process)->name));           \
3442 } while (0);
3443
3444 #ifdef OSSL_DEBUG_FLAG
3445 static long
3446 ossl_bio_dump_callback(BIO *bio, int cmd, const char *argp,
3447                   int argi, long argl, long ret)
3448 {
3449         BIO *out;
3450
3451         out=(BIO *)BIO_get_callback_arg(bio);
3452         if (out == NULL) return(ret);
3453
3454         if (cmd == (BIO_CB_READ|BIO_CB_RETURN))
3455         {
3456                 BIO_printf(out,"read from %p [%p] (%d bytes => %ld (0x%lX))\n",
3457                            (void *)bio,argp,argi,ret,ret);
3458                 BIO_dump(out,argp,(int)ret);
3459                 return(ret);
3460         }
3461         else if (cmd == (BIO_CB_WRITE|BIO_CB_RETURN))
3462         {
3463                 BIO_printf(out,"write to %p [%p] (%d bytes => %ld (0x%lX))\n",
3464                            (void *)bio,argp,argi,ret,ret);
3465                 BIO_dump(out,argp,(int)ret);
3466         }
3467         return(ret);
3468 }
3469 #endif
3470
3471 static Lisp_Object
3472 ossl_ssl_prepare_cmeth(Lisp_Object method)
3473 {
3474         SSL_METHOD *meth = NULL;
3475         Lisp_SSL_CONN *lisp_ssl_conn;
3476
3477         /* start preparing the conn object */
3478         SSL_library_init();
3479         SSL_load_error_strings();
3480
3481         if (0);
3482         else if (EQ(method, Qssl2))
3483                 meth = (SSL_METHOD *)SSLv2_client_method();
3484         else if (EQ(method, Qssl3))
3485                 meth = (SSL_METHOD *)SSLv3_client_method();
3486         else if (EQ(method, Qssl23))
3487                 meth = (SSL_METHOD *)SSLv23_client_method();
3488         else if (EQ(method, Qtls1))
3489                 meth = (SSL_METHOD *)TLSv1_client_method();
3490         else
3491                 meth = (SSL_METHOD *)TLSv1_client_method();
3492
3493         if (!RAND_status())
3494                 error("OSSL: not enough random data");
3495
3496         /* now allocate this stuff, pump it and return */
3497         lisp_ssl_conn = allocate_ssl_conn();
3498         lisp_ssl_conn->ssl_meth = meth;
3499         lisp_ssl_conn->ssl_ctx = NULL;
3500         lisp_ssl_conn->ssl_conn = NULL;
3501         lisp_ssl_conn->ssl_bio = NULL;
3502
3503         return make_ssl_conn(lisp_ssl_conn);
3504 }
3505
3506 static Lisp_Object
3507 ossl_ssl_prepare_smeth(Lisp_Object method)
3508 {
3509         SSL_METHOD *meth = NULL;
3510         Lisp_SSL_CONN *lisp_ssl_conn;
3511
3512         /* start preparing the conn object */
3513         SSL_library_init();
3514         SSL_load_error_strings();
3515
3516         if (0);
3517         else if (EQ(method, Qssl2))
3518                 meth = (SSL_METHOD *)SSLv2_server_method();
3519         else if (EQ(method, Qssl3))
3520                 meth = (SSL_METHOD *)SSLv3_server_method();
3521         else if (EQ(method, Qssl23))
3522                 meth = (SSL_METHOD *)SSLv23_server_method();
3523         else if (EQ(method, Qtls1))
3524                 meth = (SSL_METHOD *)TLSv1_server_method();
3525         else
3526                 meth = (SSL_METHOD *)SSLv23_server_method();
3527
3528         if (!RAND_status())
3529                 error("OSSL: not enough random data");
3530
3531         /* now allocate this stuff, pump it and return */
3532         lisp_ssl_conn = allocate_ssl_conn();
3533         lisp_ssl_conn->ssl_meth = meth;
3534         lisp_ssl_conn->ssl_ctx = NULL;
3535         lisp_ssl_conn->ssl_conn = NULL;
3536         lisp_ssl_conn->ssl_bio = NULL;
3537
3538         return make_ssl_conn(lisp_ssl_conn);
3539 }
3540
3541 static Lisp_Object
3542 ossl_ssl_prepare_ctx(Lisp_Object ssl_conn)
3543 {
3544         /* SSL connection stuff */
3545         SSL_CTX *ctx = NULL;
3546         Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3547
3548         ctx = SSL_CTX_new(lisp_ssl_conn->ssl_meth);
3549         if (ctx == NULL)
3550                 error("OSSL: context initialisation failed");
3551
3552         /* OpenSSL contains code to work-around lots of bugs and flaws in
3553          * various SSL-implementations. SSL_CTX_set_options() is used to enabled
3554          * those work-arounds. The man page for this option states that
3555          * SSL_OP_ALL enables all the work-arounds and that "It is usually safe
3556          * to use SSL_OP_ALL to enable the bug workaround options if
3557          * compatibility with somewhat broken implementations is desired."
3558          */
3559         SSL_CTX_set_options(ctx, SSL_OP_ALL);
3560
3561         lisp_ssl_conn->ssl_ctx = ctx;
3562
3563         return ssl_conn;
3564 }
3565
3566 static Lisp_Object
3567 ossl_ssl_prepare(Lisp_Object ssl_conn, void(*fun)(SSL*))
3568 {
3569         /* SSL connection stuff */
3570         SSL *conn = NULL;
3571         BIO *bio = NULL;
3572 #ifdef OSSL_DEBUG_FLAG
3573         BIO *bio_c_out = NULL;
3574 #endif
3575         Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3576
3577         /* now initialise a new connection context */
3578         conn = SSL_new(lisp_ssl_conn->ssl_ctx);
3579         if (conn == NULL || fun == NULL)
3580                 error("OSSL: connection initialisation failed");
3581
3582         /* always renegotiate */
3583         SSL_set_mode(conn, SSL_MODE_AUTO_RETRY);
3584
3585         /* initialise the main connection BIO */
3586         bio = BIO_new(BIO_s_socket());
3587
3588 #ifdef OSSL_DEBUG_FLAG
3589         /* this is a debug BIO which pukes tons of stuff to stderr */
3590         bio_c_out = BIO_new_fp(stderr, BIO_NOCLOSE);
3591         BIO_set_callback(bio, ossl_bio_dump_callback);
3592         BIO_set_callback_arg(bio, bio_c_out);
3593 #endif
3594
3595         /* connect SSL with the bio */
3596         SSL_set_bio(conn, bio, bio);
3597         /* turn into client or server */
3598         fun(conn);
3599
3600         /* now allocate this stuff, pump it and return */
3601         lisp_ssl_conn->ssl_conn = conn;
3602         lisp_ssl_conn->ssl_bio = bio;
3603
3604         /* create lstream handles */
3605         init_ssl_io_handles(lisp_ssl_conn, STREAM_NETWORK_CONNECTION);
3606
3607         return ssl_conn;
3608 }
3609
3610 /* Injection of CA certificates */
3611 int ossl_ssl_inject_ca(Lisp_Object ssl_conn, Lisp_Object cacert)
3612 {
3613         SSL_CTX *ctx;
3614         EVP_PKEY *cert;
3615         X509 *xc509;
3616
3617         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3618         cert = XEVPPKEY(cacert)->evp_pkey;
3619         xc509 = XEVPPKEY(cacert)->x509;
3620
3621         if (cert && !xc509) {
3622                 xc509 = X509_new();
3623                 X509_set_pubkey(xc509, cert);
3624                 XEVPPKEY(cacert)->x509 = xc509;
3625         } else if (xc509);
3626         else
3627                 return 0;
3628
3629         /* what about coding system issues? */
3630         if (!SSL_CTX_add_client_CA(ctx, xc509))
3631                 return 0;
3632         else
3633                 return -1;
3634 }
3635
3636 int ossl_ssl_inject_ca_file(Lisp_Object ssl_conn, Lisp_Object cafile)
3637 {
3638         SSL_CTX *ctx;
3639
3640         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3641
3642         /* what about coding system issues? */
3643         if (!SSL_CTX_load_verify_locations(
3644                     ctx, (char*)XSTRING_DATA(cafile), NULL))
3645                 return 0;
3646         else
3647                 return -1;
3648 }
3649
3650 int ossl_ssl_inject_ca_path(Lisp_Object ssl_conn, Lisp_Object capath)
3651 {
3652         SSL_CTX *ctx;
3653
3654         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3655
3656         /* what about coding system issues? */
3657         if (!SSL_CTX_load_verify_locations(
3658                     ctx, NULL, (char*)XSTRING_DATA(capath)))
3659                 return 0;
3660         else
3661                 return -1;
3662 }
3663
3664 int ossl_ssl_inject_cert(Lisp_Object ssl_conn,
3665                          Lisp_Object cert, Lisp_Object key)
3666 {
3667         SSL_CTX *ctx;
3668         EVP_PKEY *pkey;
3669         EVP_PKEY *xcert;
3670         X509 *xc509;
3671
3672         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3673         pkey = XEVPPKEY(key)->evp_pkey;
3674         xcert = XEVPPKEY(cert)->evp_pkey;
3675         xc509 = XEVPPKEY(cert)->x509;
3676
3677         if (xcert && !xc509) {
3678                 xc509 = X509_new();
3679                 X509_set_pubkey(xc509, xcert);
3680                 XEVPPKEY(cert)->x509 = xc509;
3681         } else if (xc509);
3682         else
3683                 return 0;
3684
3685         if (SSL_CTX_use_certificate(ctx, xc509) <= 0)
3686                 return 0;
3687
3688         if (SSL_CTX_use_PrivateKey(ctx, pkey) <= 0)
3689                 return 0;
3690         if (!SSL_CTX_check_private_key(ctx))
3691                 return 0;
3692
3693         return -1;
3694 }
3695
3696 int ossl_ssl_inject_cert_file(Lisp_Object ssl_conn,
3697                               Lisp_Object cert, Lisp_Object key)
3698 {
3699         SSL_CTX *ctx;
3700
3701         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3702
3703         if (SSL_CTX_use_certificate_file(
3704                     ctx, (char*)XSTRING_DATA(cert), SSL_FILETYPE_PEM) <= 0)
3705                 return 0;
3706         if (SSL_CTX_use_PrivateKey_file(
3707                     ctx, (char*)XSTRING_DATA(key), SSL_FILETYPE_PEM) <= 0)
3708                 return 0;
3709         if (!SSL_CTX_check_private_key(ctx))
3710                 return 0;
3711
3712         return -1;
3713 }
3714
3715 Lisp_Object ossl_ssl_handshake(Lisp_Object ssl_conn, Lisp_Object process)
3716 {
3717         /* This function can GC */
3718         /* SSL connection stuff */
3719         SSL *conn = NULL;
3720         BIO *bio = NULL;
3721 #if 0 && defined(OSSL_DEBUG_FLAG)
3722         BIO *bio_c_out = NULL;
3723 #endif
3724         int ret, err, infd, outfd;
3725
3726         struct gcpro gcpro1, gcpro2;
3727
3728         /* Make sure we have a process, the alive check should be done in the
3729            function calling this here */
3730         CHECK_PROCESS(process);
3731
3732         GCPRO2(ssl_conn, process);
3733
3734         /* set the alternate one */
3735         event_stream_unselect_process(XPROCESS(process));
3736
3737 #ifdef HAVE_MULE
3738         /* just announce that we are very binary */
3739         Fset_process_coding_system(process, Qbinary, Qbinary);
3740 #endif
3741
3742         /* initialise the process' buffer for type-specific data,
3743          * we will store process input there */
3744         XPROCESS(process)->process_type_data = Qnil;
3745
3746         /* retrieve the sockets of the process */
3747         infd = get_process_infd(XPROCESS(process));
3748         outfd = get_process_outfd(XPROCESS(process));
3749
3750         /* push data to ssl_conn */
3751         XSSLCONN(ssl_conn)->parent = process;
3752         XSSLCONN(ssl_conn)->infd = infd;
3753         XSSLCONN(ssl_conn)->outfd = outfd;
3754
3755         /* frob vars from ssl_conn */
3756         conn = XSSLCONN(ssl_conn)->ssl_conn;
3757         bio = XSSLCONN(ssl_conn)->ssl_bio;
3758
3759         /* initialise the main connection BIO */
3760         BIO_set_fd(bio, infd, 0);
3761
3762         /* now perform the actual handshake
3763          * this is a loop because of the genuine openssl concept to not handle
3764          * non-blocking I/O correctly */
3765         for (;;) {
3766                 struct timeval to;
3767
3768                 ret = SSL_do_handshake(conn);
3769                 err = SSL_get_error(conn, ret);
3770
3771                 /* perform select() with timeout
3772                  * 1 second at the moment */
3773                 to.tv_sec = 1;
3774                 to.tv_usec = 0;
3775
3776                 if (err == SSL_ERROR_NONE) {
3777                         break;
3778                 } else if (err == SSL_ERROR_WANT_READ) {
3779                         fd_set read_fds;
3780                         OSSL_DEBUG("WANT_READ\n");
3781
3782                         FD_ZERO(&read_fds);
3783                         FD_SET(infd, &read_fds);
3784
3785                         /* wait for socket to be readable */
3786                         if (!(ret = select(infd+1, &read_fds, 0, NULL, &to))) {
3787                                 UNGCPRO;
3788                                 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3789                                 error("timeout during handshake");
3790                                 return Qnil;
3791                         }
3792                 } else if (err == SSL_ERROR_WANT_WRITE) {
3793                         fd_set write_fds;
3794                         OSSL_DEBUG("WANT_WRITE\n");
3795                         FD_ZERO(&write_fds);
3796                         FD_SET(outfd, &write_fds);
3797
3798                         /* wait for socket to be writable */
3799                         if (!(ret = select(infd+1, &write_fds, 0, NULL, &to))) {
3800                                 UNGCPRO;
3801                                 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3802                                 error("timeout during handshake");
3803                                 return Qnil;
3804                         }
3805                 } else if (err == SSL_ERROR_SSL) {
3806                         /* close down the process object */
3807                         Fdelete_process(process);
3808
3809                         UNGCPRO;
3810                         finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3811                         error("handshake failed");
3812                         return Qnil;
3813                 } else {
3814                         OSSL_CRITICAL("\nUnknown error: %d\n"
3815                                       "Please report: "
3816                                       "sxemacs-devel@sxemacs.org\n\n", err);
3817
3818 #if 0
3819                         /* we used to check whether the connection is
3820                            still alive, but this was perhaps a bad idea */
3821                         try = BIO_read(bio, buf, 2);
3822                         if ((try == 0) ||
3823                             (try < 0 && !BIO_should_retry(bio))) {
3824                                 /* Handle closed connection */
3825                                 XPROCESS(process)->exit_code = 256;
3826                                 XPROCESS(process)->status_symbol = Qexit;
3827                         }
3828 #else
3829                         /* close down the process object */
3830                         Fdelete_process(process);
3831 #endif
3832
3833                         UNGCPRO;
3834                         finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3835                         error("unknown handshake error");
3836                         return Qnil;
3837                 }
3838         }
3839
3840         /* marry the socket layer now */
3841         ossl_ssl_proselytise_process(ssl_conn, process);
3842
3843         /* declare the whole pig connected */
3844         XSSLCONN(ssl_conn)->connected_p = 1;
3845
3846         event_stream_select_process(XPROCESS(process));
3847
3848         UNGCPRO;
3849         return ssl_conn;
3850 }
3851
3852 DEFUN("ossl-ssl-inject-cert", Fossl_ssl_inject_cert, 2, 3, 0, /*
3853 Add CERT as the local certificate of SSL-CONN.
3854 Optional argument KEY specifies a key file or evp-pkey, if
3855 CERT does not contain it.
3856
3857 Both, CERT and KEY may be either a filename pointing to a
3858 PEM-encoded certificate and key respectively, or may be an
3859 evp-pkey object.
3860 */
3861       (ssl_conn, cert, key))
3862 {
3863         /* This function can GC */
3864         int (*fun)(Lisp_Object, Lisp_Object, Lisp_Object) = NULL;
3865         struct gcpro gcpro1, gcpro2, gcpro3;
3866
3867         GCPRO3(ssl_conn, cert, key);
3868
3869         CHECK_SSLCONN(ssl_conn);
3870         if (!NILP(cert))
3871                 if (!STRINGP(cert))
3872                         CHECK_EVPPKEY(cert);
3873         if (!NILP(key))
3874                 if (!STRINGP(key))
3875                         CHECK_EVPPKEY(key);
3876
3877         /* certificate and key preparation */
3878         if (STRINGP(cert)) {
3879                 cert = Fexpand_file_name(cert, Qnil);
3880                 if (NILP(Ffile_readable_p(cert)))
3881                         cert = Qnil;
3882         }
3883
3884         if (STRINGP(key)) {
3885                 key = Fexpand_file_name(key, Qnil);
3886                 if (NILP(Ffile_readable_p(key)))
3887                         key = Qnil;
3888         }
3889
3890         if (STRINGP(cert) && NILP(key))
3891                 key = cert;
3892         else if (EVPPKEYP(cert) && NILP(key))
3893                 key = cert;
3894
3895         /* certificate and key injection */
3896         if (!NILP(cert) && !NILP(key) &&
3897             STRINGP(cert) && STRINGP(key))
3898                 fun = ossl_ssl_inject_cert_file;
3899         else if (!NILP(cert) && !NILP(key) &&
3900                  EVPPKEYP(cert) && EVPPKEYP(key))
3901                 fun = ossl_ssl_inject_cert;
3902
3903         if (fun && fun(ssl_conn, cert, key)) {
3904                 UNGCPRO;
3905                 return Qt;
3906         } else {
3907                 UNGCPRO;
3908                 return Qnil;
3909         }
3910 }
3911
3912 DEFUN("ossl-ssl-inject-ca", Fossl_ssl_inject_ca, 2, 2, 0, /*
3913 Add CA to the pile of certificate authorities of SSL-CONN.
3914 Also force a \(re\)verification of the remote peer certificate
3915 against CA.  Return `t' if the injection was successful,
3916 `nil' otherwise.
3917
3918 CA may be either a file name pointing to a PEM-encoded
3919 CA certificate, or may be a directory containing a valid
3920 bunch of CA certificates according to OpenSSL's CA path
3921 layout, or may also be an evp-pkey object.
3922 */
3923       (ssl_conn, ca))
3924 {
3925         /* This function can GC */
3926         int (*fun)(Lisp_Object, Lisp_Object) = NULL;
3927         SSL *conn = NULL;
3928         struct gcpro gcpro1, gcpro2;
3929
3930         GCPRO2(ssl_conn, ca);
3931
3932         CHECK_SSLCONN(ssl_conn);
3933         if (!NILP(ca))
3934                 if (!STRINGP(ca))
3935                         CHECK_EVPPKEY(ca);
3936
3937         if (STRINGP(ca)) {
3938                 ca = Fexpand_file_name(ca, Qnil);
3939                 if (NILP(Ffile_readable_p(ca)))
3940                         ca = Qnil;
3941         }
3942
3943         if (!NILP(ca) && STRINGP(ca)) {
3944                 if (NILP(Ffile_directory_p(ca)))
3945                         fun = ossl_ssl_inject_ca_file;
3946                 else
3947                         fun = ossl_ssl_inject_ca_path;
3948         } else if (!NILP(ca) && EVPPKEYP(ca))
3949                 fun = ossl_ssl_inject_ca;
3950
3951         if (fun && fun(ssl_conn, ca) &&
3952             (conn = XSSLCONN(ssl_conn)->ssl_conn)) {
3953                 ssl_verify_cert_chain(conn, SSL_get_peer_cert_chain(conn));
3954                 UNGCPRO;
3955                 return Qt;
3956         }
3957
3958         UNGCPRO;
3959         return Qnil;
3960 }
3961
3962 DEFUN("ossl-ssl-handshake", Fossl_ssl_handshake, 1, 6, 0, /*
3963 Perform a handshake on the network connection PROCESS.
3964
3965 Return a ssl-conn object, or `nil' if the handshake failed.
3966 In the latter case, most likely the remote site cannot handle
3967 the specified method, requires a client certificate, or cannot
3968 handle ssl at all.
3969
3970 Optional argument METHOD indicates the SSL connection method,
3971 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
3972
3973 Optional argument CA indicates a CA certificate.
3974 See `ossl-ssl-inject-ca'.
3975
3976 Optional arguments CERT and KEY indicate a peer certificate
3977 and possibly a separate key file respectively.
3978 See `ossl-ssl-inject-peer-cert'.
3979
3980 Optional argument SERVERP indicates whether to perform the
3981 handshake as a server if non-nil, and as a client otherwise.
3982 Note: In case of a handshake as server it is mandatory to provide
3983 a valid certificate and a corresponding key.
3984 */
3985       (process, method, ca, cert, key, serverp))
3986 {
3987         /* This function can GC */
3988         /* the result(s) */
3989         Lisp_Object ssl_conn, result;
3990
3991         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
3992
3993         GCPRO6(process, method, ca, cert, key, serverp);
3994
3995         /* Make sure the process is really alive.  */
3996         CHECK_PROCESS(process);
3997         OSSL_CHECK_PROCESS(process);
3998
3999         /* create a ssl_conn object first */
4000         if (NILP(serverp))
4001                 ssl_conn = ossl_ssl_prepare_cmeth(method);
4002         else
4003                 ssl_conn = ossl_ssl_prepare_smeth(method);
4004
4005         /* create the context */
4006         ossl_ssl_prepare_ctx(ssl_conn);
4007
4008         /* certificate and key preparation */
4009         Fossl_ssl_inject_cert(ssl_conn, cert, key);
4010         /* certificate authority preparation */
4011         Fossl_ssl_inject_ca(ssl_conn, ca);
4012
4013         /* prepare for handshake */
4014         if (NILP(serverp))
4015                 ossl_ssl_prepare(ssl_conn, SSL_set_connect_state);
4016         else
4017                 ossl_ssl_prepare(ssl_conn, SSL_set_accept_state);
4018
4019         result = ossl_ssl_handshake(ssl_conn, process);
4020
4021         UNGCPRO;
4022         return result;
4023 }
4024
4025 DEFUN("ossl-ssl-connect", Fossl_ssl_connect, 0, MANY, 0, /*
4026 Perform a TLS or SSL handshake, return a ssl-conn object on
4027 success, or `nil' if the handshake failed.
4028 In the latter case, most likely the remote site cannot handle
4029 the specified method, requires a client certificate, or cannot
4030 handle ssl at all.
4031
4032 :process
4033 :method
4034 :cafile
4035 :capath
4036 :key
4037 :cert
4038
4039  PROCESS.
4040 Optional argument METHOD indicates the SSL connection method,
4041 it can be one of `tls1' \(default\), `ssl23', `ssl2', or `ssl3'.
4042 */
4043       (int nargs, Lisp_Object *args))
4044 {
4045         int i;
4046
4047         for (i = 0; i < nargs; i++);
4048
4049         return Qnil;
4050 }
4051
4052 static void
4053 ossl_swap_process_streams(Lisp_SSL_CONN *s, Lisp_Process *p)
4054 {
4055         Lisp_Object in, out;
4056
4057         in = p->pipe_instream;
4058         out = p->pipe_outstream;
4059
4060         p->pipe_instream = s->pipe_instream;
4061         p->pipe_outstream = s->pipe_outstream;
4062
4063         s->pipe_instream = in;
4064         s->pipe_outstream = out;
4065
4066 #ifdef FILE_CODING
4067         in = p->coding_instream;
4068         out = p->coding_outstream;
4069
4070         p->coding_instream = s->coding_instream;
4071         p->coding_outstream = s->coding_outstream;
4072
4073         s->coding_instream = in;
4074         s->coding_outstream = out;
4075 #endif
4076 }
4077
4078 static int
4079 ossl_ssl_proselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4080 {
4081         Lisp_Process *p = XPROCESS(process);
4082         Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4083
4084         event_stream_unselect_process(p);
4085
4086         /* put the streams we have in the ssl-conn object into the process
4087            object; actually these swap their places */
4088         if (p->process_type != PROCESS_TYPE_SSL)
4089                 ossl_swap_process_streams(s, p);
4090
4091         /* somehow we gotta link the network-process with the ss-layer
4092          * otherwise it'd be easy to open a network stream then
4093          * a ss-layer on top of it and then via `delete-process'
4094          * all the work is void while the ss-layer still exists
4095          */
4096         p->process_type = PROCESS_TYPE_SSL;
4097         p->process_type_data = ssl_conn;
4098
4099         event_stream_select_process(p);
4100
4101         return 0;
4102 }
4103
4104 static int
4105 ossl_ssl_unproselytise_process(Lisp_Object ssl_conn, Lisp_Object process)
4106 {
4107         Lisp_Process *p = XPROCESS(process);
4108         Lisp_SSL_CONN *s = XSSLCONN(ssl_conn);
4109
4110         /* put the streams we have in the ssl-conn object into the process
4111            object (they should be the former process streams) */
4112         if (p->process_type == PROCESS_TYPE_SSL)
4113                 ossl_swap_process_streams(s, p);
4114
4115         /* somehow we gotta link the network-process with the ss-layer
4116          * otherwise it'd be easy to open a network stream then
4117          * a ss-layer on top of it and then via `delete-process'
4118          * all the work is void while the ss-layer still exists
4119          */
4120         XPROCESS(process)->process_type = PROCESS_TYPE_NETWORK;
4121         XPROCESS(process)->process_type_data = Qnil;
4122
4123         return 0;
4124 }
4125
4126 DEFUN("ossl-ssl-proselytise-process", Fossl_ssl_proselytise_process,
4127       1, 1, 0, /*
4128 Convert the underlying process of SSL-CONN into a secure
4129 network connection object.
4130 */
4131       (ssl_conn))
4132 {
4133         Lisp_Object process;
4134
4135         CHECK_SSLCONN(ssl_conn);
4136
4137         process = XSSLCONN(ssl_conn)->parent;
4138         if (!PROCESSP(process)) {
4139                 error("no process associated with this connection");
4140                 return Qnil;
4141         }
4142
4143         /* Make sure the process is really alive.  */
4144         OSSL_CHECK_PROCESS(process);
4145
4146         ossl_ssl_proselytise_process(ssl_conn, process);
4147
4148         return process;
4149 }
4150
4151 DEFUN("ossl-ssl-unproselytise-process", Fossl_ssl_unproselytise_process,
4152       1, 1, 0, /*
4153 Convert the underlying process of SSL-CONN into an ordinary
4154 network connection object.
4155 */
4156       (ssl_conn))
4157 {
4158         Lisp_Object process;
4159
4160         CHECK_SSLCONN(ssl_conn);
4161
4162         process = XSSLCONN(ssl_conn)->parent;
4163         if (!PROCESSP(process)) {
4164                 error("no process associated with this connection");
4165                 return Qnil;
4166         }
4167
4168         /* Make sure the process is really alive.  */
4169         OSSL_CHECK_PROCESS(process);
4170
4171         /* Castrate the process and make it a network process again */
4172         ossl_ssl_unproselytise_process(ssl_conn, process);
4173
4174         return process;
4175 }
4176
4177 DEFUN("ossl-ssl-finish", Fossl_ssl_finish, 1, 1, 0, /*
4178 Finish an SSL connection SSL-CONN.
4179
4180 Note: This may also finish the network connection.
4181 */
4182       (ssl_conn))
4183 {
4184         Lisp_Object process;
4185
4186         CHECK_SSLCONN(ssl_conn);
4187
4188         if (XSSLCONN(ssl_conn)->protected_p)
4189                 error ("Cannot finish protected SSL connection");
4190
4191         process = XSSLCONN(ssl_conn)->parent;
4192         if (PROCESSP(process))
4193                 ossl_ssl_unproselytise_process(ssl_conn, process);
4194
4195         finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
4196         return ssl_conn;
4197 }
4198
4199 DEFUN("ossl-ssl-read", Fossl_ssl_read, 2, 2, 0, /*
4200 Return the cleartext of STRING which is assumed to be a complete
4201 block of data sent through SSL-CONN.
4202 */
4203       (ssl_conn, string))
4204 {
4205         /* network stream stuff */
4206         SSL *conn;
4207         Lisp_Object process;
4208         /* the result */
4209         Lisp_Object result = Qnil;
4210
4211         CHECK_SSLCONN(ssl_conn);
4212         CHECK_STRING(string);
4213
4214         if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4215                 error("SSL connection dead");
4216
4217         conn = XSSLCONN(ssl_conn)->ssl_conn;
4218         process = XSSLCONN(ssl_conn)->parent;
4219
4220         /* Make sure the process is really alive.  */
4221         OSSL_CHECK_PROCESS(process);
4222
4223         return result;
4224 }
4225
4226 DEFUN("ossl-ssl-write", Fossl_ssl_write, 2, 2, 0, /*
4227 Send STRING to the tunnel SSL-CONN.
4228 */
4229       (ssl_conn, string))
4230 {
4231         /* network stream stuff */
4232         SSL *conn;
4233         Lisp_Object process, proc_filter;
4234         Lstream *out;
4235         /* aux */
4236         int ret;
4237
4238         CHECK_SSLCONN(ssl_conn);
4239         CHECK_STRING(string);
4240
4241         if (!ssl_conn_alive_p(XSSLCONN(ssl_conn)))
4242                 error("SSL connection dead");
4243
4244         conn = XSSLCONN(ssl_conn)->ssl_conn;
4245         process = XSSLCONN(ssl_conn)->parent;
4246
4247         /* Make sure the process is really alive.  */
4248         OSSL_CHECK_PROCESS(process);
4249
4250         switch (XPROCESS(process)->process_type) {
4251         case PROCESS_TYPE_NETWORK:
4252                 /* ssl streams reside in ssl-conn object atm */
4253                 out = XLSTREAM(DATA_OUTSTREAM(XSSLCONN(ssl_conn)));
4254                 break;
4255         case PROCESS_TYPE_SSL:
4256                 /* ssl streams reside in process object, snarf from there */
4257                 out = XLSTREAM(DATA_OUTSTREAM(XPROCESS(process)));
4258                 break;
4259         default:
4260                 out = NULL;
4261                 error("unable to write");
4262         }
4263
4264         /* store the original process filter */
4265         proc_filter = XPROCESS(process)->filter;
4266
4267         ret = Lstream_write(out, XSTRING_DATA(string), XSTRING_LENGTH(string));
4268         Lstream_flush(out);
4269
4270         switch (SSL_get_error(conn, ret)) {
4271         case SSL_ERROR_NONE:
4272                 break;
4273         case SSL_ERROR_WANT_WRITE:
4274                 error("Connection wants write");
4275         case SSL_ERROR_WANT_READ:
4276                 error("Connection wants read");
4277         default:
4278                 error("Severe SSL connection error");
4279         }
4280
4281         /* restore the original process filter */
4282         return (SSL_pending(conn) == 0) ? Qt : Qnil;
4283 }
4284
4285 /* convenience functions */
4286 DEFUN("ossl-ssl-parent", Fossl_ssl_parent, 1, 1, 0, /*
4287 Return the underlying parent layer of SSL-CONN.
4288 */
4289       (ssl_conn))
4290 {
4291         CHECK_SSLCONN(ssl_conn);
4292
4293         return XSSLCONN(ssl_conn)->parent;
4294 }
4295
4296 DEFUN("ossl-ssl-cert", Fossl_ssl_cert, 1, 1, 0, /*
4297 Return the local peer's certificate of SSL-CONN if present,
4298 `nil' otherwise.
4299 */
4300       (ssl_conn))
4301 {
4302         /* SSL connection stuff */
4303         SSL *conn = NULL;
4304         X509 *cert = NULL;
4305
4306         CHECK_SSLCONN(ssl_conn);
4307
4308         conn = XSSLCONN(ssl_conn)->ssl_conn;
4309         cert = SSL_get_certificate(conn);
4310
4311         if (cert)
4312                 return make_evp_pkey_x509(cert);
4313         else
4314                 return Qnil;
4315 }
4316
4317 DEFUN("ossl-ssl-peer-cert", Fossl_ssl_peer_cert, 1, 1, 0, /*
4318 Return the remote peer's certificate of SSL-CONN if present,
4319 `nil' otherwise.
4320 */
4321       (ssl_conn))
4322 {
4323         /* SSL connection stuff */
4324         SSL *conn = NULL;
4325         X509 *cert = NULL;
4326
4327         CHECK_SSLCONN(ssl_conn);
4328
4329         conn = XSSLCONN(ssl_conn)->ssl_conn;
4330         cert = SSL_get_peer_certificate(conn);
4331
4332         if (cert)
4333                 return make_evp_pkey_x509(cert);
4334         else
4335                 return Qnil;
4336 }
4337
4338 DEFUN("ossl-ssl-peer-cert-chain", Fossl_ssl_peer_cert_chain, 1, 1, 0, /*
4339 Return the certificate chain of SSL-CONN as a list of
4340 evp-pkey objects.
4341 */
4342       (ssl_conn))
4343 {
4344         int i;
4345         /* SSL connection stuff */
4346         SSL *conn = NULL;
4347         STACK_OF(X509) *sk;
4348         /* result cruft */
4349         Lisp_Object result = Qnil;
4350
4351         CHECK_SSLCONN(ssl_conn);
4352
4353         conn = XSSLCONN(ssl_conn)->ssl_conn;
4354         sk = SSL_get_peer_cert_chain(conn);
4355
4356         if (sk == NULL)
4357                 return result;
4358
4359         for (i=0; i<sk_X509_num(sk); i++) {
4360                 X509 *cert = sk_X509_value(sk, i);
4361
4362                 result = Fcons(make_evp_pkey_x509(cert), result);
4363         }
4364
4365         return result;
4366 }
4367
4368 #if 0
4369 DEFUN("ossl-ssl-cert-store", Fossl_ssl_cert_store, 1, 1, 0, /*
4370 Return the X509 cert store of SSL-CONN.
4371 */
4372       (ssl_conn))
4373 {
4374         X509_STORE *sto = NULL;
4375
4376         return Qnil;
4377 }
4378 #endif
4379
4380 #if 0                           /* just thoughts */
4381 int     SSL_get_verify_mode(const SSL *s);
4382 int     SSL_get_verify_depth(const SSL *s);
4383 #endif
4384
4385 DEFUN("ossl-ssl-verify-certificate", Fossl_ssl_verify_certificate,
4386       1, 1, 0, /*
4387 Return a verify code of SSL-CONN.
4388
4389 The result is a cons cell with the numeric verify code in
4390 the car and a verbose string in the cdr.
4391 */
4392       (ssl_conn))
4393 {
4394         int vrc;
4395         /* SSL connection stuff */
4396         SSL *conn = NULL;
4397         /* result cruft */
4398         Lisp_Object result = Qnil;
4399
4400         CHECK_SSLCONN(ssl_conn);
4401
4402         conn = XSSLCONN(ssl_conn)->ssl_conn;    
4403         vrc = SSL_get_verify_result(conn);
4404
4405         result = Fcons(
4406                 make_int(vrc),
4407                 build_string(X509_verify_cert_error_string(vrc)));
4408
4409         return result;
4410 }
4411
4412 DEFUN("ossl-ssl-cipher-version", Fossl_ssl_cipher_version, 1, 1, 0, /*
4413 Return the protocol version of the tunnel SSL-CONN.
4414 */
4415       (ssl_conn))
4416 {
4417         /* SSL connection stuff */
4418         SSL *conn=NULL;
4419         const SSL_CIPHER *ciph;
4420         /* network stream stuff */
4421         Lisp_SSL_CONN *lisp_ssl_conn;
4422
4423         CHECK_SSLCONN(ssl_conn);
4424         lisp_ssl_conn = XSSLCONN(ssl_conn);
4425
4426         conn = lisp_ssl_conn->ssl_conn;
4427         if (conn == NULL)
4428                 return Qnil;
4429
4430         ciph = SSL_get_current_cipher(conn);
4431
4432         if (!(ciph == NULL))
4433                 return Fmake_symbol(
4434                         build_string(SSL_CIPHER_get_version(ciph)));
4435         else
4436                 return Qnil;
4437 }
4438
4439 DEFUN("ossl-ssl-cipher-name", Fossl_ssl_cipher_name, 1, 1, 0, /*
4440 Return the name of the current cipher used in the tunnel SSL-CONN.
4441 */
4442       (ssl_conn))
4443 {
4444         /* SSL connection stuff */
4445         SSL *conn=NULL;
4446         const SSL_CIPHER *ciph;
4447         /* network stream stuff */
4448         Lisp_SSL_CONN *lisp_ssl_conn;
4449
4450         CHECK_SSLCONN(ssl_conn);
4451         lisp_ssl_conn = XSSLCONN(ssl_conn);
4452
4453         conn = lisp_ssl_conn->ssl_conn;
4454         if (conn == NULL)
4455                 return Qnil;
4456
4457         ciph = SSL_get_current_cipher(conn);
4458
4459         if (!(ciph == NULL))
4460                 return intern(SSL_CIPHER_get_name(ciph));
4461         else
4462                 return Qnil;
4463 }
4464
4465 DEFUN("ossl-ssl-cipher-names", Fossl_ssl_cipher_names, 1, 1, 0, /*
4466 Return the names of all supported ciphers in the tunnel SSL-CONN.
4467 */
4468       (ssl_conn))
4469 {
4470         int i;
4471         /* SSL connection stuff */
4472         SSL *conn=NULL;
4473         STACK_OF(SSL_CIPHER) *ciphs;
4474         Lisp_Object result = Qnil;
4475
4476         CHECK_SSLCONN(ssl_conn);
4477
4478         conn = XSSLCONN(ssl_conn)->ssl_conn;
4479         if (conn == NULL)
4480                 return Qnil;
4481
4482         ciphs = SSL_get_ciphers(conn);
4483
4484         for (i=sk_SSL_CIPHER_num(ciphs)-1; i>=0; i--) {
4485                 SSL_CIPHER *ciph = sk_SSL_CIPHER_value(ciphs, i);
4486
4487                 result = Fcons(intern(SSL_CIPHER_get_name(ciph)), result);
4488         }
4489
4490         return result;
4491 }
4492
4493 DEFUN("ossl-ssl-cipher-bits", Fossl_ssl_cipher_bits, 1, 1, 0, /*
4494 Return the number of effective bits of the current cipher in SSL-CONN.
4495 */
4496       (ssl_conn))
4497 {
4498         /* SSL connection stuff */
4499         SSL *conn=NULL;
4500         const SSL_CIPHER *ciph;
4501         int alg_bits, strength_bits;
4502         /* network stream stuff */
4503         Lisp_SSL_CONN *lisp_ssl_conn;
4504
4505         CHECK_SSLCONN(ssl_conn);
4506         lisp_ssl_conn = XSSLCONN(ssl_conn);
4507
4508         conn = lisp_ssl_conn->ssl_conn;
4509         if (conn == NULL)
4510                 return Qnil;
4511
4512         ciph = SSL_get_current_cipher(conn);
4513
4514         if (!(ciph == NULL)) {
4515                 strength_bits = SSL_CIPHER_get_bits(ciph, &alg_bits);
4516                 /* what do we want to do with alg_bits? */
4517                 return make_int(strength_bits);
4518         } else
4519                 return Qnil;
4520 }
4521
4522 DEFUN("ossl-ssl-cipher-description", Fossl_ssl_cipher_description, 1, 1, 0, /*
4523 Return a description of the current cipher used in the tunnel SSL-CONN.
4524 */
4525       (ssl_conn))
4526 {
4527         /* SSL connection stuff */
4528         SSL *conn=NULL;
4529         const SSL_CIPHER *ciph;
4530         /* network stream stuff */
4531         Lisp_SSL_CONN *lisp_ssl_conn;
4532
4533         CHECK_SSLCONN(ssl_conn);
4534         lisp_ssl_conn = XSSLCONN(ssl_conn);
4535
4536         conn = lisp_ssl_conn->ssl_conn;
4537         if (conn == NULL)
4538                 return Qnil;
4539
4540         ciph = SSL_get_current_cipher(conn);
4541
4542         if (!(ciph == NULL))
4543                 return build_string(SSL_CIPHER_description(ciph, NULL, 0));
4544         else
4545                 return Qnil;
4546 }
4547
4548
4549 /* X509 cert handling */
4550 DEFUN("ossl-x509-subject", Fossl_x509_subject, 1, 1, 0, /*
4551 Return the certificate subject of CERT (an evp-pkey object).
4552
4553 This will return a string in LDAP syntax.
4554 */
4555       (cert))
4556 {
4557         X509 *pk509;
4558
4559         CHECK_EVPPKEY(cert);
4560
4561         pk509 = XEVPPKEY(cert)->x509;
4562
4563         if (pk509) {
4564                 X509_NAME *sub = X509_get_subject_name(pk509);
4565                 return build_string(X509_NAME_oneline(sub, NULL, 0));
4566         } else
4567                 return Qnil;
4568 }
4569
4570 DEFUN("ossl-x509-issuer", Fossl_x509_issuer, 1, 1, 0, /*
4571 Return the certificate issuer of CERT (an evp-pkey object),
4572 that is the organisation which signed the certificate.
4573
4574 This will return a string in LDAP syntax.
4575 */
4576       (cert))
4577 {
4578         X509 *pk509;
4579
4580         CHECK_EVPPKEY(cert);
4581
4582         pk509 = XEVPPKEY(cert)->x509;
4583
4584         if (pk509) {
4585                 X509_NAME *iss = X509_get_issuer_name(pk509);
4586                 return build_string(X509_NAME_oneline(iss, NULL, 0));
4587         } else
4588                 return Qnil;
4589 }
4590
4591 DEFUN("ossl-x509-serial", Fossl_x509_serial, 1, 1, 0, /*
4592 Return the certificate serial of CERT (an evp-pkey object).
4593 */
4594       (cert))
4595 {
4596         X509 *pk509;
4597
4598         CHECK_EVPPKEY(cert);
4599
4600         pk509 = XEVPPKEY(cert)->x509;
4601
4602         if (pk509) {
4603                 ASN1_INTEGER *ser = X509_get_serialNumber(pk509);
4604                 return make_integer(ASN1_INTEGER_get(ser));
4605         } else
4606                 return Qnil;
4607 }
4608
4609 DEFUN("ossl-x509-not-before", Fossl_x509_not_before, 1, 1, 0, /*
4610 Return the certificate valid-not-before time of CERT.
4611 */
4612       (cert))
4613 {
4614         X509 *pk509;
4615
4616         CHECK_EVPPKEY(cert);
4617
4618         pk509 = XEVPPKEY(cert)->x509;
4619
4620         if (pk509) {
4621                 ASN1_TIME *nbf = X509_get_notBefore(pk509);
4622                 return build_string((char*)nbf->data);
4623         } else
4624                 return Qnil;
4625 }
4626
4627 DEFUN("ossl-x509-not-after", Fossl_x509_not_after, 1, 1, 0, /*
4628 Return the certificate valid-not-after time of CERT.
4629 */
4630       (cert))
4631 {
4632         X509 *pk509;
4633
4634         CHECK_EVPPKEY(cert);
4635
4636         pk509 = XEVPPKEY(cert)->x509;
4637
4638         if (pk509) {
4639                 ASN1_TIME *nbf = X509_get_notAfter(pk509);
4640                 return build_string((char*)nbf->data);
4641         } else
4642                 return Qnil;
4643 }
4644
4645 DEFUN("ossl-x509-signature-type", Fossl_x509_signature_type, 1, 1, 0, /*
4646 Return the signature type of CERT.
4647 */
4648       (cert))
4649 {
4650         X509 *pk509;
4651
4652         CHECK_EVPPKEY(cert);
4653
4654         pk509 = XEVPPKEY(cert)->x509;
4655
4656         if (pk509) {
4657                 int ty = X509_get_signature_type(pk509);
4658                 Lisp_Object result = Qnil;
4659
4660                 switch (ty) {
4661                 case EVP_PKEY_NONE:
4662                         result = intern("none");
4663                         break;
4664 #ifndef OPENSSL_NO_RSA
4665                 case EVP_PKEY_RSA:
4666                         result = intern("rsa");
4667                         break;
4668                 case EVP_PKEY_RSA2:
4669                         result = intern("rsa2");
4670                         break;
4671 #endif
4672 #ifndef OPENSSL_NO_DSA
4673                 case EVP_PKEY_DSA:
4674                         result = intern("dsa");
4675                         break;
4676                 case EVP_PKEY_DSA1:
4677                         result = intern("dsa1");
4678                         break;
4679                 case EVP_PKEY_DSA2:
4680                         result = intern("dsa2");
4681                         break;
4682                 case EVP_PKEY_DSA3:
4683                         result = intern("dsa3");
4684                         break;
4685                 case EVP_PKEY_DSA4:
4686                         result = intern("dsa4");
4687                         break;
4688 #endif
4689 #ifndef OPENSSL_NO_DH
4690                 case EVP_PKEY_DH:
4691                         result = intern("dh");
4692                         break;
4693 #endif
4694 #ifndef OPENSSL_NO_EC
4695                 case EVP_PKEY_EC:
4696                         result = intern("ec");
4697                         break;
4698 #endif
4699                 default:
4700                         result = intern("unknown");
4701                         break;
4702                 }
4703
4704                 return result;
4705         } else
4706                 return Qnil;
4707 }
4708
4709
4710
4711
4712
4713 /*
4714  *
4715  * Initialisation stuff
4716  *
4717  */
4718 void syms_of_openssl(void)
4719 {
4720         INIT_LRECORD_IMPLEMENTATION(evp_pkey);
4721         INIT_LRECORD_IMPLEMENTATION(ssl_conn);
4722
4723         defsymbol(&Qopenssl, "openssl");
4724         defsymbol(&Qevp_pkeyp, "ossl-pkey-p");
4725
4726         DEFSUBR(Fossl_version);
4727         DEFSUBR(Fossl_available_digests);
4728         DEFSUBR(Fossl_available_ciphers);
4729         DEFSUBR(Fossl_digest_size);
4730         DEFSUBR(Fossl_digest_bits);
4731         DEFSUBR(Fossl_digest_block_size);
4732         DEFSUBR(Fossl_cipher_key_length);
4733         DEFSUBR(Fossl_cipher_bits);
4734         DEFSUBR(Fossl_cipher_iv_length);
4735         DEFSUBR(Fossl_cipher_block_size);
4736         DEFSUBR(Fossl_cipher_mode);
4737
4738         DEFSUBR(Fossl_rand_bytes);
4739         DEFSUBR(Fossl_rand_bytes_egd);
4740
4741         DEFSUBR(Fossl_digest);
4742         DEFSUBR(Fossl_digest_file);
4743
4744         DEFSUBR(Fossl_hmac);
4745         DEFSUBR(Fossl_hmac_file);
4746
4747         DEFSUBR(Fossl_bytes_to_key);
4748         DEFSUBR(Fossl_encrypt);
4749         DEFSUBR(Fossl_encrypt_file);
4750         DEFSUBR(Fossl_decrypt);
4751         DEFSUBR(Fossl_decrypt_file);
4752
4753         /* general pkey */
4754         DEFSUBR(Fossl_pkey_p);
4755         DEFSUBR(Fossl_pkey_size);
4756         DEFSUBR(Fossl_pkey_private_p);
4757         DEFSUBR(Fossl_pkey_get_public);
4758
4759 #ifndef OPENSSL_NO_RSA
4760         /* RSA */
4761         DEFSUBR(Fossl_rsa_generate_key);
4762         DEFSUBR(Fossl_rsa_pkey_p);
4763         DEFSUBR(Fossl_rsa_subkey_p);
4764 #endif /* OPENSSL_NO_RSA */
4765 #ifndef OPENSSL_NO_DSA
4766         /* DSA */
4767         DEFSUBR(Fossl_dsa_generate_key);
4768         DEFSUBR(Fossl_dsa_pkey_p);
4769         DEFSUBR(Fossl_dsa_subkey_p);
4770 #endif /* OPENSSL_NO_DSA */
4771 #ifndef OPENSSL_NO_EC
4772         /* EC */
4773         DEFSUBR(Fossl_ec_available_curves);
4774         DEFSUBR(Fossl_ec_generate_key);
4775         DEFSUBR(Fossl_ec_pkey_p);
4776 #endif /* OPENSSL_NO_EC */
4777 #ifndef OPENSSL_NO_DH
4778         /* DH */
4779         /* DEFSUBR(Fossl_ec_generate_key); */
4780         DEFSUBR(Fossl_dh_pkey_p);
4781 #endif
4782         DEFSUBR(Fossl_seal);
4783         DEFSUBR(Fossl_open);
4784
4785         DEFSUBR(Fossl_sign);
4786         DEFSUBR(Fossl_verify);
4787
4788 /* PEM */
4789         DEFSUBR(Fossl_pem_read_public_key);
4790         DEFSUBR(Fossl_pem_read_key);
4791         DEFSUBR(Fossl_pem_write_public_key);
4792         DEFSUBR(Fossl_pem_write_key);
4793         DEFSUBR(Fossl_pem_public_key);
4794         DEFSUBR(Fossl_pem_key);
4795
4796 /* SSL */
4797         defsymbol(&Qssl_connp, "ossl-ssl-conn-p");
4798         defsymbol(&Qssl2, "ssl2");
4799         defsymbol(&Qssl23, "ssl23");
4800         defsymbol(&Qssl3, "ssl3");
4801         defsymbol(&Qtls1, "tls1");
4802 #ifdef HAVE_SOCKETS
4803         DEFSUBR(Fossl_ssl_handshake);
4804         DEFSUBR(Fossl_ssl_inject_ca);
4805         DEFSUBR(Fossl_ssl_inject_cert);
4806         DEFSUBR(Fossl_ssl_proselytise_process);
4807         DEFSUBR(Fossl_ssl_unproselytise_process);
4808         DEFSUBR(Fossl_ssl_connect);
4809         DEFSUBR(Fossl_ssl_finish);
4810         DEFSUBR(Fossl_ssl_read);
4811         DEFSUBR(Fossl_ssl_write);
4812         DEFSUBR(Fossl_ssl_parent);
4813         DEFSUBR(Fossl_ssl_cert);
4814         DEFSUBR(Fossl_ssl_peer_cert);
4815         DEFSUBR(Fossl_ssl_peer_cert_chain);
4816         DEFSUBR(Fossl_ssl_verify_certificate);
4817         DEFSUBR(Fossl_ssl_cipher_version);
4818         DEFSUBR(Fossl_ssl_cipher_name);
4819         DEFSUBR(Fossl_ssl_cipher_names);
4820         DEFSUBR(Fossl_ssl_cipher_bits);
4821         DEFSUBR(Fossl_ssl_cipher_description);
4822 #endif
4823
4824         DEFSUBR(Fossl_x509_subject);
4825         DEFSUBR(Fossl_x509_issuer);
4826         DEFSUBR(Fossl_x509_serial);
4827         DEFSUBR(Fossl_x509_not_before);
4828         DEFSUBR(Fossl_x509_not_after);
4829         DEFSUBR(Fossl_x509_signature_type);
4830 }
4831
4832 void vars_of_openssl(void)
4833 {
4834         Fprovide(Qopenssl);
4835
4836 #ifndef OPENSSL_NO_RSA
4837         Fprovide(intern("openssl-rsa"));
4838 #endif
4839 #ifndef OPENSSL_NO_DSA
4840         Fprovide(intern("openssl-dsa"));
4841 #endif
4842 #ifndef OPENSSL_NO_EC
4843         Fprovide(intern("openssl-ec"));
4844 #endif
4845 #ifndef OPENSSL_NO_DH
4846         Fprovide(intern("openssl-dh"));
4847 #endif
4848 #ifdef HAVE_SOCKETS
4849         Fprovide(intern("openssl-ssl"));
4850 #endif
4851 }