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