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