More eliminate silly warnings
[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 do {                                                                    \
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 do {                                                                    \
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         SXE_SET_UNUSED(md_blocksize);
899
900         EVP_DigestInit_ex(mdctx, md, NULL);
901
902         /* we reuse md_value here for streaming over fp */
903         do {
904                 n = fread(md_value, 1, EVP_MAX_MD_SIZE, fp);
905                 if (n < 0) {
906                         EVP_cleanup();
907                         fclose(fp);
908                         xfree(mdctx);
909                         error("file corrupted");
910                         return Qnil;
911                 }
912                 EVP_DigestUpdate(mdctx, md_value, n);
913         } while (n > 0);
914
915         EVP_DigestFinal_ex(mdctx, md_value, &md_len);
916         EVP_MD_CTX_cleanup(mdctx);
917
918         EVP_cleanup();
919         xfree(mdctx);
920         fclose(fp);
921
922         return make_ext_string((char *)md_value, md_len, OSSL_CODING);
923 }
924
925
926 /*
927  *
928  * HMAC (aka keyed hashes)
929  *
930  */
931 DEFUN("ossl-hmac", Fossl_hmac, 3, 3, 0, /*
932 Return the message authentication code of MSG
933 using the hash function DIGEST and the key PASSWORD.
934
935 Note: You probably want to put a wrapping encoder function
936 \(like `base16-encode-string'\) around it, since this returns
937 binary string data.
938 */
939       (digest, msg, password))
940 {
941         const EVP_MD *md;
942         HMAC_CTX *hmacctx;
943
944         /* buffer for the ciphertext */
945         unsigned char outbuf[EVP_MAX_MD_SIZE];
946         unsigned int outlen;
947         /* buffer for external password */
948         char *password_ext;
949         unsigned int password_len;
950 #if 0   /* why? */
951         /* buffer for external message */
952         char *msg_ext;
953         unsigned int msg_len;
954 #endif
955
956         CHECK_SYMBOL(digest);
957         CHECK_STRING(msg);
958         CHECK_STRING(password);
959
960         OpenSSL_add_all_digests();
961         md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
962
963         if (!md) {
964                 EVP_cleanup();
965                 error ("no such digest");
966         }
967
968         TO_EXTERNAL_FORMAT (LISP_STRING, password,
969                             C_STRING_ALLOCA, password_ext, OSSL_CODING);
970         password_len = OSSL_STRING_LENGTH(password);
971
972 #if 0   /* i wonder why */
973         TO_EXTERNAL_FORMAT (LISP_STRING, msg,
974                             C_STRING_ALLOCA, msg_ext, OSSL_CODING);
975         msg_len = OSSL_STRING_LENGTH(msg);
976 #endif
977
978         hmacctx = xnew(HMAC_CTX);
979         HMAC_CTX_init(hmacctx);
980         HMAC_Init(hmacctx, password_ext, password_len, md);
981         HMAC_Update(hmacctx, (unsigned char*)XSTRING_DATA(msg),
982                     XSTRING_LENGTH(msg));
983         HMAC_Final(hmacctx, outbuf, &outlen);
984         HMAC_CTX_cleanup(hmacctx);
985         xfree(hmacctx);
986
987         EVP_cleanup();
988
989         return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
990 }
991
992 DEFUN("ossl-hmac-file", Fossl_hmac_file, 3, 3, 0, /*
993 Return the message authentication code of the contents of FILE
994 using the hash function DIGEST and the key PASSWORD.
995
996 Note: You probably want to put a wrapping encoder function
997 \(like `base16-encode-string'\) around it, since this returns
998 binary string data.
999 */
1000       (digest, file, password))
1001 {
1002         const EVP_MD *md;
1003         HMAC_CTX *hmacctx;
1004
1005         /* buffer for the ciphertext */
1006         unsigned char outbuf[EVP_MAX_MD_SIZE];
1007         unsigned int outlen;
1008         ssize_t n;
1009         /* buffer for external password */
1010         char *password_ext;
1011         unsigned int password_len;
1012         /* input file */
1013         FILE *fp;
1014
1015         CHECK_SYMBOL(digest);
1016         CHECK_STRING(file);
1017         CHECK_STRING(password);
1018
1019         file = Fexpand_file_name(file, Qnil);
1020
1021         if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1022             (fseek(fp, 0, SEEK_SET))) {
1023                 if (fp)
1024                         fclose(fp);
1025                 return wrong_type_argument(Qfile_readable_p, file);
1026         }
1027
1028
1029         OpenSSL_add_all_digests();
1030         md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
1031
1032         if (!md) {
1033                 EVP_cleanup();
1034                 error ("no such digest");
1035         }
1036
1037         TO_EXTERNAL_FORMAT (LISP_STRING, password,
1038                             C_STRING_ALLOCA, password_ext, OSSL_CODING);
1039         password_len = OSSL_STRING_LENGTH(password);
1040
1041         hmacctx = xnew(HMAC_CTX);
1042         HMAC_CTX_init(hmacctx);
1043         HMAC_Init(hmacctx, password_ext, password_len, md);
1044
1045         /* we reuse md_value here for streaming over fp */
1046         do {
1047                 n = fread(outbuf, 1, EVP_MAX_MD_SIZE, fp);
1048                 if (n < 0) {
1049                         EVP_cleanup();
1050                         fclose(fp);
1051                         xfree(hmacctx);
1052                         error("file corrupted");
1053                         return Qnil;
1054                 }
1055                 HMAC_Update(hmacctx, outbuf, n);
1056         } while (n > 0);
1057
1058         HMAC_Final(hmacctx, outbuf, &outlen);
1059         HMAC_CTX_cleanup(hmacctx);
1060         xfree(hmacctx);
1061
1062         EVP_cleanup();
1063         fclose(fp);
1064
1065         return make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1066 }
1067
1068
1069 /*
1070  *
1071  * SYMMETRIC CIPHER
1072  *
1073  */
1074 DEFUN("ossl-bytes-to-key", Fossl_bytes_to_key, 5, 5, 0, /*
1075 Derive a key and initialisation vector (iv) suitable for a cipher.
1076 Return a string KEY being the key. The initialisation vector is
1077 put into KEY's property list as 'iv.
1078
1079 CIPHER \(a symbol\) is the cipher to derive the key and IV for.
1080 Valid ciphers can be obtained by `ossl-available-ciphers'.
1081
1082 DIGEST \(a symbol\) is the message digest to use.
1083 Valid digests can be obtained by `ossl-available-digests'.
1084
1085 SALT \(string or `nil'\) is used as a salt in the derivation.
1086 Use `nil' here to indicate that no salt is used.
1087
1088 PASSWORD is an arbitrary string which is processed to derive a
1089 unique key and IV.
1090
1091 COUNT \(a positive integer\) is the iteration count to use. This
1092 indicates how often the hash algorithm is called recursively.
1093
1094 Note: You probably want to put a wrapping encoder function
1095 \(like `base16-encode-string'\) around it, since this returns
1096 binary string data.
1097 */
1098       (cipher, digest, salt, password, count))
1099 {
1100         const EVP_MD *md;
1101         const EVP_CIPHER *ciph;
1102         const char *salt_ext;
1103
1104         char *password_ext;
1105         unsigned int password_len;
1106
1107         char key[EVP_MAX_KEY_LENGTH];
1108         char iv[EVP_MAX_IV_LENGTH];
1109
1110         Lisp_Object result;
1111
1112         CHECK_STRING(password);
1113         CHECK_SYMBOL(cipher);
1114         CHECK_SYMBOL(digest);
1115         CHECK_NATNUM(count);
1116
1117
1118         if (!XINT(count))
1119                 error ("count has to be a non-zero positive integer");
1120
1121         OpenSSL_add_all_algorithms();
1122         md = EVP_get_digestbyname(
1123                 (char *)string_data(XSYMBOL(digest)->name));
1124         ciph = EVP_get_cipherbyname(
1125                 (char *)string_data(XSYMBOL(cipher)->name));
1126
1127         if (!ciph) {
1128                 EVP_cleanup();
1129                 error ("no such cipher");
1130         }
1131
1132         if (!md) {
1133                 EVP_cleanup();
1134                 error ("no such digest");
1135         }
1136
1137         if (NILP(salt)) {
1138                 salt_ext = NULL;
1139         } else {
1140                 CHECK_STRING(salt);
1141                 TO_EXTERNAL_FORMAT (LISP_STRING, salt,
1142                                     C_STRING_ALLOCA, salt_ext, OSSL_CODING);
1143                 salt_ext = NULL;
1144         }
1145
1146         TO_EXTERNAL_FORMAT (LISP_STRING, password,
1147                             C_STRING_ALLOCA, password_ext, OSSL_CODING);
1148         password_len = OSSL_STRING_LENGTH(password);
1149
1150         EVP_BytesToKey(ciph, md, (const unsigned char *)salt_ext,
1151                        (const unsigned char *)password_ext, password_len,
1152                        XINT(count),
1153                        (unsigned char *)key,
1154                        (unsigned char *)iv);
1155
1156         EVP_cleanup();
1157
1158         result = make_ext_string(key, EVP_CIPHER_key_length(ciph), OSSL_CODING);
1159         Fput(result, intern("iv"),
1160              make_ext_string(iv, EVP_CIPHER_iv_length(ciph), OSSL_CODING));
1161
1162         return result;
1163 }
1164
1165
1166 DEFUN("ossl-encrypt", Fossl_encrypt, 3, 4, 0,   /*
1167 Return the cipher of STRING computed by CIPHER under KEY.
1168
1169 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1170 you have compiled. See `ossl-available-ciphers'.
1171
1172 STRING is the text to be encrypted.
1173
1174 KEY should be a key generated suitably for this cipher, for example
1175 by `ossl-bytes-to-key'.
1176
1177 Optional fourth argument IV should be an initialisation vector
1178 suitable for this cipher. Normally the initialisation vector from
1179 KEY's property list is used. However, if IV is
1180 non-nil, use this IV instead.
1181
1182 Note: You probably want to put a wrapping encoder function
1183 \(like `base16-encode-string'\) around it, since this returns
1184 binary string data.
1185 */
1186       (cipher, string, key, iv))
1187 {
1188         /* buffer for the external string */
1189         char *string_ext;
1190         unsigned int string_len;
1191         /* buffer for the ciphertext */
1192         char *outbuf;
1193         int outlen;
1194         Lisp_Object l_outbuf;
1195         /* buffer for key */
1196         char *key_ext;
1197         /* buffer for iv */
1198         char *iv_ext;
1199
1200         /* declarations for the cipher */
1201         const EVP_CIPHER *ciph;
1202         EVP_CIPHER_CTX *ciphctx;
1203
1204         int tmplen;
1205         int speccount = specpdl_depth();
1206         Charcount alloclen;
1207
1208         /* frob the IV from the plist of key maybe */
1209         if (NILP(iv))
1210                 iv = Fget(key, intern("iv"), Qnil);
1211
1212         CHECK_SYMBOL(cipher);
1213         CHECK_STRING(string);
1214         CHECK_STRING(key);
1215         CHECK_STRING(iv);
1216
1217         TO_EXTERNAL_FORMAT(LISP_STRING, string,
1218                            C_STRING_ALLOCA, string_ext, OSSL_CODING);
1219         string_len = OSSL_STRING_LENGTH(string);
1220
1221         if (string_len <= 0)
1222                 error ("string must be of non-zero positive length.");
1223
1224         OpenSSL_add_all_algorithms();
1225         /* ENGINE_load_builtin_engines(); */
1226         /* atm, no support for different engines */
1227         ciph = EVP_get_cipherbyname(
1228                 (char *)string_data(XSYMBOL(cipher)->name));
1229
1230         if (!ciph) {
1231                 EVP_cleanup();
1232                 error ("no such cipher");
1233         }
1234
1235         /* now allocate some output buffer externally
1236          * this one has to be at least EVP_CIPHER_block_size bigger
1237          * since block algorithms merely operate blockwise
1238          */
1239         alloclen = XSTRING_LENGTH(string) + EVP_CIPHER_block_size(ciph);
1240         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1241
1242         TO_EXTERNAL_FORMAT(LISP_STRING, key,
1243                             C_STRING_ALLOCA, key_ext, OSSL_CODING);
1244         TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1245                            C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1246
1247         ciphctx = xnew(EVP_CIPHER_CTX);
1248         EVP_CIPHER_CTX_init(ciphctx);
1249         if (!EVP_EncryptInit(ciphctx, ciph,
1250                              (unsigned char *)key_ext,
1251                              (unsigned char *)iv_ext)) {
1252                 EVP_cleanup();
1253                 xfree(ciphctx);
1254                 error ("error in EncryptInit");
1255         }
1256         if (!EVP_EncryptUpdate(ciphctx,
1257                                (unsigned char *)outbuf, &outlen,
1258                                (unsigned char *)string_ext, string_len)) {
1259                 EVP_cleanup();
1260                 xfree(ciphctx);
1261                 error ("error in EncryptUpdate");
1262         }
1263         /* Buffer passed to EVP_EncryptFinal() must be after data just
1264          * encrypted to avoid overwriting it.
1265          */
1266         if (!EVP_EncryptFinal(ciphctx,
1267                               (unsigned char *)outbuf+outlen, &tmplen)) {
1268                 EVP_cleanup();
1269                 xfree(ciphctx);
1270                 error ("error in EncryptFinal");
1271         }
1272         /* added probable padding space to the length of the output buffer */
1273         outlen += tmplen;
1274         EVP_CIPHER_CTX_cleanup(ciphctx);
1275
1276         l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1277         XMALLOC_UNBIND(outbuf, alloclen, speccount);
1278
1279         EVP_cleanup();
1280         xfree(ciphctx);
1281
1282         return l_outbuf;
1283 }
1284
1285 DEFUN("ossl-encrypt-file", Fossl_encrypt_file, 3, 5, 0, /*
1286 Return the encrypted contents of FILE computed by CIPHER under KEY.
1287
1288 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1289 you have compiled. See `ossl-available-ciphers'.
1290
1291 FILE is the file to be encrypted.
1292
1293 Third argument KEY should be a key generated suitably for this
1294 cipher, for example by `ossl-bytes-to-key'.
1295
1296 Optional fourth argument IV should be an initialisation vector
1297 suitable for this cipher. Normally the initialisation vector from
1298 KEY's property list is used. However, if IV is
1299 non-nil, use this IV instead.
1300
1301 Optional fifth argument OUTFILE may specify a file to have the
1302 encrypted data redirected.
1303
1304 Note: You probably want to put a wrapping encoder function
1305 \(like `base16-encode-string'\) around it, since this returns
1306 binary string data.
1307 */
1308       (cipher, file, key, iv, outfile))
1309 {
1310         /* buffer for the external string */
1311         unsigned char string_in[1024];
1312         ssize_t string_len;
1313         unsigned int block_len;
1314         unsigned long file_size;
1315         /* buffer for the ciphertext */
1316         unsigned char *outbuf;
1317         unsigned char *obp;
1318         int outlen;
1319         Lisp_Object l_outbuf;
1320         /* buffer for key */
1321         char *key_ext;
1322         /* buffer for iv */
1323         char *iv_ext;
1324
1325         /* input file */
1326         FILE *fp;
1327         /* output file */
1328         FILE *of;
1329
1330         /* declarations for the cipher */
1331         const EVP_CIPHER *ciph;
1332         EVP_CIPHER_CTX *ciphctx;
1333
1334         int tmplen;
1335         int speccount = specpdl_depth();
1336         Charcount alloclen;
1337
1338         /* frob the IV from the plist of key maybe */
1339         if (NILP(iv))
1340                 iv = Fget(key, intern("iv"), Qnil);
1341
1342         CHECK_SYMBOL(cipher);
1343         CHECK_STRING(file);
1344         CHECK_STRING(key);
1345         CHECK_STRING(iv);
1346
1347         if (!NILP(outfile)) {
1348                 CHECK_STRING(outfile);
1349                 outfile = Fexpand_file_name(outfile, Qnil);
1350                 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1351                         return wrong_type_argument(Qfile_writable_p, outfile);
1352         } else {
1353                 of = NULL;
1354         }
1355
1356         file = Fexpand_file_name(file, Qnil);
1357         if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1358             (fseek(fp, 0, SEEK_SET))) {
1359                 if (fp)
1360                         fclose(fp);
1361                 if (of)
1362                         fclose(of);
1363                 return wrong_type_argument(Qfile_readable_p, file);
1364         }
1365
1366         fseek(fp, 0, SEEK_END);
1367         file_size = ftell(fp);
1368         fseek(fp, 0, SEEK_SET);
1369
1370
1371         OpenSSL_add_all_algorithms();
1372         /* ENGINE_load_builtin_engines(); */
1373         /* atm, no support for different engines */
1374         ciph = EVP_get_cipherbyname(
1375                 (char *)string_data(XSYMBOL(cipher)->name));
1376
1377         if (!ciph) {
1378                 EVP_cleanup();
1379                 fclose(fp);
1380                 if (of)
1381                         fclose(of);
1382                 error ("no such cipher");
1383         }
1384
1385         /* now allocate some output buffer externally
1386          * this one has to be at least EVP_CIPHER_block_size bigger
1387          * since block algorithms merely operate blockwise
1388          */
1389         block_len = EVP_CIPHER_block_size(ciph);
1390         if (UNLIKELY(of != NULL)) {
1391                 alloclen = 2048;
1392         } else {
1393                 alloclen = file_size + block_len;
1394         }
1395         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1396
1397         TO_EXTERNAL_FORMAT(LISP_STRING, key,
1398                            C_STRING_ALLOCA, key_ext, OSSL_CODING);
1399         TO_EXTERNAL_FORMAT(LISP_STRING, iv,
1400                            C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1401
1402         ciphctx = xnew(EVP_CIPHER_CTX);
1403         EVP_CIPHER_CTX_init(ciphctx);
1404         if (!EVP_EncryptInit(ciphctx, ciph,
1405                              (unsigned char *)key_ext,
1406                              (unsigned char *)iv_ext)) {
1407                 EVP_cleanup();
1408                 fclose(fp);
1409                 if (of)
1410                         fclose(of);
1411                 xfree(ciphctx);
1412                 error("error in EncryptInit");
1413         }
1414
1415         obp = outbuf;
1416         outlen = 0;
1417         do {
1418                 string_len = fread(string_in, 1, 1024, fp);
1419                 if (string_len < 0) {
1420                         EVP_cleanup();
1421                         fclose(fp);
1422                         if (of)
1423                                 fclose(of);
1424                         xfree(ciphctx);
1425                         error("file corrupted");
1426                         return Qnil;
1427                 }
1428
1429                 tmplen = 0;
1430                 if (string_len > 0 &&
1431                     !EVP_EncryptUpdate(ciphctx,
1432                                        obp, &tmplen,
1433                                        string_in, string_len)) {
1434                         EVP_cleanup();
1435                         fclose(fp);
1436                         if (of)
1437                                 fclose(of);
1438                         xfree(ciphctx);
1439                         error("error in EncryptUpdate");
1440                 }
1441
1442                 if (of)
1443                         fwrite(obp, 1, tmplen, of);
1444                 else
1445                         obp += tmplen;
1446
1447                 outlen += tmplen;
1448         } while (string_len > 0);
1449
1450         /* Buffer passed to EVP_EncryptFinal() must be after data just
1451          * encrypted to avoid overwriting it.
1452          */
1453         if (!EVP_EncryptFinal(ciphctx, obp, &tmplen)) {
1454                 EVP_cleanup();
1455                 fclose(fp);
1456                 if (of)
1457                         fclose(of);
1458                 xfree(ciphctx);
1459                 error("error in EncryptFinal");
1460         }
1461
1462         if (of)
1463                 fwrite(obp, 1, tmplen, of);
1464
1465         /* added probable padding space to the length of the output buffer */
1466         outlen += tmplen;
1467         EVP_CIPHER_CTX_cleanup(ciphctx);
1468
1469         if (UNLIKELY(of != NULL)) {
1470                 l_outbuf = outfile;
1471         } else {
1472                 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1473         }
1474         XMALLOC_UNBIND(outbuf, alloclen, speccount);
1475
1476         EVP_cleanup();
1477         xfree(ciphctx);
1478         fclose(fp);
1479         if (of)
1480                 fclose(of);
1481
1482         return l_outbuf;
1483 }
1484 /* testcase:
1485  (setq k (ossl-bytes-to-key 'AES-256-OFB 'SHA1 nil "password" 1))
1486  (ossl-encrypt-file 'AES-256-OFB "~/.gnus" k nil "/tmp/gnus-enc")
1487  (ossl-decrypt-file 'AES-256-OFB "/tmp/gnus-enc" k nil "/tmp/gnus-dec")
1488 */
1489
1490
1491 DEFUN("ossl-decrypt", Fossl_decrypt, 3, 4, 0,   /*
1492 Return the deciphered version of STRING computed by CIPHER under KEY.
1493
1494 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1495 you have compiled. See `ossl-available-ciphers'.
1496
1497 STRING is the text to be decrypted.
1498
1499 KEY should be a key generated suitably for this
1500 cipher, for example by `ossl-bytes-to-key'.
1501
1502 Optional fourth argument IV should be an initialisation vector
1503 suitable for this cipher. Normally the initialisation vector from
1504 KEY's property list is used. However, if IV is
1505 non-nil, use this IV instead.
1506 */
1507       (cipher, string, key, iv))
1508 {
1509         /* buffer for the external string */
1510         char *string_ext;
1511         unsigned int string_len;
1512         /* buffer for the deciphered text */
1513         char *outbuf;
1514         int outlen;
1515         Lisp_Object l_outbuf;
1516         /* buffer for key */
1517         char *key_ext;
1518         /* buffer for iv */
1519         char *iv_ext;
1520
1521         /* declarations for the decipher */
1522         const EVP_CIPHER *ciph;
1523         EVP_CIPHER_CTX *ciphctx;
1524
1525         int tmplen;
1526         int speccount = specpdl_depth();
1527         Charcount alloclen;
1528
1529         /* frob the IV from the plist of key maybe */
1530         if (NILP(iv))
1531                 iv = Fget(key, intern("iv"), Qnil);
1532
1533         CHECK_SYMBOL(cipher);
1534         CHECK_STRING(string);
1535         CHECK_STRING(key);
1536         CHECK_STRING(iv);
1537
1538         TO_EXTERNAL_FORMAT(LISP_STRING, string,
1539                            C_STRING_ALLOCA, string_ext, OSSL_CODING);
1540         string_len = OSSL_STRING_LENGTH(string);
1541
1542         if (!string_len)
1543                 error ("string must be of non-zero positive length.");
1544
1545         OpenSSL_add_all_algorithms();
1546         /* ENGINE_load_builtin_engines(); */
1547         /* atm, no support for different engines */
1548         ciph = EVP_get_cipherbyname(
1549                 (char *)string_data(XSYMBOL(cipher)->name));
1550
1551         if (!ciph) {
1552                 EVP_cleanup();
1553                 error ("no such cipher");
1554         }
1555
1556         /* now allocate some output buffer externally */
1557         alloclen = XSTRING_LENGTH(string);
1558         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, char);
1559
1560         TO_EXTERNAL_FORMAT (LISP_STRING, key,
1561                             C_STRING_ALLOCA, key_ext, OSSL_CODING);
1562         TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1563                             C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1564
1565         ciphctx = xnew(EVP_CIPHER_CTX);
1566         EVP_CIPHER_CTX_init(ciphctx);
1567         if (!EVP_DecryptInit(ciphctx, ciph,
1568                              (unsigned char *)key_ext,
1569                              (unsigned char *)iv_ext)) {
1570                 EVP_cleanup();
1571                 xfree(ciphctx);
1572                 error ("error in DecryptInit");
1573         }
1574         if (!EVP_DecryptUpdate(ciphctx,
1575                                (unsigned char *)outbuf, &outlen,
1576                                (unsigned char *)string_ext,string_len)) {
1577                 EVP_cleanup();
1578                 xfree(ciphctx);
1579                 error ("error in DecryptUpdate");
1580         }
1581         /* Buffer passed to EVP_EncryptFinal() must be after data just
1582          * encrypted to avoid overwriting it.
1583          */
1584         if (!EVP_DecryptFinal(ciphctx,
1585                               (unsigned char *)outbuf+outlen, &tmplen)) {
1586                 EVP_cleanup();
1587                 xfree(ciphctx);
1588                 error ("error in DecryptFinal");
1589         }
1590         /* added probable padding space to the length of the output buffer */
1591         outlen += tmplen;
1592         EVP_CIPHER_CTX_cleanup(ciphctx);
1593
1594         l_outbuf = make_ext_string(outbuf, outlen, OSSL_CODING);
1595         XMALLOC_UNBIND(outbuf, alloclen, speccount);
1596
1597         EVP_cleanup();
1598         xfree(ciphctx);
1599
1600         return l_outbuf;
1601 }
1602
1603 DEFUN("ossl-decrypt-file", Fossl_decrypt_file, 3, 5, 0, /*
1604 Return the deciphered version of FILE computed by CIPHER under KEY.
1605
1606 CIPHER \(a symbol\) may be one of the OpenSSL cipher algorithms
1607 you have compiled. See `ossl-available-ciphers'.
1608
1609 FILE is the file to be decrypted.
1610
1611 Third argument KEY should be a key generated suitably for this
1612 cipher, for example by `ossl-bytes-to-key'.
1613
1614 Optional fourth argument IV should be an initialisation vector
1615 suitable for this cipher. Normally the initialisation vector from
1616 KEY's property list is used. However, if IV is
1617 non-nil, use this IV instead.
1618
1619 Optional fifth argument OUTFILE may specify a file to have the
1620 encrypted data redirected.
1621 */
1622       (cipher, file, key, iv, outfile))
1623 {
1624         /* buffer for the external string */
1625         unsigned char string_in[1024];
1626         ssize_t string_len;
1627         unsigned int block_len;
1628         unsigned long file_size;
1629         /* buffer for the deciphered text */
1630         unsigned char *outbuf;
1631         unsigned char *obp;
1632         int outlen;
1633         Lisp_Object l_outbuf;
1634         /* buffer for key */
1635         char *key_ext;
1636         /* buffer for iv */
1637         char *iv_ext;
1638
1639         /* input file */
1640         FILE *fp;
1641         /* output file */
1642         FILE *of;
1643
1644         /* declarations for the decipher */
1645         const EVP_CIPHER *ciph;
1646         EVP_CIPHER_CTX *ciphctx;
1647
1648         int tmplen;
1649         int speccount = specpdl_depth();
1650         Charcount alloclen;
1651
1652         /* frob the IV from the plist of key maybe */
1653         if (NILP(iv))
1654                 iv = Fget(key, intern("iv"), Qnil);
1655
1656         CHECK_SYMBOL(cipher);
1657         CHECK_STRING(file);
1658         CHECK_STRING(key);
1659         CHECK_STRING(iv);
1660
1661         if (!NILP(outfile)) {
1662                 CHECK_STRING(outfile);
1663                 outfile = Fexpand_file_name(outfile, Qnil);
1664                 if ((of = fopen((char *)XSTRING_DATA(outfile),"wb")) == NULL)
1665                         return wrong_type_argument(Qfile_writable_p, outfile);
1666         } else {
1667                 of = NULL;
1668         }
1669
1670         file = Fexpand_file_name(file, Qnil);
1671         if (((fp = fopen((char *)XSTRING_DATA(file),"rb")) == NULL) ||
1672             (fseek(fp, 0, SEEK_SET))) {
1673                 if (fp)
1674                         fclose(fp);
1675                 if (of)
1676                         fclose(of);
1677                 return wrong_type_argument(Qfile_readable_p, file);
1678         }
1679
1680         fseek(fp, 0, SEEK_END);
1681         file_size = ftell(fp);
1682         fseek(fp, 0, SEEK_SET);
1683
1684
1685         OpenSSL_add_all_algorithms();
1686         /* ENGINE_load_builtin_engines(); */
1687         /* atm, no support for different engines */
1688         ciph = EVP_get_cipherbyname(
1689                 (char *)string_data(XSYMBOL(cipher)->name));
1690
1691         if (!ciph) {
1692                 EVP_cleanup();
1693                 fclose(fp);
1694                 if (of)
1695                         fclose(of);
1696                 error ("no such cipher");
1697         }
1698
1699         /* now allocate some output buffer externally */
1700         block_len = EVP_CIPHER_block_size(ciph);
1701         if (UNLIKELY(of != NULL)) {
1702                 alloclen = 2048;
1703         } else {
1704                 alloclen = file_size + block_len;
1705         }
1706         XMALLOC_ATOMIC_OR_ALLOCA(outbuf, alloclen, unsigned char);
1707
1708         TO_EXTERNAL_FORMAT (LISP_STRING, key,
1709                             C_STRING_ALLOCA, key_ext, OSSL_CODING);
1710         TO_EXTERNAL_FORMAT (LISP_STRING, iv,
1711                             C_STRING_ALLOCA, iv_ext, OSSL_CODING);
1712
1713         ciphctx = xnew(EVP_CIPHER_CTX);
1714         EVP_CIPHER_CTX_init(ciphctx);
1715         if (!EVP_DecryptInit(ciphctx, ciph,
1716                              (unsigned char *)key_ext,
1717                              (unsigned char *)iv_ext)) {
1718                 EVP_cleanup();
1719                 fclose(fp);
1720                 if (of)
1721                         fclose(of);
1722                 xfree(ciphctx);
1723                 error ("error in DecryptInit");
1724         }
1725
1726         obp = outbuf;
1727         outlen = 0;
1728         do {
1729                 string_len = fread(string_in, 1, 1024, fp);
1730                 if (string_len < 0) {
1731                         EVP_cleanup();
1732                         fclose(fp);
1733                         if (of)
1734                                 fclose(of);
1735                         xfree(ciphctx);
1736                         error("file corrupted");
1737                         return Qnil;
1738                 }
1739
1740                 tmplen = 0;
1741                 if (string_len > 0 &&
1742                     !EVP_DecryptUpdate(ciphctx,
1743                                        obp, &tmplen,
1744                                        string_in, string_len)) {
1745                         EVP_cleanup();
1746                         fclose(fp);
1747                         if (of)
1748                                 fclose(of);
1749                         xfree(ciphctx);
1750                         error ("error in DecryptUpdate");
1751                 }
1752
1753                 if (of)
1754                         fwrite(obp, 1, tmplen, of);
1755                 else
1756                         obp += tmplen;
1757
1758                 outlen += tmplen;
1759         } while (string_len > 0);
1760
1761         /* Buffer passed to EVP_EncryptFinal() must be after data just
1762          * encrypted to avoid overwriting it.
1763          */
1764         if (!EVP_DecryptFinal(ciphctx, obp, &tmplen)) {
1765                 EVP_cleanup();
1766                 fclose(fp);
1767                 if (of)
1768                         fclose(of);
1769                 xfree(ciphctx);
1770                 error ("error in DecryptFinal");
1771         }
1772
1773         if (of)
1774                 fwrite(obp, 1, tmplen, of);
1775
1776         /* added probable padding space to the length of the output buffer */
1777         outlen += tmplen;
1778         EVP_CIPHER_CTX_cleanup(ciphctx);
1779
1780         if (UNLIKELY(of != NULL)) {
1781                 l_outbuf = outfile;
1782         } else {
1783                 l_outbuf = make_ext_string((char*)outbuf, outlen, OSSL_CODING);
1784         }
1785         XMALLOC_UNBIND(outbuf, alloclen, speccount);
1786
1787         EVP_cleanup();
1788         xfree(ciphctx);
1789         fclose(fp);
1790         if (of)
1791                 fclose(of);
1792
1793         return l_outbuf;
1794 }
1795
1796
1797 /*
1798  *
1799  * ASYMMETRIC CIPHER
1800  *
1801  */
1802 /* This is an opaque object for storing PKEYs in lisp */
1803 Lisp_Object Qevp_pkeyp;
1804
1805 static Lisp_Object
1806 mark_evp_pkey(Lisp_Object obj)
1807 {
1808         /* avoid some warning */
1809         if (obj);
1810         return Qnil;
1811 }
1812
1813 static void
1814 print_evp_pkey(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1815 {
1816         EVP_PKEY *pkey;
1817         X509 *x509;
1818
1819         pkey = XEVPPKEY(obj)->evp_pkey;
1820         x509 = XEVPPKEY(obj)->x509;
1821
1822         write_c_string("#<OpenSSL", printcharfun);
1823
1824         if (x509) {
1825                 X509_NAME *iss = X509_get_issuer_name(x509);
1826                 X509_NAME *sub = X509_get_subject_name(x509);
1827                 write_c_string(" X509 Certificate", printcharfun);
1828                 write_c_string(" iss:", printcharfun);
1829                 write_c_string(X509_NAME_oneline(sub, NULL, 0), printcharfun);
1830                 write_c_string(" sub:", printcharfun);
1831                 write_c_string(X509_NAME_oneline(iss, NULL, 0), printcharfun);
1832         }
1833
1834         if (pkey) {
1835                 if (x509)
1836                         write_c_string(";", printcharfun);
1837
1838                 if (rsa_pkey_p(pkey))
1839                         write_c_string(" RSA", printcharfun);
1840                 else if (dsa_pkey_p(pkey))
1841                         write_c_string(" DSA", printcharfun);
1842                 else if (ec_pkey_p(pkey))
1843                         write_c_string(" EC", printcharfun);
1844
1845                 if (ossl_pkey_has_private_data(pkey))
1846                         write_c_string(" private/public key", printcharfun);
1847                 else if (ossl_pkey_has_public_data(pkey))
1848                         write_c_string(" public key", printcharfun);
1849                 else
1850                         write_c_string(" empty key", printcharfun);
1851
1852                 if (EVP_PKEY_size(pkey) > 0) {
1853                         write_fmt_str(printcharfun, ", size %d", EVP_PKEY_size(pkey)*8);
1854                 }
1855         }
1856
1857         write_c_string(">", printcharfun);
1858
1859         /* avoid some warning */
1860         if (escapeflag);
1861 }
1862
1863 static Lisp_EVP_PKEY *
1864 allocate_evp_pkey(void)
1865 {
1866         Lisp_EVP_PKEY *evp_pkey =
1867                 alloc_lcrecord_type(Lisp_EVP_PKEY, &lrecord_evp_pkey);
1868         evp_pkey->evp_pkey = NULL;
1869         evp_pkey->x509 = NULL;
1870         return evp_pkey;
1871 }
1872
1873 static void
1874 finalise_evp_pkey(void *header, int for_disksave)
1875 {
1876         Lisp_EVP_PKEY *evp_pkey = (Lisp_EVP_PKEY *) header;
1877
1878         if (evp_pkey->evp_pkey) {
1879                 EVP_PKEY_free(evp_pkey->evp_pkey);
1880                 evp_pkey->evp_pkey = NULL;
1881         }
1882         if (evp_pkey->x509) {
1883                 X509_free(evp_pkey->x509);
1884                 evp_pkey->x509 = NULL;
1885         }
1886
1887         /* avoid some warning */
1888         if (for_disksave);
1889 }
1890
1891 DEFINE_LRECORD_IMPLEMENTATION("evp_pkey", evp_pkey,
1892                               mark_evp_pkey, print_evp_pkey,
1893                               finalise_evp_pkey,
1894                               NULL, NULL, 0,
1895                               Lisp_EVP_PKEY);
1896
1897 static Lisp_Object
1898 make_evp_pkey(EVP_PKEY *pkey, X509 *x509)
1899 {
1900         Lisp_EVP_PKEY *lisp_pkey = allocate_evp_pkey();
1901
1902         lisp_pkey->evp_pkey = pkey;
1903         lisp_pkey->x509 = x509;
1904
1905         return wrap_evppkey(lisp_pkey);
1906 }
1907
1908 static Lisp_Object
1909 make_evp_pkey_pk(EVP_PKEY *pkey)
1910 {
1911         return make_evp_pkey(pkey, NULL);
1912 }
1913
1914 static Lisp_Object
1915 make_evp_pkey_x509(X509 *x509)
1916 {
1917         return make_evp_pkey(X509_get_pubkey(x509), x509);
1918 }
1919
1920 DEFUN("ossl-pkey-p", Fossl_pkey_p, 1, 1, 0, /*
1921 Return t iff OBJECT is a pkey, nil otherwise.
1922 */
1923       (object))
1924 {
1925         if (EVPPKEYP(object))
1926                 return Qt;
1927         else
1928                 return Qnil;
1929 }
1930
1931 DEFUN("ossl-pkey-size", Fossl_pkey_size, 1, 1, 0, /*
1932 Return the size a public key PKEY in bits.
1933 */
1934       (pkey))
1935 {
1936         EVP_PKEY *pk;
1937
1938         CHECK_EVPPKEY(pkey);
1939
1940         pk = (XEVPPKEY(pkey))->evp_pkey;
1941
1942         return make_int(EVP_PKEY_size(pk)*8);
1943 }
1944
1945 int
1946 ossl_pkey_has_public_data(EVP_PKEY *pkey)
1947 {
1948         if (rsa_pkey_p(pkey)) {
1949 #ifndef OPENSSL_NO_RSA
1950                 return rsa_pkey_has_public_data((pkey->pkey).rsa);
1951 #else
1952                 return 0;
1953 #endif
1954         } else if (dsa_pkey_p(pkey)) {
1955 #ifndef OPENSSL_NO_DSA
1956                 return dsa_pkey_has_public_data((pkey->pkey).dsa);
1957 #else
1958                 return 0;
1959 #endif
1960         } else if (ec_pkey_p(pkey)) {
1961 #ifndef OPENSSL_NO_EC
1962                 return ec_pkey_has_public_data((pkey->pkey).ec);
1963 #else
1964                 return 0;
1965 #endif
1966         } else if (dh_pkey_p(pkey)) {
1967 #ifndef OPENSSL_NO_DH
1968                 return dh_pkey_has_public_data((pkey->pkey).dh);
1969 #else
1970                 return 0;
1971 #endif
1972         } else
1973                 return 0;
1974 }
1975 int
1976 ossl_pkey_has_private_data(EVP_PKEY *pkey)
1977 {
1978         if (rsa_pkey_p(pkey)) {
1979 #ifndef OPENSSL_NO_RSA
1980                 return rsa_pkey_has_private_data((pkey->pkey).rsa);
1981 #else
1982                 return 0;
1983 #endif
1984         } else if (dsa_pkey_p(pkey)) {
1985 #ifndef OPENSSL_NO_DSA
1986                 return dsa_pkey_has_private_data((pkey->pkey).dsa);
1987 #else
1988                 return 0;
1989 #endif
1990         } else if (ec_pkey_p(pkey)) {
1991 #ifndef OPENSSL_NO_EC
1992                 return ec_pkey_has_private_data((pkey->pkey).ec);
1993 #else
1994                 return 0;
1995 #endif
1996         } else if (dh_pkey_p(pkey)) {
1997 #ifndef OPENSSL_NO_DH
1998                 return dh_pkey_has_private_data((pkey->pkey).dh);
1999 #else
2000                 return 0;
2001 #endif
2002         } else
2003                 return 0;
2004 }
2005
2006 DEFUN("ossl-pkey-private-p", Fossl_pkey_private_p, 1, 1, 0, /*
2007 Return non-nil if PKEY contains private data.
2008
2009 This function is not native OpenSSL.
2010 */
2011       (pkey))
2012 {
2013         EVP_PKEY *pk;
2014
2015         if (!(EVPPKEYP(pkey)))
2016                 return Qnil;
2017
2018         pk = (XEVPPKEY(pkey))->evp_pkey;
2019
2020         if (ossl_pkey_has_private_data(pk))
2021                 return Qt;
2022
2023         return Qnil;
2024 }
2025
2026 DEFUN("ossl-pkey-get-public", Fossl_pkey_get_public, 1, 1, 0, /*
2027 Return a copy of PKEY stripped by the private data.
2028
2029 This function is not native OpenSSL.
2030 */
2031       (pkey))
2032 {
2033         EVP_PKEY *pk;
2034         EVP_PKEY *pkout;
2035
2036         CHECK_EVPPKEY(pkey);
2037
2038         pk = (XEVPPKEY(pkey))->evp_pkey;
2039         if (!(ossl_pkey_has_public_data(pk)))
2040                 error ("key must have public data");
2041
2042         pkout = EVP_PKEY_new();
2043         if (rsa_pkey_p(pk)) {
2044 #ifndef OPENSSL_NO_RSA
2045                 EVP_PKEY_assign_RSA(pkout, RSAPublicKey_dup((pk->pkey).rsa));
2046 #endif
2047         } else if (dsa_pkey_p(pk)) {
2048 #ifndef OPENSSL_NO_DSA
2049                 EVP_PKEY_assign_DSA(pkout, dsa_get_public(pk));
2050 #endif
2051         } else if (ec_pkey_p(pk)) {
2052 #ifndef OPENSSL_NO_EC
2053                 EVP_PKEY_assign_EC_KEY(pkout, ec_get_public(pk));
2054 #endif
2055         } else
2056                 error ("no method to strip private data yet");
2057
2058         return make_evp_pkey_pk(pkout);
2059 }
2060
2061 /* RSA */
2062 int
2063 rsa_pkey_p(EVP_PKEY *pkey)
2064 {
2065         int type;
2066
2067         type = EVP_PKEY_type(pkey->type);
2068
2069 #ifndef OPENSSL_NO_RSA
2070         return ((type == EVP_PKEY_RSA) ||
2071                 (type == EVP_PKEY_RSA2));
2072 #else
2073         return 0;
2074 #endif
2075 }
2076 #ifndef OPENSSL_NO_RSA
2077 int
2078 rsa_pkey_has_public_data(RSA *rsakey)
2079 {
2080         return (!(rsakey->n == NULL) &&
2081                 !(rsakey->e == NULL));
2082 }
2083 int
2084 rsa_pkey_has_private_data(RSA *rsakey)
2085 {
2086         return (rsa_pkey_has_public_data(rsakey) &&
2087                 !(rsakey->d == NULL));
2088 }
2089
2090 DEFUN("ossl-rsa-generate-key", Fossl_rsa_generate_key, 2, 2, 0, /*
2091 Return an RSA public key with of length BITS and exponent EXPO.
2092 */
2093       (bits, expo))
2094 {
2095         EVP_PKEY *pkey;
2096         RSA *rsakey;
2097
2098         CHECK_NATNUM(bits);
2099         CHECK_NATNUM(expo);
2100
2101
2102         if (!XINT(bits))
2103                 error ("modulus size must be a non-zero positive integer");
2104         if (!(XINT(expo) % 2))
2105                 error ("exponent must be an odd positive integer");
2106
2107         pkey = EVP_PKEY_new();
2108         rsakey = RSA_generate_key(XINT(bits), XINT(expo), NULL, NULL);
2109         EVP_PKEY_assign_RSA(pkey, rsakey);
2110
2111         return make_evp_pkey_pk(pkey);
2112 }
2113
2114 DEFUN("ossl-rsa-pkey-p", Fossl_rsa_pkey_p, 1, 1, 0, /*
2115 Return t iff PKEY is of RSA type.
2116 */
2117       (pkey))
2118 {
2119         EVP_PKEY *pk;
2120
2121         if (!EVPPKEYP(pkey))
2122                 return Qnil;
2123
2124         pk = (XEVPPKEY(pkey))->evp_pkey;
2125
2126         if (rsa_pkey_p(pk))
2127                 return Qt;
2128         else
2129                 return Qnil;
2130 }
2131
2132 DEFUN("ossl-rsa-subkey-p", Fossl_rsa_subkey_p, 2, 2, 0, /*
2133 Return t iff PKEY1 is a subkey of PKEY2.
2134 I.e. if PKEY1 has the same public key data as PKEY2 and
2135 PKEY2 has all private data.
2136
2137 This function is not native OpenSSL.
2138 */
2139       (pkey1, pkey2))
2140 {
2141         EVP_PKEY *pk1;
2142         EVP_PKEY *pk2;
2143         RSA *rk1;
2144         RSA *rk2;
2145
2146         CHECK_EVPPKEY(pkey1);
2147         CHECK_EVPPKEY(pkey2);
2148
2149         pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2150         pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2151
2152         /* perform a type check first */
2153         if (!rsa_pkey_p(pk1))
2154                 error ("pkey1 must be of RSA type");
2155         if (!rsa_pkey_p(pk2))
2156                 error ("pkey2 must be of RSA type");
2157
2158         rk1 = (pk1->pkey).rsa;
2159         rk2 = (pk2->pkey).rsa;
2160
2161         if (rsa_pkey_has_private_data(rk2) &&
2162             rsa_pkey_has_public_data(rk1) &&
2163             (!BN_cmp(rk1->n, rk2->n)) &&
2164             (!BN_cmp(rk1->e, rk2->e)))
2165                 return Qt;
2166         else
2167                 return Qnil;
2168 }
2169 #endif /* OPENSSL_NO_RSA */
2170
2171
2172 /* DSA */
2173 int
2174 dsa_pkey_p(EVP_PKEY *pkey)
2175 {
2176         int type;
2177
2178         type = EVP_PKEY_type(pkey->type);
2179
2180 #ifndef OPENSSL_NO_DSA
2181         return ((type == EVP_PKEY_DSA) ||
2182                 (type == EVP_PKEY_DSA1) ||
2183                 (type == EVP_PKEY_DSA2) ||
2184                 (type == EVP_PKEY_DSA3) ||
2185                 (type == EVP_PKEY_DSA4));
2186 #else
2187         return 0;
2188 #endif
2189 }
2190 #ifndef OPENSSL_NO_DSA
2191 int
2192 dsa_pkey_has_public_data(DSA *dsakey)
2193 {
2194         return (!(dsakey->p == NULL) &&
2195                 !(dsakey->q == NULL) &&
2196                 !(dsakey->g == NULL) &&
2197                 !(dsakey->pub_key == NULL));
2198 }
2199 int
2200 dsa_pkey_has_private_data(DSA *dsakey)
2201 {
2202         return (dsa_pkey_has_public_data(dsakey) &&
2203                 !(dsakey->priv_key == NULL));
2204 }
2205
2206 DEFUN("ossl-dsa-generate-key", Fossl_dsa_generate_key, 1, 2, 0, /*
2207 Return a DSA public key with of length BITS seeded with (optional) SEED.
2208 */
2209       (bits, seed))
2210 {
2211         EVP_PKEY *pkey;
2212         DSA *dsakey;
2213         char *seed_ext;
2214         int seed_len;
2215         int counter_ret;
2216         unsigned_long h_ret;
2217
2218
2219         CHECK_NATNUM(bits);
2220
2221
2222         if (!XINT(bits))
2223                 error ("prime number size must be a non-zero positive integer");
2224
2225         if (NILP(seed)) {
2226                 seed_ext = NULL;
2227                 seed_len = 0;
2228         } else {
2229                 CHECK_STRING(seed);
2230                 TO_EXTERNAL_FORMAT (LISP_STRING, seed,
2231                                     C_STRING_ALLOCA, seed_ext, OSSL_CODING);
2232                 seed_len = OSSL_STRING_LENGTH(seed);
2233         }
2234
2235         pkey = EVP_PKEY_new();
2236         dsakey = DSA_generate_parameters(XINT(bits),
2237                                          (unsigned char*)seed_ext, seed_len,
2238                                          &counter_ret, &h_ret,
2239                                          NULL, NULL);
2240         if (!DSA_generate_key(dsakey))
2241                 error ("error during generation of DSA key");
2242
2243         EVP_PKEY_assign_DSA(pkey, dsakey);
2244
2245         return make_evp_pkey_pk(pkey);
2246 }
2247
2248 DEFUN("ossl-dsa-pkey-p", Fossl_dsa_pkey_p, 1, 1, 0, /*
2249 Return t iff PKEY is of DSA type.
2250 */
2251       (pkey))
2252 {
2253         EVP_PKEY *pk;
2254
2255         if (!EVPPKEYP(pkey))
2256                 return Qnil;
2257
2258         pk = (XEVPPKEY(pkey))->evp_pkey;
2259         if (dsa_pkey_p(pk))
2260                 return Qt;
2261         else
2262                 return Qnil;
2263 }
2264
2265 DSA *
2266 dsa_get_public(EVP_PKEY *pk)
2267 {
2268         DSA *key;
2269
2270         key = DSA_new();
2271         memcpy(key, (pk->pkey).dsa, sizeof(DSA));
2272
2273         /* now kill the private data */
2274         key->priv_key = NULL;
2275
2276         return key;
2277 }
2278
2279 DEFUN("ossl-dsa-subkey-p", Fossl_dsa_subkey_p, 2, 2, 0, /*
2280 Return t iff PKEY1 is a subkey of PKEY2.
2281 I.e. if PKEY1 has the same public key data as PKEY2 and
2282 PKEY2 has all private data.
2283
2284 This function is not native OpenSSL.
2285 */
2286       (pkey1, pkey2))
2287 {
2288         EVP_PKEY *pk1;
2289         EVP_PKEY *pk2;
2290         DSA *dk1;
2291         DSA *dk2;
2292
2293         CHECK_EVPPKEY(pkey1);
2294         CHECK_EVPPKEY(pkey2);
2295
2296         pk1 = (XEVPPKEY(pkey1))->evp_pkey;
2297         pk2 = (XEVPPKEY(pkey2))->evp_pkey;
2298
2299         /* perform a type check first */
2300         if (!dsa_pkey_p(pk1))
2301                 error ("pkey1 must be of DSA type");
2302         if (!dsa_pkey_p(pk2))
2303                 error ("pkey2 must be of DSA type");
2304
2305         dk1 = (pk1->pkey).dsa;
2306         dk2 = (pk2->pkey).dsa;
2307
2308         if (dsa_pkey_has_private_data(dk2) &&
2309             dsa_pkey_has_public_data(dk1) &&
2310             (!BN_cmp(dk1->p, dk2->p)) &&
2311             (!BN_cmp(dk1->q, dk2->q)) &&
2312             (!BN_cmp(dk1->g, dk2->g)) &&
2313             (!BN_cmp(dk1->pub_key, dk2->pub_key)))
2314                 return Qt;
2315         else
2316                 return Qnil;
2317 }
2318 #endif /* OPENSSL_NO_DSA */
2319
2320
2321 /* EC */
2322 int
2323 ec_pkey_p(EVP_PKEY *pkey)
2324 {
2325         int type;
2326
2327         type = EVP_PKEY_type(pkey->type);
2328
2329 #ifndef OPENSSL_NO_EC
2330         return (type == EVP_PKEY_EC);
2331 #else
2332         return 0;
2333 #endif
2334 }
2335 #ifndef OPENSSL_NO_EC
2336 int
2337 ec_pkey_has_public_data(EC_KEY *ec_key)
2338 {
2339         return (!(EC_KEY_get0_group(ec_key) == NULL) &&
2340                 !(EC_KEY_get0_public_key(ec_key) == NULL));
2341 }
2342 int
2343 ec_pkey_has_private_data(EC_KEY *ec_key)
2344 {
2345         return (ec_pkey_has_public_data(ec_key) &&
2346                 !(EC_KEY_get0_private_key(ec_key) == NULL));
2347 }
2348
2349 DEFUN("ossl-ec-available-curves", Fossl_ec_available_curves, 0, 0, 0, /*
2350 Return a list of builtin elliptic curves.
2351 */
2352       ())
2353 {
2354         EC_builtin_curve *curves = NULL;
2355         size_t crv_len = 0, n = 0;
2356         Lisp_Object lcurves;
2357
2358         lcurves = Qnil;
2359
2360         crv_len = EC_get_builtin_curves(NULL, 0);
2361         curves = OPENSSL_malloc(sizeof(EC_builtin_curve) * crv_len);
2362
2363         if (curves == NULL)
2364                 error ("no curves defined");
2365
2366         if (!EC_get_builtin_curves(curves, crv_len)) {
2367                 OPENSSL_free(curves);
2368                 error ("error during initialisation of curves");
2369         }
2370
2371         for (n = 0; n < crv_len; n++) {
2372                 int nid = curves[n].nid;
2373                 lcurves = Fcons(intern(OBJ_nid2sn(nid)), lcurves);
2374         }
2375
2376         OPENSSL_free(curves);
2377
2378         return lcurves;
2379 }
2380
2381 int
2382 ec_curve_by_name(char *name)
2383 {
2384         return OBJ_sn2nid(name);
2385 }
2386
2387 DEFUN("ossl-ec-generate-key", Fossl_ec_generate_key, 1, 1, 0, /*
2388 Return a EC public key on CURVE.
2389 CURVE may be any symbol from `ossl-ec-available-curves'.
2390
2391 At the moment we do not support creating custom curves.
2392 */
2393       (curve))
2394 {
2395         EVP_PKEY *pkey;
2396         EC_KEY *eckey;
2397
2398         CHECK_SYMBOL(curve);
2399
2400         pkey = EVP_PKEY_new();
2401         eckey = EC_KEY_new_by_curve_name(
2402                 ec_curve_by_name((char *)string_data(XSYMBOL(curve)->name)));
2403
2404         if (eckey == NULL) {
2405                 error ("no such curve");
2406         }
2407
2408         if (!EC_KEY_generate_key(eckey))
2409                 error ("error during generation of EC key");
2410
2411         EVP_PKEY_assign_EC_KEY(pkey, eckey);
2412
2413         return make_evp_pkey_pk(pkey);
2414 }
2415
2416 DEFUN("ossl-ec-pkey-p", Fossl_ec_pkey_p, 1, 1, 0, /*
2417 Return t iff PKEY is of EC type.
2418 */
2419       (pkey))
2420 {
2421         EVP_PKEY *pk;
2422         int type;
2423
2424         if (!EVPPKEYP(pkey))
2425                 return Qnil;
2426
2427         pk = (XEVPPKEY(pkey))->evp_pkey;
2428         type = EVP_PKEY_type(pk->type);
2429         if (type == EVP_PKEY_EC)
2430                 return Qt;
2431         else
2432                 return Qnil;
2433 }
2434
2435 EC_KEY *
2436 ec_get_public(EVP_PKEY *pk)
2437 {
2438         EC_KEY *key;
2439
2440         key = EC_KEY_dup((pk->pkey).ec);
2441
2442         /* now kill the private data */
2443         EC_KEY_set_private_key(key, NULL);
2444
2445         return key;
2446 }
2447 #endif /* OPENSSL_NO_EC */
2448
2449
2450 /* DH */
2451 int
2452 dh_pkey_p(EVP_PKEY *pkey)
2453 {
2454         int type;
2455
2456         type = EVP_PKEY_type(pkey->type);
2457
2458 #ifndef OPENSSL_NO_DH
2459         return (type == EVP_PKEY_DH);
2460 #else
2461         return 0;
2462 #endif
2463 }
2464 #ifndef OPENSSL_NO_DH
2465 int
2466 dh_pkey_has_public_data(DH *dhkey)
2467 {
2468         return (!(dhkey->p == NULL) &&
2469                 !(dhkey->g == NULL) &&
2470                 !(dhkey->pub_key == NULL));
2471 }
2472 int
2473 dh_pkey_has_private_data(DH *dhkey)
2474 {
2475         return (dh_pkey_has_public_data(dhkey) &&
2476                 !(dhkey->priv_key == NULL));
2477 }
2478
2479 DEFUN("ossl-dh-pkey-p", Fossl_dh_pkey_p, 1, 1, 0, /*
2480 Return t iff PKEY is of DH type.
2481 */
2482       (pkey))
2483 {
2484         EVP_PKEY *pk;
2485
2486         if (!EVPPKEYP(pkey))
2487                 return Qnil;
2488
2489         pk = (XEVPPKEY(pkey))->evp_pkey;
2490
2491         if (dh_pkey_p(pk))
2492                 return Qt;
2493         else
2494                 return Qnil;
2495 }
2496
2497 #endif /* OPENSSL_NO_DH */
2498
2499
2500 /* more general access functions */
2501 DEFUN("ossl-seal", Fossl_seal, 3, 3, 0, /*
2502 Return an envelope derived from encrypting STRING by CIPHER under PKEY
2503 with the hybrid technique.
2504
2505 That is, create a random key/iv pair for the symmetric encryption with
2506 CIPHER and encrypt that key/iv asymmetrically with the provided public
2507 key.
2508
2509 The envelope returned is a list
2510 \(encrypted_string encrypted_key encrypted_iv\)
2511 where
2512 `encrypted_string' is the (symmetrically) encrypted message
2513 `encrypted_key' is the (asymmetrically) encrypted random key
2514 `encrypted_iv' is the (asymmetrically) encrypted random iv
2515
2516 Note: You probably want to put a wrapping encoder function
2517 (like `base16-encode-string') around it, since this function
2518 returns binary string data.
2519 */
2520       (cipher, string, pkey))
2521 {
2522         /* declarations for the cipher */
2523         const EVP_CIPHER *ciph;
2524         EVP_CIPHER_CTX ciphctx;
2525         /* declarations for the pkey */
2526         EVP_PKEY *pk[1];
2527         int npubk;
2528         unsigned char *ekey;
2529         int ekey_len;
2530         Lisp_Object l_ekey;
2531         /* buffer for the generated IV */
2532         char iv[EVP_MAX_IV_LENGTH];
2533         Lisp_Object l_iv;
2534         /* buffer for output */
2535         unsigned char *outbuf;
2536         unsigned int outlen;
2537         Lisp_Object l_outbuf;
2538         /* buffer for external string data */
2539         char *string_ext;
2540         int string_len;
2541
2542         int tmplen;
2543
2544
2545         CHECK_SYMBOL(cipher);
2546         CHECK_STRING(string);
2547         CHECK_EVPPKEY(pkey);
2548
2549
2550         pk[0] = (XEVPPKEY(pkey))->evp_pkey;
2551         if (!ossl_pkey_has_public_data(pk[0])) {
2552                 error ("cannot seal, key has no public key data");
2553         }
2554         npubk = 1;
2555
2556         TO_EXTERNAL_FORMAT (LISP_STRING, string,
2557                             C_STRING_ALLOCA, string_ext, OSSL_CODING);
2558         string_len = OSSL_STRING_LENGTH(string);
2559
2560         OpenSSL_add_all_algorithms();
2561         ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2562
2563         if (!ciph) {
2564                 EVP_cleanup();
2565                 error ("no such cipher");
2566                 return Qnil;
2567         }
2568
2569         /* alloc ekey buffer */
2570         ekey = (unsigned char*)xmalloc_atomic(EVP_PKEY_size(pk[0]));
2571
2572         /* now allocate some output buffer externally
2573          * this one has to be at least EVP_CIPHER_block_size bigger
2574          * since block algorithms merely operate blockwise
2575          */
2576         outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string) +
2577                                                  EVP_CIPHER_block_size(ciph));
2578
2579         EVP_CIPHER_CTX_init(&ciphctx);
2580         if (!(EVP_SealInit(&ciphctx, ciph,
2581                            &ekey, &ekey_len,
2582                            (unsigned char *)&iv,
2583                            (EVP_PKEY **)&pk, npubk)==npubk)) {
2584                 EVP_cleanup();
2585                 xfree(outbuf);
2586                 xfree(ekey);
2587                 error ("error in SealInit");
2588                 return Qnil;
2589         }
2590         if (!EVP_SealUpdate(&ciphctx, outbuf, (int *)&outlen,
2591                             (unsigned char*)string_ext, string_len)) {
2592                 EVP_cleanup();
2593                 xfree(outbuf);
2594                 xfree(ekey);
2595                 error ("error in SealUpdate");
2596                 return Qnil;
2597         }
2598         if (!EVP_SealFinal(&ciphctx, (unsigned char*)outbuf+outlen, &tmplen)) {
2599                 EVP_cleanup();
2600                 xfree(outbuf);
2601                 xfree(ekey);
2602                 error ("error in SealFinal");
2603                 return Qnil;
2604         }
2605         /* added probable padding space to the length of the output buffer */
2606         outlen += tmplen;
2607         EVP_CIPHER_CTX_cleanup(&ciphctx);
2608
2609         l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2610         l_ekey = make_ext_string((char *)ekey, ekey_len, OSSL_CODING);
2611         l_iv = make_ext_string(iv,EVP_CIPHER_iv_length(ciph), OSSL_CODING);
2612         xfree(outbuf);
2613         xfree(ekey);
2614         EVP_cleanup();
2615
2616         return list3(l_outbuf, l_ekey, l_iv);
2617 }
2618
2619
2620 DEFUN("ossl-open", Fossl_open, 4, 5, 0, /*
2621 Return the deciphered message STRING from an envelope
2622 obtained by `ossl-seal'.
2623
2624 CIPHER is the cipher to use (the same as in `ossl-seal')
2625 STRING is the encrypted message
2626 PKEY is the private key
2627 EKEY is the encrypted random key
2628 EIV is the encrypted iv
2629 */
2630       (cipher, string, pkey, ekey, eiv))
2631 {
2632         /* declarations for the cipher */
2633         const EVP_CIPHER *ciph;
2634         EVP_CIPHER_CTX ciphctx;
2635         /* declarations for the pkey */
2636         EVP_PKEY *pk;
2637         /* buffer for external ekey data */
2638         char *ekey_ext;
2639         int ekey_len;
2640         /* buffer for external eiv data */
2641         char *eiv_ext;
2642         /* buffer for output */
2643         unsigned char *outbuf;
2644         unsigned int outlen;
2645         Lisp_Object l_outbuf;
2646         /* buffer for external string data */
2647         char *string_ext;
2648         int string_len;
2649
2650         int tmplen;
2651
2652
2653         CHECK_SYMBOL(cipher);
2654         CHECK_STRING(string);
2655         CHECK_EVPPKEY(pkey);
2656         CHECK_STRING(ekey);
2657
2658
2659         pk = (XEVPPKEY(pkey))->evp_pkey;
2660         if (!ossl_pkey_has_private_data(pk))
2661                 error ("cannot open, key has no private key data");
2662
2663         TO_EXTERNAL_FORMAT (LISP_STRING, string,
2664                             C_STRING_ALLOCA, string_ext, OSSL_CODING);
2665         string_len = OSSL_STRING_LENGTH(string);
2666         TO_EXTERNAL_FORMAT (LISP_STRING, ekey,
2667                             C_STRING_ALLOCA, ekey_ext, OSSL_CODING);
2668         ekey_len = OSSL_STRING_LENGTH(ekey);
2669
2670         OpenSSL_add_all_algorithms();
2671         ciph = EVP_get_cipherbyname((char*)string_data(XSYMBOL(cipher)->name));
2672
2673         if (!ciph) {
2674                 EVP_cleanup();
2675                 error ("no such cipher");
2676                 return Qnil;
2677         }
2678
2679         if (NILP(eiv)) {
2680                 eiv_ext = NULL;
2681         } else {
2682                 CHECK_STRING(eiv);
2683                 TO_EXTERNAL_FORMAT (LISP_STRING, eiv,
2684                                     C_STRING_ALLOCA, eiv_ext, OSSL_CODING);
2685         }
2686
2687         /* now allocate some output buffer externally */
2688         outbuf = (unsigned char *)xmalloc_atomic(XSTRING_LENGTH(string));
2689
2690         EVP_CIPHER_CTX_init(&ciphctx);
2691         if (!EVP_OpenInit(&ciphctx, ciph,
2692                           (unsigned char*)ekey_ext,
2693                           (unsigned int)ekey_len,
2694                           (unsigned char*)eiv_ext, pk)) {
2695                 EVP_cleanup();
2696                 xfree(outbuf);
2697                 error ("error in OpenInit");
2698                 return Qnil;
2699         }
2700         if (!EVP_OpenUpdate(&ciphctx, outbuf, (int *)&outlen,
2701                             (unsigned char*)string_ext,
2702                             (unsigned int)string_len)) {
2703                 EVP_cleanup();
2704                 xfree(outbuf);
2705                 error ("error in OpenUpdate");
2706                 return Qnil;
2707         }
2708         if (!EVP_OpenFinal(&ciphctx, outbuf+outlen, &tmplen)) {
2709                 EVP_cleanup();
2710                 xfree(outbuf);
2711                 error ("error in OpenFinal");
2712                 return Qnil;
2713         }
2714         /* added probable padding space to the length of the output buffer */
2715         outlen += tmplen;
2716         EVP_CIPHER_CTX_cleanup(&ciphctx);
2717
2718         l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2719         xfree(outbuf);
2720
2721         EVP_cleanup();
2722
2723         return l_outbuf;
2724 }
2725
2726
2727 DEFUN("ossl-sign", Fossl_sign, 3, 3, 0, /*
2728 Return a signature obtained by signing STRING under DIGEST with PKEY.
2729
2730 That is, hash the message STRING with the message digest DIGEST and
2731 encrypt the result with the private key PKEY.
2732
2733 Note: Due to some relationship between the public key system and the
2734 message digest you cannot use every digest algorithm with every
2735 private key type.
2736 The most certain results will be achieved using
2737 RSA keys with RSA-* digests, DSA keys with DSA-* digests.
2738
2739 See `ossl-available-digests'.
2740
2741 Note: You probably want to put a wrapping encoder function
2742 (like `base16-encode-string') around it, since this returns
2743 binary string data.
2744 */
2745       (digest, string, pkey))
2746 {
2747         /* declarations for the cipher */
2748         const EVP_MD *md;
2749         EVP_MD_CTX mdctx;
2750         /* declarations for the pkey */
2751         EVP_PKEY *pk;
2752         /* buffer for output */
2753         unsigned char *outbuf;
2754         unsigned int outlen;
2755         Lisp_Object l_outbuf;
2756         /* buffer for external string data */
2757         char *string_ext;
2758         int string_len;
2759
2760
2761         CHECK_SYMBOL(digest);
2762         CHECK_STRING(string);
2763         CHECK_EVPPKEY(pkey);
2764
2765
2766         pk = (XEVPPKEY(pkey))->evp_pkey;
2767         if (!ossl_pkey_has_private_data(pk)) {
2768                 error ("cannot sign, key has no private key data");
2769         }
2770
2771         TO_EXTERNAL_FORMAT (LISP_STRING, string,
2772                             C_STRING_ALLOCA, string_ext, OSSL_CODING);
2773         string_len = OSSL_STRING_LENGTH(string);
2774
2775         OpenSSL_add_all_algorithms();
2776         md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2777
2778         if (!md) {
2779                 EVP_cleanup();
2780                 error ("no such digest");
2781                 return Qnil;
2782         }
2783
2784         /* now allocate some output buffer externally */
2785         outbuf = (unsigned char *)xmalloc_atomic(EVP_PKEY_size(pk));
2786
2787         EVP_MD_CTX_init(&mdctx);
2788         if (!(EVP_SignInit(&mdctx, md))) {
2789                 EVP_cleanup();
2790                 xfree(outbuf);
2791                 error ("error in SignInit");
2792                 return Qnil;
2793         }
2794         if (!EVP_SignUpdate(&mdctx, string_ext, string_len)) {
2795                 EVP_cleanup();
2796                 xfree(outbuf);
2797                 error ("error in SignUpdate");
2798                 return Qnil;
2799         }
2800         if (!EVP_SignFinal(&mdctx, outbuf, &outlen, pk)) {
2801                 EVP_cleanup();
2802                 xfree(outbuf);
2803                 error ("error in SignFinal");
2804                 return Qnil;
2805         }
2806         EVP_MD_CTX_cleanup(&mdctx);
2807
2808         l_outbuf = make_ext_string((char *)outbuf, outlen, OSSL_CODING);
2809         xfree(outbuf);
2810
2811         EVP_cleanup();
2812
2813         return l_outbuf;
2814 }
2815
2816 DEFUN("ossl-verify", Fossl_verify, 4, 4, 0, /*
2817 Return t iff SIG is a valid signature of STRING under DIGEST obtained by PKEY.
2818
2819 That is, hash the message STRING with the message digest DIGEST, then
2820 decrypt the signature SIG with the public key PKEY.
2821 Compare the results and return t iff both hashes are equal.
2822
2823 DIGEST is the digest to use (the same as in `ossl-sign')
2824 STRING is the message
2825 SIG is the signature of message
2826 PKEY is the public key
2827 */
2828       (digest, string, sig, pkey))
2829 {
2830         /* declarations for the cipher */
2831         const EVP_MD *md;
2832         EVP_MD_CTX mdctx;
2833         /* declarations for the pkey */
2834         EVP_PKEY *pk;
2835         /* buffer for external signature data */
2836         char *sig_ext;
2837         int sig_len;
2838         /* buffer for external string data */
2839         char *string_ext;
2840         int string_len;
2841
2842         int result;
2843
2844
2845         CHECK_SYMBOL(digest);
2846         CHECK_STRING(string);
2847         CHECK_STRING(sig);
2848         CHECK_EVPPKEY(pkey);
2849
2850
2851         pk = (XEVPPKEY(pkey))->evp_pkey;
2852         if (!ossl_pkey_has_public_data(pk))
2853                 error ("cannot verify, key has no public key data");
2854
2855         OpenSSL_add_all_algorithms();
2856         md = EVP_get_digestbyname((char*)string_data(XSYMBOL(digest)->name));
2857
2858         if (!md) {
2859                 EVP_cleanup();
2860                 error ("no such digest");
2861                 return Qnil;
2862         }
2863
2864         TO_EXTERNAL_FORMAT (LISP_STRING, string,
2865                             C_STRING_ALLOCA, string_ext, OSSL_CODING);
2866         string_len = OSSL_STRING_LENGTH(string);
2867         TO_EXTERNAL_FORMAT (LISP_STRING, sig,
2868                             C_STRING_ALLOCA, sig_ext, OSSL_CODING);
2869         sig_len = OSSL_STRING_LENGTH(sig);
2870
2871         EVP_MD_CTX_init(&mdctx);
2872         if (!EVP_VerifyInit(&mdctx, md)) {
2873                 EVP_cleanup();
2874                 error ("error in VerifyInit");
2875                 return Qnil;
2876         }
2877         if (!EVP_VerifyUpdate(&mdctx, string_ext, string_len)) {
2878                 EVP_cleanup();
2879                 error ("error in VerifyUpdate");
2880                 return Qnil;
2881         }
2882         result = EVP_VerifyFinal(&mdctx, (unsigned char*)sig_ext, sig_len, pk);
2883         if (result == -1) {
2884                 EVP_cleanup();
2885                 error ("error in VerifyFinal");
2886                 return Qnil;
2887         }
2888         EVP_MD_CTX_cleanup(&mdctx);
2889
2890         EVP_cleanup();
2891
2892         return result ? Qt : Qnil;
2893 }
2894
2895
2896 /*
2897  *
2898  * PEM
2899  *
2900  */
2901 DEFUN("ossl-pem-read-public-key", Fossl_pem_read_public_key, 1, 1, 0, /*
2902 Return a key (the public part) stored in a PEM structure from FILE.
2903 */
2904       (file))
2905 {
2906         /* declarations for the pkey */
2907         EVP_PKEY *pk;
2908         X509 *pk509;
2909
2910         /* output file */
2911         FILE *fp;
2912
2913         CHECK_STRING(file);
2914
2915         file = Fexpand_file_name(file, Qnil);
2916
2917         if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2918                 error ("error opening file.");
2919
2920         pk509 = PEM_read_X509(fp, NULL, NULL, NULL);
2921         pk = PEM_read_PUBKEY(fp, NULL, NULL, NULL);
2922
2923         fclose(fp);
2924
2925         return make_evp_pkey(pk, pk509);
2926 }
2927
2928 DEFUN("ossl-pem-read-key", Fossl_pem_read_key, 1, 2, 0, /*
2929 Return a key stored in a PEM structure from FILE.
2930 If the (private part of the) key is protected with a password
2931 provide (optional) PASSWORD.
2932 */
2933       (file, password))
2934 {
2935         /* declarations for the pkey */
2936         EVP_PKEY *pk;
2937         /* output file */
2938         FILE *fp;
2939         /* password pointer */
2940         char *pass;
2941
2942         CHECK_STRING(file);
2943
2944         file = Fexpand_file_name(file, Qnil);
2945
2946         if ((fp = fopen((char *)XSTRING_DATA(file), "r")) == NULL)
2947                 error ("error opening file.");
2948
2949         if (NILP(password)) {
2950                 pass = NULL;
2951         } else {
2952                 CHECK_STRING(password);
2953                 pass = (char *)XSTRING_DATA(password);
2954         }
2955
2956         pk = PEM_read_PrivateKey(fp, NULL, NULL, pass);
2957         fclose(fp);
2958         if (pk == NULL) {
2959                 /* now maybe it is a public key only */
2960                 return Fossl_pem_read_public_key(file);
2961         }
2962
2963         return make_evp_pkey_pk(pk);
2964 }
2965
2966 DEFUN("ossl-pem-write-public-key", Fossl_pem_write_public_key, 2, 2, 0, /*
2967 Write PKEY (the public part) in a PEM structure to FILE.
2968 */
2969       (file, pkey))
2970 {
2971         /* declarations for the pkey */
2972         EVP_PKEY *pk;
2973         X509 *pk509;
2974         /* output file */
2975         FILE *fp;
2976
2977         CHECK_STRING(file);
2978         CHECK_EVPPKEY(pkey);
2979
2980         file = Fexpand_file_name(file, Qnil);
2981
2982         pk = XEVPPKEY(pkey)->evp_pkey;
2983         pk509 = XEVPPKEY(pkey)->x509;
2984         SXE_SET_UNUSED(pk509);
2985
2986         if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL)
2987                 error ("error opening file.");
2988
2989         if (!PEM_write_PUBKEY(fp, pk)) {
2990                 fclose(fp);
2991                 error ("error writing PEM file.");
2992         }
2993
2994         fclose(fp);
2995
2996         return file;
2997 }
2998
2999 DEFUN("ossl-pem-write-key", Fossl_pem_write_key, 2, 4, 0, /*
3000 Write PKEY in a PEM structure to FILE. The key itself is
3001 protected by (optional) CIPHER with PASSWORD.
3002
3003 CIPHER can be set to nil and the key will not be encrypted.
3004 PASSWORD is ignored in this case.
3005 */
3006       (file, pkey, cipher, password))
3007 {
3008         const EVP_CIPHER *ciph;
3009         /* declarations for the pkey */
3010         EVP_PKEY *pk;
3011         X509 *pk509;
3012         /* output file */
3013         FILE *fp;
3014         /* password pointer */
3015         char *pass;
3016
3017         CHECK_STRING(file);
3018         CHECK_EVPPKEY(pkey);
3019
3020         file = Fexpand_file_name(file, Qnil);
3021
3022         pk = XEVPPKEY(pkey)->evp_pkey;
3023         pk509 = XEVPPKEY(pkey)->x509;
3024         SXE_SET_UNUSED(pk509);
3025
3026         if (!ossl_pkey_has_private_data(pk))
3027                 return Fossl_pem_write_public_key(file, pkey);
3028
3029         CHECK_SYMBOL(cipher);
3030
3031         OpenSSL_add_all_algorithms();
3032
3033         if (NILP(cipher)) {
3034                 ciph = NULL;
3035                 pass = NULL;
3036         } else {
3037                 ciph = EVP_get_cipherbyname(
3038                         (char *)string_data(XSYMBOL(cipher)->name));
3039                 if (!ciph) {
3040                         EVP_cleanup();
3041                         error ("no such cipher");
3042                 }
3043         }
3044
3045         if (NILP(password)) {
3046                 ciph = NULL;
3047                 pass = NULL;
3048         } else {
3049                 CHECK_STRING(password);
3050                 pass = (char *)XSTRING_DATA(password);
3051         }
3052
3053         if ((fp = fopen((char *)XSTRING_DATA(file), "w")) == NULL) {
3054                 EVP_cleanup();
3055                 error ("error opening file.");
3056         }
3057
3058         if (!PEM_write_PKCS8PrivateKey(fp, pk, ciph, NULL, 0, NULL, pass)) {
3059                 EVP_cleanup();
3060                 fclose(fp);
3061                 error ("error writing PEM file.");
3062         }
3063
3064         EVP_cleanup();
3065         fclose(fp);
3066
3067         return file;
3068 }
3069
3070 static long
3071 ossl_pem_pkey_cb(BIO *bio, int cmd, const char *argp,
3072                  int argi, long argl, long ret)
3073 {
3074         Lisp_Object key;
3075         void *foo = BIO_get_callback_arg(bio);
3076
3077         if (!(key = (Lisp_Object)foo)) {
3078                 return ret;
3079         }
3080
3081         if (BIO_CB_RETURN & cmd) {
3082                 return ret;
3083         }
3084
3085         switch (cmd) {
3086         case BIO_CB_WRITE:
3087                 key = concat2(key, make_ext_string(argp, argi, OSSL_CODING));
3088                 BIO_set_callback_arg(bio, (void*)key);
3089                 break;
3090         default:
3091                 return ret;
3092         }
3093         return ret;
3094 }
3095
3096 DEFUN("ossl-pem-public-key",Fossl_pem_public_key, 1, 1, 0, /*
3097 Return PKEY as PEM encoded string.
3098 */
3099       (pkey))
3100 {
3101         /* This function can GC */
3102         /* declarations for the pkey */
3103         EVP_PKEY *pk;
3104         Lisp_Object result;
3105         /* bio stuff */
3106         BIO *b;
3107         /* gc stuff */
3108         struct gcpro gcpro1;
3109
3110         GCPRO1(pkey);
3111
3112         CHECK_EVPPKEY(pkey);
3113
3114         pk = (XEVPPKEY(pkey))->evp_pkey;
3115
3116         if (!(b = BIO_new(BIO_s_null()))) {
3117                 UNGCPRO;
3118                 error("cannot open memory buffer");
3119                 return Qnil;
3120         }
3121
3122         result = build_string("");
3123         BIO_set_callback(b, ossl_pem_pkey_cb);
3124         BIO_set_callback_arg(b, (void*)result);
3125
3126         if (!PEM_write_bio_PUBKEY(b, pk)) {
3127                 EVP_cleanup();
3128                 BIO_free(b);
3129                 UNGCPRO;
3130                 error ("error creating PEM string");
3131                 return Qnil;
3132         }
3133
3134         {
3135                 void *foo = BIO_get_callback_arg(b);
3136                 if (!(result = (Lisp_Object)foo)) {
3137                         result = Qnil;
3138                 }
3139         }
3140
3141         BIO_free(b);
3142
3143         UNGCPRO;
3144         return result;
3145 }
3146
3147 DEFUN("ossl-pem-key",Fossl_pem_key, 1, 3, 0, /*
3148 Return PKEY as PEM encoded string.   The key itself is
3149 protected by (optional) CIPHER with PASSWORD.
3150
3151 CIPHER can be set to nil and the key will not be encrypted.
3152 PASSWORD is ignored in this case.
3153 */
3154       (pkey, cipher, password))
3155 {
3156         /* This function can GC */
3157         /* declarations for the pkey */
3158         EVP_PKEY *pk;
3159         Lisp_Object result;
3160         const EVP_CIPHER *ciph;
3161         char *pass;
3162         /* bio stuff */
3163         BIO *b;
3164         struct gcpro gcpro1, gcpro2, gcpro3;
3165
3166         GCPRO3(pkey, cipher, password);
3167
3168         CHECK_EVPPKEY(pkey);
3169
3170         pk = (XEVPPKEY(pkey))->evp_pkey;
3171
3172         if (!ossl_pkey_has_private_data(pk)) {
3173                 UNGCPRO;
3174                 return Fossl_pem_public_key(pkey);
3175         }
3176
3177         CHECK_SYMBOL(cipher);
3178
3179         OpenSSL_add_all_algorithms();
3180
3181         if (NILP(cipher)) {
3182                 ciph = NULL;
3183                 pass = NULL;
3184         } else {
3185                 ciph = EVP_get_cipherbyname(
3186                         (char *)string_data(XSYMBOL(cipher)->name));
3187                 if (!ciph) {
3188                         EVP_cleanup();
3189                         UNGCPRO;
3190                         error ("no such cipher");
3191                         return Qnil;
3192                 }
3193         }
3194
3195         if (NILP(password)) {
3196                 ciph = NULL;
3197                 pass = NULL;
3198         } else {
3199                 CHECK_STRING(password);
3200                 pass = (char *)XSTRING_DATA(password);
3201         }
3202
3203         if (!(b = BIO_new(BIO_s_null()))) {
3204                 UNGCPRO;
3205                 error("cannot open memory buffer");
3206                 return Qnil;
3207         }
3208
3209         result = build_string("");
3210         BIO_set_callback(b, ossl_pem_pkey_cb);
3211         BIO_set_callback_arg(b, (void*)result);
3212
3213         if (!PEM_write_bio_PKCS8PrivateKey(b, pk, ciph, NULL, 0, NULL, pass)) {
3214                 EVP_cleanup();
3215                 BIO_free(b);
3216                 UNGCPRO;
3217                 error ("error creating PEM string");
3218                 return Qnil;
3219         }
3220
3221         {
3222                 void *foo = BIO_get_callback_arg(b);
3223
3224                 if (!(result = (Lisp_Object)foo)) {
3225                         result = Qnil;
3226                 }
3227         }
3228
3229         BIO_free(b);
3230
3231         UNGCPRO;
3232         return result;
3233 }
3234
3235 \f
3236 /*
3237  *
3238  * SSL
3239  * The SSL support in this API is sorta high level since having
3240  * server hellos, handshakes and stuff like that is not what you want
3241  * to do in elisp.
3242  *
3243  */
3244 /* This is an opaque object for storing PKEYs in lisp */
3245 Lisp_Object Qssl_connp;
3246
3247 Lisp_Object
3248 make_ssl_conn(Lisp_SSL_CONN *ssl_conn)
3249 {
3250         Lisp_Object lisp_ssl_conn;
3251         XSETSSLCONN(lisp_ssl_conn, ssl_conn);
3252         return lisp_ssl_conn;
3253 }
3254
3255 static Lisp_Object
3256 mark_ssl_conn(Lisp_Object obj)
3257 {
3258         mark_object(XSSLCONN(obj)->parent);
3259         mark_object(XSSLCONN(obj)->pipe_instream);
3260         mark_object(XSSLCONN(obj)->pipe_outstream);
3261 #ifdef FILE_CODING
3262         mark_object(XSSLCONN(obj)->coding_instream);
3263         mark_object(XSSLCONN(obj)->coding_outstream);
3264 #endif
3265
3266         return Qnil;
3267 }
3268
3269 static void
3270 print_ssl_conn(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3271 {
3272         SSL *conn;
3273         Lisp_Object parent;
3274
3275         conn = XSSLCONN(obj)->ssl_conn;
3276         parent = XSSLCONN(obj)->parent;
3277
3278         write_c_string("#<OpenSSL socket layer: ", printcharfun);
3279         if (conn == NULL)
3280                 write_c_string("dead", printcharfun);
3281         else
3282                 write_c_string(SSL_get_version(conn), printcharfun);
3283
3284 #ifdef HAVE_SOCKETS
3285         if (PROCESSP(parent)) {
3286                 write_c_string(" on top of ", printcharfun);
3287                 print_internal(parent, printcharfun, escapeflag);
3288         }
3289 #endif  /* HAVE_SOCKETS */
3290
3291 #ifdef HAVE_POSTGRESQL
3292         if (PGCONNP(parent) &&
3293             PQstatus(XPGCONN(parent)->pgconn) == CONNECTION_OK) {
3294                 write_c_string(" on top of ", printcharfun);
3295                 print_internal(parent, printcharfun, escapeflag);
3296         }
3297 #endif  /* HAVE_POSTGRESQL */
3298         write_c_string(">", printcharfun);
3299 }
3300
3301 Lisp_SSL_CONN *
3302 allocate_ssl_conn(void)
3303 {
3304         Lisp_SSL_CONN *ssl_conn =
3305                 alloc_lcrecord_type(Lisp_SSL_CONN, &lrecord_ssl_conn);
3306
3307         /* the network process stuff */
3308         ssl_conn->parent = Qnil;
3309         ssl_conn->infd = -1;
3310         ssl_conn->outfd = -1;
3311
3312         ssl_conn->connected_p = 0;
3313         ssl_conn->protected_p = 0;
3314
3315         ssl_conn->pipe_instream = Qnil;
3316         ssl_conn->pipe_outstream = Qnil;
3317 #if FILE_CODING
3318         ssl_conn->coding_instream = Qnil;
3319         ssl_conn->coding_outstream = Qnil;
3320 #endif
3321
3322         return ssl_conn;
3323 }
3324
3325 static void
3326 finalise_ssl_conn(void *header, int for_disksave)
3327 {
3328         Lisp_SSL_CONN *ssl_conn = (Lisp_SSL_CONN *) header;
3329
3330         if (!(ssl_conn->ssl_conn == NULL)) {
3331                 if (ssl_conn->connected_p)
3332                         SSL_shutdown(ssl_conn->ssl_conn);
3333                 SSL_free(ssl_conn->ssl_conn);
3334                 ssl_conn->ssl_conn = NULL;
3335         }
3336         if (!(ssl_conn->ssl_ctx == NULL)) {
3337                 SSL_CTX_free(ssl_conn->ssl_ctx);
3338                 ssl_conn->ssl_ctx = NULL;
3339         }
3340         ssl_conn->ssl_bio = NULL;
3341
3342         if (PROCESSP(ssl_conn->parent)) {
3343                 XPROCESS(ssl_conn->parent)->process_type = PROCESS_TYPE_NETWORK;
3344                 XPROCESS(ssl_conn->parent)->process_type_data = Qnil;
3345         }
3346         /* we leave the process alive, it's not our fault, but
3347          * we nullify its pointer
3348          */
3349         ssl_conn->parent = Qnil;
3350         ssl_conn->infd = -1;
3351         ssl_conn->outfd = -1;
3352
3353         ssl_conn->connected_p = 0;
3354         ssl_conn->protected_p = 0;
3355
3356         /* free the lstream resources */
3357 #if 0                           /* will lead to problems */
3358         if (LSTREAMP(ssl_conn->pipe_instream))
3359                 Lstream_delete(XLSTREAM(ssl_conn->pipe_instream));
3360         if (LSTREAMP(ssl_conn->pipe_outstream))
3361                 Lstream_delete(XLSTREAM(ssl_conn->pipe_outstream));
3362 #endif
3363         ssl_conn->pipe_instream = Qnil;
3364         ssl_conn->pipe_outstream = Qnil;
3365 #if FILE_CODING
3366 #if 0                           /* will lead to problems */
3367         if (LSTREAMP(ssl_conn->coding_instream))
3368                 Lstream_delete(XLSTREAM(ssl_conn->coding_instream));
3369         if (LSTREAMP(ssl_conn->coding_outstream))
3370                 Lstream_delete(XLSTREAM(ssl_conn->coding_outstream));
3371 #endif
3372         ssl_conn->coding_instream = Qnil;
3373         ssl_conn->coding_outstream = Qnil;
3374 #endif
3375
3376         /* avoid some warning */
3377         if (for_disksave);
3378 }
3379
3380 DEFINE_LRECORD_IMPLEMENTATION("ssl_conn", ssl_conn,
3381                               mark_ssl_conn, print_ssl_conn,
3382                               finalise_ssl_conn,
3383                               NULL, NULL, 0, Lisp_SSL_CONN);
3384
3385 static int
3386 ssl_conn_alive_p(Lisp_SSL_CONN *ssl_conn)
3387 {
3388         return ssl_conn->connected_p;
3389 }
3390
3391 static int
3392 get_process_infd(Lisp_Process * p)
3393 {
3394         Lisp_Object instr, outstr;
3395         get_process_streams(p, &instr, &outstr);
3396         return Lstream_get_fd(XLSTREAM(instr));
3397 }
3398 static int
3399 get_process_outfd(Lisp_Process * p)
3400 {
3401         Lisp_Object instr, outstr;
3402         get_process_streams(p, &instr, &outstr);
3403         return Lstream_get_fd(XLSTREAM(outstr));
3404 }
3405
3406 static int
3407 event_stream_ssl_create_stream_pair(
3408         SSL *conn,
3409         Lisp_Object *instream, Lisp_Object *outstream, int flags)
3410 {
3411         *instream = make_ssl_input_stream(conn, flags);
3412         *outstream = make_ssl_output_stream(conn, flags);
3413
3414         return 0;
3415 }
3416
3417 static void
3418 init_ssl_io_handles(Lisp_SSL_CONN *s, int flags)
3419 {
3420         event_stream_ssl_create_stream_pair(
3421                 s->ssl_conn, &s->pipe_instream, &s->pipe_outstream, flags);
3422
3423 #ifdef FILE_CODING
3424         s->coding_instream = make_decoding_input_stream(
3425                 XLSTREAM(s->pipe_instream), Fget_coding_system(
3426                         Vcoding_system_for_read));
3427         Lstream_set_character_mode(XLSTREAM(s->coding_instream));
3428         s->coding_outstream = make_encoding_output_stream(
3429                 XLSTREAM(s->pipe_outstream), Fget_coding_system(
3430                         Vcoding_system_for_write));
3431 #endif /* FILE_CODING */
3432 }
3433
3434 /* Advanced step-by-step initialisation */
3435 #define OSSL_CHECK_PROCESS(process)                                     \
3436 do {                                                                    \
3437         /* Make sure the process is really alive.  */                   \
3438         if (!EQ(XPROCESS(process)->status_symbol, Qrun))                \
3439                 error("Network stream %s not alive",                    \
3440                       XSTRING_DATA(XPROCESS(process)->name));           \
3441         /* Make sure the process is a network stream. */                \
3442         if (!network_connection_p(process))                             \
3443                 error("Process %s is not a network stream",             \
3444                       XSTRING_DATA(XPROCESS(process)->name));           \
3445 } while (0);
3446
3447 #ifdef OSSL_DEBUG_FLAG
3448 static long
3449 ossl_bio_dump_callback(BIO *bio, int cmd, const char *argp,
3450                   int argi, long argl, long ret)
3451 {
3452         BIO *out;
3453
3454         out=(BIO *)BIO_get_callback_arg(bio);
3455         if (out == NULL) return(ret);
3456
3457         if (cmd == (BIO_CB_READ|BIO_CB_RETURN))
3458         {
3459                 BIO_printf(out,"read from %p [%p] (%d bytes => %ld (0x%lX))\n",
3460                            (void *)bio,argp,argi,ret,ret);
3461                 BIO_dump(out,argp,(int)ret);
3462                 return(ret);
3463         }
3464         else if (cmd == (BIO_CB_WRITE|BIO_CB_RETURN))
3465         {
3466                 BIO_printf(out,"write to %p [%p] (%d bytes => %ld (0x%lX))\n",
3467                            (void *)bio,argp,argi,ret,ret);
3468                 BIO_dump(out,argp,(int)ret);
3469         }
3470         return(ret);
3471 }
3472 #endif
3473
3474 static Lisp_Object
3475 ossl_ssl_prepare_cmeth(Lisp_Object method)
3476 {
3477         SSL_METHOD *meth = NULL;
3478         Lisp_SSL_CONN *lisp_ssl_conn;
3479
3480         /* start preparing the conn object */
3481         SSL_library_init();
3482         SSL_load_error_strings();
3483
3484         /* I would love to make 'meth' const SSL_METHOD* as well as the
3485            'ssl_meth' member of 'Lisp_SSL_CONN' unfortunately not all
3486            supported versions of OpenSSL then take const SSL_METHOD*
3487            as arguments, so turning off the cast qualifier warning and
3488            store non-const is a more reasonable solution.
3489         */
3490 #pragma GCC diagnostic push
3491 #pragma GCC diagnostic ignored "-Wcast-qual"
3492         if (0) {
3493         } else if (EQ(method, Qssl2)) {
3494 #if HAVE_SSLV2_CLIENT_METHOD
3495                 meth = (SSL_METHOD *)SSLv2_client_method();
3496 #else
3497                 error("sslv2 client method not supported");
3498 #endif
3499         } else if (EQ(method, Qssl3)) {
3500 #if HAVE_SSLV3_CLIENT_METHOD
3501                 meth = (SSL_METHOD *)SSLv3_client_method();
3502 #else
3503                 error("sslv3 client method not supported");
3504 #endif
3505         } else if (EQ(method, Qssl23)) {
3506 #if HAVE_SSLV23_CLIENT_METHOD
3507                 meth = (SSL_METHOD *)SSLv23_client_method();
3508 #else
3509                 error("sslv23 client method not supported");
3510 #endif
3511         } else if (EQ(method, Qtls1)) {
3512 #if HAVE_TLSV1_CLIENT_METHOD
3513                 meth = (SSL_METHOD *)TLSv1_client_method();
3514 #else
3515                 error("tlsv1 client method not supported");
3516 #endif
3517         } else {
3518 #if HAVE_TLSV1_CLIENT_METHOD
3519                 meth = (SSL_METHOD *)TLSv1_client_method();
3520 #else
3521                 error("default tlsv1 client method not supported");
3522 #endif
3523         }
3524 #pragma GCC diagnostic pop
3525         if (!RAND_status())
3526                 error("OSSL: not enough random data");
3527
3528         /* now allocate this stuff, pump it and return */
3529         lisp_ssl_conn = allocate_ssl_conn();
3530         lisp_ssl_conn->ssl_meth = meth;
3531         lisp_ssl_conn->ssl_ctx = NULL;
3532         lisp_ssl_conn->ssl_conn = NULL;
3533         lisp_ssl_conn->ssl_bio = NULL;
3534
3535         return make_ssl_conn(lisp_ssl_conn);
3536 }
3537
3538 static Lisp_Object
3539 ossl_ssl_prepare_smeth(Lisp_Object method)
3540 {
3541         SSL_METHOD *meth = NULL;
3542         Lisp_SSL_CONN *lisp_ssl_conn;
3543
3544         /* start preparing the conn object */
3545         SSL_library_init();
3546         SSL_load_error_strings();
3547
3548         /* I would love to make 'meth' const SSL_METHOD* as well as the
3549            'ssl_meth' member of 'Lisp_SSL_CONN' unfortunately not all
3550            supported versions of OpenSSL then take const SSL_METHOD*
3551            as arguments, so turning off the cast qualifier warning and
3552            store non-const is a more reasonable solution. 
3553         */
3554 #pragma GCC diagnostic push
3555 #pragma GCC diagnostic ignored "-Wcast-qual"
3556         if (0) {
3557         } else if (EQ(method, Qssl2)) {
3558 #if HAVE_SSLV2_SERVER_METHOD
3559                 meth = (SSL_METHOD *)SSLv2_server_method();
3560 #else
3561                 error("sslv2 client method not supported");
3562 #endif
3563         } else if (EQ(method, Qssl3)) {
3564 #if HAVE_SSLV3_SERVER_METHOD
3565                 meth = (SSL_METHOD *)SSLv3_server_method();
3566 #else
3567                 error("sslv3 client method not supported");
3568 #endif
3569         } else if (EQ(method, Qssl23)) {
3570 #if HAVE_SSLV23_SERVER_METHOD
3571                 meth = (SSL_METHOD *)SSLv23_server_method();
3572 #else
3573                 error("sslv23 client method not supported");
3574 #endif
3575         } else if (EQ(method, Qtls1)) {
3576 #if HAVE_TLSV1_SERVER_METHOD
3577                 meth = (SSL_METHOD *)TLSv1_server_method();
3578 #else
3579                 error("tlsv1 client method not supported");
3580 #endif
3581         } else {
3582 #if HAVE_SSLV23_SERVER_METHOD
3583                 meth = (SSL_METHOD *)SSLv23_server_method();
3584 #else
3585                 error("default sslv23 client method not supported");
3586 #endif
3587         }
3588 #pragma GCC diagnostic pop
3589         if (!RAND_status())
3590                 error("OSSL: not enough random data");
3591
3592         /* now allocate this stuff, pump it and return */
3593         lisp_ssl_conn = allocate_ssl_conn();
3594         lisp_ssl_conn->ssl_meth = meth;
3595         lisp_ssl_conn->ssl_ctx = NULL;
3596         lisp_ssl_conn->ssl_conn = NULL;
3597         lisp_ssl_conn->ssl_bio = NULL;
3598
3599         return make_ssl_conn(lisp_ssl_conn);
3600 }
3601
3602 static Lisp_Object
3603 ossl_ssl_prepare_ctx(Lisp_Object ssl_conn)
3604 {
3605         /* SSL connection stuff */
3606         SSL_CTX *ctx = NULL;
3607         Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3608
3609         ctx = SSL_CTX_new(lisp_ssl_conn->ssl_meth);
3610         if (ctx == NULL)
3611                 error("OSSL: context initialisation failed");
3612
3613         /* OpenSSL contains code to work-around lots of bugs and flaws in
3614          * various SSL-implementations. SSL_CTX_set_options() is used to enabled
3615          * those work-arounds. The man page for this option states that
3616          * SSL_OP_ALL enables all the work-arounds and that "It is usually safe
3617          * to use SSL_OP_ALL to enable the bug workaround options if
3618          * compatibility with somewhat broken implementations is desired."
3619          */
3620         SSL_CTX_set_options(ctx, SSL_OP_ALL);
3621
3622         lisp_ssl_conn->ssl_ctx = ctx;
3623
3624         return ssl_conn;
3625 }
3626
3627 static Lisp_Object
3628 ossl_ssl_prepare(Lisp_Object ssl_conn, void(*fun)(SSL*))
3629 {
3630         /* SSL connection stuff */
3631         SSL *conn = NULL;
3632         BIO *bio = NULL;
3633 #ifdef OSSL_DEBUG_FLAG
3634         BIO *bio_c_out = NULL;
3635 #endif
3636         Lisp_SSL_CONN *lisp_ssl_conn = XSSLCONN(ssl_conn);
3637
3638         /* now initialise a new connection context */
3639         conn = SSL_new(lisp_ssl_conn->ssl_ctx);
3640         if (conn == NULL || fun == NULL)
3641                 error("OSSL: connection initialisation failed");
3642
3643         /* always renegotiate */
3644         SSL_set_mode(conn, SSL_MODE_AUTO_RETRY);
3645
3646         /* initialise the main connection BIO */
3647         bio = BIO_new(BIO_s_socket());
3648
3649 #ifdef OSSL_DEBUG_FLAG
3650         /* this is a debug BIO which pukes tons of stuff to stderr */
3651         bio_c_out = BIO_new_fp(stderr, BIO_NOCLOSE);
3652         BIO_set_callback(bio, ossl_bio_dump_callback);
3653         BIO_set_callback_arg(bio, bio_c_out);
3654 #endif
3655
3656         /* connect SSL with the bio */
3657         SSL_set_bio(conn, bio, bio);
3658         /* turn into client or server */
3659         fun(conn);
3660
3661         /* now allocate this stuff, pump it and return */
3662         lisp_ssl_conn->ssl_conn = conn;
3663         lisp_ssl_conn->ssl_bio = bio;
3664
3665         /* create lstream handles */
3666         init_ssl_io_handles(lisp_ssl_conn, STREAM_NETWORK_CONNECTION);
3667
3668         return ssl_conn;
3669 }
3670
3671 /* Injection of CA certificates */
3672 int ossl_ssl_inject_ca(Lisp_Object ssl_conn, Lisp_Object cacert)
3673 {
3674         SSL_CTX *ctx;
3675         EVP_PKEY *cert;
3676         X509 *xc509;
3677
3678         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3679         cert = XEVPPKEY(cacert)->evp_pkey;
3680         xc509 = XEVPPKEY(cacert)->x509;
3681
3682         if (cert && !xc509) {
3683                 xc509 = X509_new();
3684                 X509_set_pubkey(xc509, cert);
3685                 XEVPPKEY(cacert)->x509 = xc509;
3686         } else if (xc509);
3687         else
3688                 return 0;
3689
3690         /* what about coding system issues? */
3691         if (!SSL_CTX_add_client_CA(ctx, xc509))
3692                 return 0;
3693         else
3694                 return -1;
3695 }
3696
3697 int ossl_ssl_inject_ca_file(Lisp_Object ssl_conn, Lisp_Object cafile)
3698 {
3699         SSL_CTX *ctx;
3700
3701         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3702
3703         /* what about coding system issues? */
3704         if (!SSL_CTX_load_verify_locations(
3705                     ctx, (char*)XSTRING_DATA(cafile), NULL))
3706                 return 0;
3707         else
3708                 return -1;
3709 }
3710
3711 int ossl_ssl_inject_ca_path(Lisp_Object ssl_conn, Lisp_Object capath)
3712 {
3713         SSL_CTX *ctx;
3714
3715         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3716
3717         /* what about coding system issues? */
3718         if (!SSL_CTX_load_verify_locations(
3719                     ctx, NULL, (char*)XSTRING_DATA(capath)))
3720                 return 0;
3721         else
3722                 return -1;
3723 }
3724
3725 int ossl_ssl_inject_cert(Lisp_Object ssl_conn,
3726                          Lisp_Object cert, Lisp_Object key)
3727 {
3728         SSL_CTX *ctx;
3729         EVP_PKEY *pkey;
3730         EVP_PKEY *xcert;
3731         X509 *xc509;
3732
3733         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3734         pkey = XEVPPKEY(key)->evp_pkey;
3735         xcert = XEVPPKEY(cert)->evp_pkey;
3736         xc509 = XEVPPKEY(cert)->x509;
3737
3738         if (xcert && !xc509) {
3739                 xc509 = X509_new();
3740                 X509_set_pubkey(xc509, xcert);
3741                 XEVPPKEY(cert)->x509 = xc509;
3742         } else if (xc509);
3743         else
3744                 return 0;
3745
3746         if (SSL_CTX_use_certificate(ctx, xc509) <= 0)
3747                 return 0;
3748
3749         if (SSL_CTX_use_PrivateKey(ctx, pkey) <= 0)
3750                 return 0;
3751         if (!SSL_CTX_check_private_key(ctx))
3752                 return 0;
3753
3754         return -1;
3755 }
3756
3757 int ossl_ssl_inject_cert_file(Lisp_Object ssl_conn,
3758                               Lisp_Object cert, Lisp_Object key)
3759 {
3760         SSL_CTX *ctx;
3761
3762         ctx = XSSLCONN(ssl_conn)->ssl_ctx;
3763
3764         if (SSL_CTX_use_certificate_file(
3765                     ctx, (char*)XSTRING_DATA(cert), SSL_FILETYPE_PEM) <= 0)
3766                 return 0;
3767         if (SSL_CTX_use_PrivateKey_file(
3768                     ctx, (char*)XSTRING_DATA(key), SSL_FILETYPE_PEM) <= 0)
3769                 return 0;
3770         if (!SSL_CTX_check_private_key(ctx))
3771                 return 0;
3772
3773         return -1;
3774 }
3775
3776 Lisp_Object ossl_ssl_handshake(Lisp_Object ssl_conn, Lisp_Object process)
3777 {
3778         /* This function can GC */
3779         /* SSL connection stuff */
3780         SSL *conn = NULL;
3781         BIO *bio = NULL;
3782 #if 0 && defined(OSSL_DEBUG_FLAG)
3783         BIO *bio_c_out = NULL;
3784 #endif
3785         int ret, err, infd, outfd;
3786
3787         struct gcpro gcpro1, gcpro2;
3788
3789         /* Make sure we have a process, the alive check should be done in the
3790            function calling this here */
3791         CHECK_PROCESS(process);
3792
3793         GCPRO2(ssl_conn, process);
3794
3795         /* set the alternate one */
3796         event_stream_unselect_process(XPROCESS(process));
3797
3798 #ifdef HAVE_MULE
3799         /* just announce that we are very binary */
3800         Fset_process_coding_system(process, Qbinary, Qbinary);
3801 #endif
3802
3803         /* initialise the process' buffer for type-specific data,
3804          * we will store process input there */
3805         XPROCESS(process)->process_type_data = Qnil;
3806
3807         /* retrieve the sockets of the process */
3808         infd = get_process_infd(XPROCESS(process));
3809         outfd = get_process_outfd(XPROCESS(process));
3810
3811         /* push data to ssl_conn */
3812         XSSLCONN(ssl_conn)->parent = process;
3813         XSSLCONN(ssl_conn)->infd = infd;
3814         XSSLCONN(ssl_conn)->outfd = outfd;
3815
3816         /* frob vars from ssl_conn */
3817         conn = XSSLCONN(ssl_conn)->ssl_conn;
3818         bio = XSSLCONN(ssl_conn)->ssl_bio;
3819
3820         /* initialise the main connection BIO */
3821         BIO_set_fd(bio, infd, 0);
3822
3823         /* now perform the actual handshake
3824          * this is a loop because of the genuine openssl concept to not handle
3825          * non-blocking I/O correctly */
3826         for (;;) {
3827                 struct timeval to;
3828
3829                 ret = SSL_do_handshake(conn);
3830                 err = SSL_get_error(conn, ret);
3831
3832                 /* perform select() with timeout
3833                  * 1 second at the moment */
3834                 to.tv_sec = 1;
3835                 to.tv_usec = 0;
3836
3837                 if (err == SSL_ERROR_NONE) {
3838                         break;
3839                 } else if (err == SSL_ERROR_WANT_READ) {
3840                         fd_set read_fds;
3841                         OSSL_DEBUG("WANT_READ\n");
3842
3843                         FD_ZERO(&read_fds);
3844                         FD_SET(infd, &read_fds);
3845
3846                         /* wait for socket to be readable */
3847                         if (!(ret = select(infd+1, &read_fds, 0, NULL, &to))) {
3848                                 UNGCPRO;
3849                                 finalise_ssl_conn(XSSLCONN(ssl_conn), 0);
3850                                 error("timeout during handshake");