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