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