1 /*  Part of SWI-Prolog
2 
3     Author:        Markus Triska
4     E-mail:        triska@metalevel.at
5     WWW:           http://www.swi-prolog.org
6     Copyright (c)  2004-2016, SWI-Prolog Foundation
7     All rights reserved.
8 
9     Redistribution and use in source and binary forms, with or without
10     modification, are permitted provided that the following conditions
11     are met:
12 
13     1. Redistributions of source code must retain the above copyright
14        notice, this list of conditions and the following disclaimer.
15 
16     2. Redistributions in binary form must reproduce the above copyright
17        notice, this list of conditions and the following disclaimer in
18        the documentation and/or other materials provided with the
19        distribution.
20 
21     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24     FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25     COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26     INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27     BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29     CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31     ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32     POSSIBILITY OF SUCH DAMAGE.
33 */
34 
35 #include <config.h>
36 #include <string.h>
37 
38 #include "cryptolib.h"
39 
40 /* OPENSSL_zalloc is only used in the EVP_MD_CTX_new defined below */
41 #if !defined(HAVE_OPENSSL_ZALLOC) && !defined(OPENSSL_zalloc) && !defined(HAVE_EVP_MD_CTX_FREE)
42 static void *
OPENSSL_zalloc(size_t num)43 OPENSSL_zalloc(size_t num)
44 { void *ret = OPENSSL_malloc(num);
45   if (ret != NULL)
46     memset(ret, 0, num);
47   return ret;
48 }
49 #endif
50 
51 #ifndef HAVE_EVP_MD_CTX_FREE
52 static inline void
EVP_MD_CTX_free(EVP_MD_CTX * ctx)53 EVP_MD_CTX_free(EVP_MD_CTX *ctx)
54 { EVP_MD_CTX_cleanup(ctx);
55   OPENSSL_free(ctx);
56 }
57 
58 static inline EVP_MD_CTX *
EVP_MD_CTX_new(void)59 EVP_MD_CTX_new(void)
60 { return OPENSSL_zalloc(sizeof(EVP_MD_CTX));
61 }
62 #endif
63 
64 static int
unify_bytes_hex(term_t t,size_t len,const unsigned char * data)65 unify_bytes_hex(term_t t, size_t len, const unsigned char *data)
66 { char tmp[512];
67   char *out, *o;
68   static const char *tohex = "0123456789ABCDEF";
69   const unsigned char *end = data+len;
70   int rc;
71 
72   if ( len*2 <= sizeof(tmp) )
73     out = tmp;
74   else if ( !(out = malloc(len*2)) )
75     return PL_resource_error("memory");
76 
77   for(o=out ; data < end; data++)
78   { *o++ = tohex[(*data >> 4) & 0xf];
79     *o++ = tohex[(*data >> 0) & 0xf];
80   }
81 
82   rc = PL_unify_chars(t, PL_STRING|REP_ISO_LATIN_1, len*2, out);
83   if ( out != tmp )
84     free(out);
85 
86   return rc;
87 }
88 
89 static char *
ssl_strdup(const char * s)90 ssl_strdup(const char *s)
91 {
92     char *new = NULL;
93 
94     if (s != NULL && (new = malloc(strlen(s)+1)) != NULL) {
95         strcpy(new, s);
96     }
97     return new;
98 }
99 
100 
101 /***********************************************************************
102  * Warning, error and debug reporting
103  ***********************************************************************/
104 
105 /**
106  * ssl_error_term(long ex) returns a Prolog term representing the SSL
107  * error.  If there is already a pending exception, this is returned.
108  *
109  */
110 static int
ssl_error_term(long e)111 ssl_error_term(long e)
112 { term_t ex;
113   char buffer[256];
114   char* colon;
115   char *component[5] = {NULL, "unknown", "unknown", "unknown", "unknown"};
116   int n = 0;
117   static functor_t FUNCTOR_error2 = 0;
118   static functor_t FUNCTOR_ssl_error4 = 0;
119 
120   if ( (ex=PL_exception(0)) )
121     return ex;					/* already pending exception */
122 
123   if ( !FUNCTOR_error2 )
124   { FUNCTOR_error2     = PL_new_functor(PL_new_atom("error"),     2);
125     FUNCTOR_ssl_error4 = PL_new_functor(PL_new_atom("ssl_error"), 4);
126   }
127 
128   ERR_error_string_n(e, buffer, 256);
129 
130   /*
131    * Disect the following error string:
132    *
133    * error:[error code]:[library name]:[function name]:[reason string]
134    */
135   if ( (ex=PL_new_term_ref()) )
136   { for (colon = buffer, n = 0; n < 5 && colon != NULL; n++)
137     { component[n] = colon;
138       if ((colon = strchr(colon, ':')) == NULL) break;
139       *colon++ = 0;
140     }
141     if ( PL_unify_term(ex,
142 		       PL_FUNCTOR, FUNCTOR_error2,
143 		       PL_FUNCTOR, FUNCTOR_ssl_error4,
144 		       PL_CHARS, component[1],
145 		       PL_CHARS, component[2],
146 		       PL_CHARS, component[3],
147 		       PL_CHARS, component[4],
148 		       PL_VARIABLE) )
149     { return ex;
150     }
151   }
152 
153   return PL_exception(0);
154 }
155 
156 
157 static int
raise_ssl_error(long e)158 raise_ssl_error(long e)
159 { term_t ex;
160 
161   if ( (ex = ssl_error_term(e)) )
162     return PL_raise_exception(ex);
163 
164   return FALSE;
165 }
166 
167 
168 #ifdef NEED_SSL_ERR
169 static void
ssl_err(char * fmt,...)170 ssl_err(char *fmt, ...)
171 {
172     va_list argpoint;
173 
174     va_start(argpoint, fmt);
175 	Svfprintf(Serror, fmt, argpoint);
176     va_end(argpoint);
177 }
178 #endif
179 
180 static int ssl_debug_level = 0;
181 
182 static int
ssl_set_debug(int level)183 ssl_set_debug(int level)
184 { int old = ssl_debug_level;
185 
186   ssl_debug_level = level;
187   return old;
188 }
189 
190 
191 static void
ssl_deb(int level,char * fmt,...)192 ssl_deb(int level, char *fmt, ...)
193 {
194 #if DEBUG
195     if ( ssl_debug_level >= level )
196     { va_list argpoint;
197 
198       fprintf(stderr, "Debug: ");
199       va_start(argpoint, fmt);
200       Svfprintf(Serror, fmt, argpoint);
201       va_end(argpoint);
202     }
203 #endif
204 }
205 
206 static inline int
ssl_missing(const char * feature)207 ssl_missing(const char *feature)
208 { term_t t = PL_new_term_ref();
209 
210   return ( PL_put_atom_chars(t, feature) &&
211 	   PL_existence_error("ssl_feature", t) );
212 
213 }
214 
215 
216 /*
217  * BIO routines for SSL over streams
218  */
219 
220 #ifdef NEED_BIO
221 
222 /*
223  * Read function.
224  */
225 
226 static int
bio_read(BIO * bio,char * buf,int len)227 bio_read(BIO* bio, char* buf, int len)
228 { IOSTREAM *stream = BIO_get_ex_data(bio, 0);
229 
230   return (int)Sread_pending(stream, buf, len, SIO_RP_BLOCK);
231 }
232 
233 /*
234  * Gets function. If only OpenSSL actually had usable documentation, I might know
235  * what this was actually meant to do....
236  */
237 
238 static int
bio_gets(BIO * bio,char * buf,int len)239 bio_gets(BIO* bio, char* buf, int len)
240 { IOSTREAM *stream;
241   int r = 0;
242   stream = BIO_get_app_data(bio);
243 
244   for (r = 0; r < len-1; r++)
245   { int c = Sgetc(stream);
246     if (c == EOF)
247     { buf[r] = '\0';
248       break;
249     }
250     buf[r] = (char)c;
251     if (buf[r] == '\n')
252     { buf[++r] = '\0';
253       break;
254     }
255   }
256 
257   return r;
258 }
259 
260 /*
261  * Write function
262  */
263 
264 static int
bio_write(BIO * bio,const char * buf,int len)265 bio_write(BIO* bio, const char* buf, int len)
266 { IOSTREAM* stream = BIO_get_ex_data(bio, 0);
267   int r;
268 
269   r = (int)Sfwrite(buf, sizeof(char), len, stream);
270   Sflush(stream);
271 
272   return r;
273 }
274 
275 static int
bio_write_text(BIO * bio,const char * buf,int len)276 bio_write_text(BIO* bio, const char* buf, int len)
277 { IOSTREAM* stream = BIO_get_ex_data(bio, 0);
278   int r = 0, i;
279 
280   for (i = 0; i < len; i++)
281   { if (Sputcode(buf[i], stream))
282       r++;
283     else
284       break;
285   }
286   Sflush(stream);
287 
288   return r;
289 }
290 
291 /*
292  * Control function. Currently only supports flushing and detecting EOF.
293  * There are several more mandatory, but as-yet unsupported functions...
294  *
295  * We should not consider a timeout  to   be  end-of-file.  If we do so,
296  * OpenSSL as of 1.1.1e will propagate this   as an SSL_ERROR_SSL and we
297  * cannot resume the connection. Note that   the TIMEOUT flag is cleared
298  * by the next read operation. Also, if this  flag is set, the last read
299  * operation did call Sfillbuf(), and we  thus   do  know  the buffer is
300  * empty.  Diagnosed by Matt Lilley.
301  */
302 
303 static long
bio_control(BIO * bio,int cmd,long num,void * ptr)304 bio_control(BIO* bio, int cmd, long num, void* ptr)
305 { IOSTREAM* stream;
306   stream  = BIO_get_ex_data(bio, 0);
307 
308   switch(cmd)
309   { case BIO_CTRL_FLUSH:
310       Sflush(stream);
311       return 1;
312     case BIO_CTRL_EOF:
313       return !(stream->flags&SIO_TIMEOUT) && Sfeof(stream);
314   }
315 
316   return 0;
317 }
318 
319 /*
320  * Create function. Called when a new BIO is created
321  * It is our responsibility to set init to 1 here
322  */
323 
324 static int
bio_create(BIO * bio)325 bio_create(BIO* bio)
326 {
327 #if OPENSSL_VERSION_NUMBER < 0x10100000L || defined(LIBRESSL_VERSION_NUMBER)
328    bio->shutdown = 1;
329    bio->init = 1;
330    bio->num = -1;
331    bio->ptr = NULL;
332 #else
333    BIO_set_shutdown(bio, 1);
334    BIO_set_init(bio, 1);
335    /* bio->num = -1;  (what to do in OpenSSL >= 1.1.0?)
336       bio->ptr = NULL; */
337 #endif
338    return 1;
339 }
340 
341 /*
342  * Destroy function. Called when a BIO is freed
343  */
344 
345 static int
bio_destroy(BIO * bio)346 bio_destroy(BIO* bio)
347 {
348    if (bio == NULL)
349    {
350       return 0;
351    }
352    return 1;
353 }
354 
355 #if OPENSSL_VERSION_NUMBER < 0x10100000L || defined(LIBRESSL_VERSION_NUMBER)
356 /*
357  * Specify the BIO read and write function structures
358  */
359 
360 static BIO_METHOD bio_read_functions = { BIO_TYPE_MEM,
361                                          "read",
362 					 NULL,
363 					 &bio_read,
364 					 NULL,
365 					 &bio_gets,
366 					 &bio_control,
367 					 &bio_create,
368 					 &bio_destroy
369 				       };
370 
371 static BIO_METHOD bio_write_functions = { BIO_TYPE_MEM,
372 					  "write",
373 					  &bio_write,
374 					  NULL,
375 					  NULL,
376 					  NULL,
377 					  &bio_control,
378 					  &bio_create,
379 					  &bio_destroy
380 					};
381 
382 static BIO_METHOD bio_write_text_functions = { BIO_TYPE_MEM,
383                                                "write",
384                                                &bio_write_text,
385                                                NULL,
386                                                NULL,
387                                                NULL,
388                                                &bio_control,
389                                                &bio_create,
390                                                &bio_destroy
391                                              };
392 
393 
394 static BIO_METHOD *
bio_read_method(void)395 bio_read_method(void)
396 {
397   return &bio_read_functions;
398 }
399 
400 static BIO_METHOD *
bio_write_method(void)401 bio_write_method(void)
402 {
403   return &bio_write_functions;
404 }
405 
406 static BIO_METHOD *
bio_write_text_method(void)407 bio_write_text_method(void)
408 {
409   return &bio_write_text_functions;
410 }
411 
412 #else
413 /*
414  * In OpenSSL >= 1.1.0, the BIO methods are constructed
415  * using functions. We initialize them exactly once.
416  */
417 
418 static CRYPTO_ONCE once_read  = CRYPTO_ONCE_STATIC_INIT;
419 static CRYPTO_ONCE once_write = CRYPTO_ONCE_STATIC_INIT;
420 static CRYPTO_ONCE once_write_text = CRYPTO_ONCE_STATIC_INIT;
421 
422 static BIO_METHOD *read_method = NULL;
423 static BIO_METHOD *write_method = NULL;
424 static BIO_METHOD *write_text_method = NULL;
425 
426 static void
read_method_init(void)427 read_method_init(void)
428 {
429   BIO_METHOD *rm = BIO_meth_new(BIO_TYPE_MEM, "read");
430 
431   if ( rm == NULL ||
432        (BIO_meth_set_read(rm, &bio_read) <= 0) ||
433        (BIO_meth_set_gets(rm, &bio_gets) <= 0) ||
434        (BIO_meth_set_ctrl(rm, &bio_control) <= 0) ||
435        (BIO_meth_set_create(rm, &bio_create) <= 0) ||
436        (BIO_meth_set_destroy(rm, &bio_destroy) <= 0) )
437     return;
438 
439   read_method = rm;
440 }
441 
442 static BIO_METHOD *
bio_read_method(void)443 bio_read_method(void)
444 {
445   if (read_method != NULL) return read_method;
446 
447   if ( !CRYPTO_THREAD_run_once(&once_read, read_method_init) )
448     return NULL;
449 
450   return read_method;
451 }
452 
453 static void
write_method_init(void)454 write_method_init(void)
455 {
456   BIO_METHOD *wm = BIO_meth_new(BIO_TYPE_MEM, "write");
457 
458   if ( wm == NULL ||
459        (BIO_meth_set_write(wm, &bio_write) <= 0) ||
460        (BIO_meth_set_ctrl(wm, &bio_control) <= 0) ||
461        (BIO_meth_set_create(wm, &bio_create) <= 0) ||
462        (BIO_meth_set_destroy(wm, &bio_destroy) <= 0) )
463     return;
464 
465   write_method = wm;
466 }
467 
468 static void
write_text_method_init(void)469 write_text_method_init(void)
470 {
471   BIO_METHOD *wm = BIO_meth_new(BIO_TYPE_MEM, "write");
472 
473   if ( wm == NULL ||
474        (BIO_meth_set_write(wm, &bio_write_text) <= 0) ||
475        (BIO_meth_set_ctrl(wm, &bio_control) <= 0) ||
476        (BIO_meth_set_create(wm, &bio_create) <= 0) ||
477        (BIO_meth_set_destroy(wm, &bio_destroy) <= 0) )
478     return;
479 
480   write_text_method = wm;
481 }
482 
483 
484 static BIO_METHOD *
bio_write_method(void)485 bio_write_method(void)
486 {
487   if (write_method != NULL) return write_method;
488 
489   if ( !CRYPTO_THREAD_run_once(&once_write, write_method_init) )
490     return NULL;
491 
492   return write_method;
493 }
494 
495 static BIO_METHOD *
bio_write_text_method(void)496 bio_write_text_method(void)
497 {
498   if (write_text_method != NULL) return write_text_method;
499 
500   if ( !CRYPTO_THREAD_run_once(&once_write_text, write_text_method_init) )
501     return NULL;
502 
503   return write_text_method;
504 }
505 
506 #endif
507 
508 #endif /*NEED_BIO*/
509