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