1/* 2 * $Id: SSLeay.xs,v 1.2 2000/05/10 16:37:25 ben Exp $ 3 * Copyright 1998 Gisle Aas. 4 * 5 * This library is free software; you can redistribute it and/or 6 * modify it under the same terms as Perl itself. 7 */ 8 9#ifdef __cplusplus 10extern "C" { 11#endif 12#include "EXTERN.h" 13#include "perl.h" 14 15/* CRYPT_SSLEAY_free() will not be #defined to be free() now that we're no 16 * longer supporting pre-2000 OpenSSL. 17#define NO_XSLOCKS 18*/ 19 20#include "XSUB.h" 21 22/* build problem under openssl 0.9.6 and some builds of perl 5.8.x */ 23#ifndef PERL5 24#define PERL5 1 25#endif 26 27/* Makefile.PL no longer generates the following header file 28 * #include "crypt_ssleay_version.h" 29 * Among other things, Makefile.PL used to determine whether 30 * to use #include<openssl/ssl.h> or #include<ssl.h> and 31 * whether to use OPENSSL_free or free etc, but such distinctions 32 * ceased to matter pre-2000. Crypt::SSLeay no longer supports 33 * pre-2000 OpenSSL */ 34 35#include <openssl/ssl.h> 36#include <openssl/crypto.h> 37#include <openssl/err.h> 38#include <openssl/rand.h> 39#include <openssl/pkcs12.h> 40 41#define CRYPT_SSLEAY_free OPENSSL_free 42 43#undef Free /* undo namespace pollution from crypto.h */ 44#ifdef __cplusplus 45} 46#endif 47 48 49#if SSLEAY_VERSION_NUMBER >= 0x0900 50#define CRYPT_SSL_CLIENT_METHOD SSLv3_client_method() 51#else 52#define CRYPT_SSL_CLIENT_METHOD SSLv2_client_method() 53#endif 54 55static void InfoCallback(const SSL *s,int where,int ret) 56 { 57 const char *str; 58 int w; 59 60 w = where & ~SSL_ST_MASK; 61 62 if(w & SSL_ST_CONNECT) 63 str="SSL_connect"; 64 else if(w & SSL_ST_ACCEPT) 65 str="SSL_accept"; 66 else 67 str="undefined"; 68 69 if(where & SSL_CB_LOOP) { 70 fprintf(stderr,"%s:%s\n",str,SSL_state_string_long(s)); 71 } 72 else if(where & SSL_CB_ALERT) { 73 str=(where & SSL_CB_READ)?"read":"write"; 74 fprintf(stderr,"SSL3 alert %s:%s:%s\n",str, 75 SSL_alert_type_string_long(ret), 76 SSL_alert_desc_string_long(ret)); 77 } 78 else if(where & SSL_CB_EXIT) { 79 if(ret == 0) 80 fprintf(stderr,"%s:failed in %s\n",str,SSL_state_string_long(s)); 81 else if (ret < 0) 82 fprintf(stderr,"%s:error in %s\n",str,SSL_state_string_long(s)); 83 } 84 } 85 86MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay 87 88PROTOTYPES: DISABLE 89 90MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::Err PREFIX = ERR_ 91 92char* 93ERR_get_error_string() 94 CODE: 95 unsigned long l; 96 char buf[1024]; 97 98 if(!(l=ERR_get_error())) 99 RETVAL=NULL; 100 else { 101 ERR_error_string(l,buf); 102 RETVAL=buf; 103 } 104 OUTPUT: 105 RETVAL 106 107MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::CTX PREFIX = SSL_CTX_ 108 109SSL_CTX* 110SSL_CTX_new(packname, ssl_version) 111 SV* packname 112 int ssl_version 113 CODE: 114 SSL_CTX* ctx; 115 static int bNotFirstTime; 116 char buf[1024]; 117 int rand_bytes_read; 118 119 if(!bNotFirstTime) { 120 SSLeay_add_all_algorithms(); 121 SSL_load_error_strings(); 122 ERR_load_crypto_strings(); 123 SSL_library_init(); 124 bNotFirstTime = 1; 125 } 126 127 /**** Code from Devin Heitmueller, 10/3/2002 ****/ 128 /**** Use /dev/urandom to seed if available ****/ 129 rand_bytes_read = RAND_load_file("/dev/urandom", 1024); 130 if (rand_bytes_read <= 0) { 131 /* Couldn't read /dev/urandom, just seed off 132 * of the stack variable (the old way) 133 */ 134 RAND_seed(buf,sizeof buf); 135 } 136 137 if(ssl_version == 23) { 138 ctx = SSL_CTX_new(SSLv23_client_method()); 139 } 140 else if(ssl_version == 3) { 141 ctx = SSL_CTX_new(SSLv3_client_method()); 142 } 143 else { 144#ifndef OPENSSL_NO_SSL2 145 /* v2 is the default */ 146 ctx = SSL_CTX_new(SSLv2_client_method()); 147#else 148 /* v3 is the default */ 149 ctx = SSL_CTX_new(SSLv3_client_method()); 150#endif 151 } 152 153 SSL_CTX_set_options(ctx,SSL_OP_ALL|0); 154 SSL_CTX_set_default_verify_paths(ctx); 155 SSL_CTX_set_verify(ctx, SSL_VERIFY_NONE, NULL); 156 RETVAL = ctx; 157 OUTPUT: 158 RETVAL 159 160void 161SSL_CTX_free(ctx) 162 SSL_CTX* ctx 163 164int 165SSL_CTX_set_cipher_list(ctx, ciphers) 166 SSL_CTX* ctx 167 char* ciphers 168 169int 170SSL_CTX_use_certificate_file(ctx, filename, mode) 171 SSL_CTX* ctx 172 char* filename 173 int mode 174 175int 176SSL_CTX_use_PrivateKey_file(ctx, filename ,mode) 177 SSL_CTX* ctx 178 char* filename 179 int mode 180 181int 182SSL_CTX_use_pkcs12_file(ctx, filename, password) 183 SSL_CTX* ctx 184 char* filename 185 char* password 186 PREINIT: 187 FILE *fp; 188 EVP_PKEY *pkey; 189 X509 *cert; 190 STACK_OF(X509) *ca = NULL; 191 PKCS12 *p12; 192 CODE: 193 if ((fp = fopen(filename, "rb"))) { 194 p12 = d2i_PKCS12_fp(fp, NULL); 195 fclose (fp); 196 197 if (p12) { 198 if(PKCS12_parse(p12, password, &pkey, &cert, &ca)) { 199 if (pkey) { 200 RETVAL = SSL_CTX_use_PrivateKey(ctx, pkey); 201 EVP_PKEY_free(pkey); 202 } 203 if (cert) { 204 RETVAL = SSL_CTX_use_certificate(ctx, cert); 205 X509_free(cert); 206 } 207 } 208 PKCS12_free(p12); 209 } 210 } 211 OUTPUT: 212 RETVAL 213 214 215int 216SSL_CTX_check_private_key(ctx) 217 SSL_CTX* ctx 218 219SV* 220SSL_CTX_set_verify(ctx) 221 SSL_CTX* ctx 222 PREINIT: 223 char* CAfile; 224 char* CAdir; 225 CODE: 226 CAfile=getenv("HTTPS_CA_FILE"); 227 CAdir =getenv("HTTPS_CA_DIR"); 228 229 if(!CAfile && !CAdir) { 230 SSL_CTX_set_verify(ctx, SSL_VERIFY_NONE, NULL); 231 RETVAL = newSViv(0); 232 } 233 else { 234 SSL_CTX_load_verify_locations(ctx,CAfile,CAdir); 235 SSL_CTX_set_verify(ctx, SSL_VERIFY_PEER, NULL); 236 RETVAL = newSViv(1); 237 } 238 OUTPUT: 239 RETVAL 240 241MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::Conn PREFIX = SSL_ 242 243SSL* 244SSL_new(packname, ctx, debug, ...) 245 SV* packname 246 SSL_CTX* ctx 247 SV* debug 248 PREINIT: 249 SSL* ssl; 250 CODE: 251 ssl = SSL_new(ctx); 252 SSL_set_connect_state(ssl); 253 /* The set mode is necessary so the SSL connection can 254 * survive a renegotiated cipher that results from 255 * modssl VerifyClient config changing between 256 * VirtualHost & some other config block. At modssl 257 * this would be a [trace] ssl message: 258 * "Changed client verification type will force renegotiation" 259 * -- jc 6/28/2001 260 */ 261#ifdef SSL_MODE_AUTO_RETRY 262 SSL_set_mode(ssl, SSL_MODE_AUTO_RETRY); 263#endif 264 RETVAL = ssl; 265 if(SvTRUE(debug)) { 266 SSL_set_info_callback(RETVAL,InfoCallback); 267 } 268 if (items > 2) { 269 PerlIO* io = IoIFP(sv_2io(ST(3))); 270#ifdef _WIN32 271 SSL_set_fd(RETVAL, _get_osfhandle(PerlIO_fileno(io))); 272#else 273 SSL_set_fd(RETVAL, PerlIO_fileno(io)); 274#endif 275 } 276 OUTPUT: 277 RETVAL 278 279void 280SSL_free(ssl) 281 SSL* ssl 282 283int 284SSL_set_fd(ssl,fd) 285 SSL* ssl 286 int fd 287 288int 289SSL_connect(ssl) 290 SSL* ssl 291 292int 293SSL_accept(ssl) 294 SSL* ssl 295 296SV* 297SSL_write(ssl, buf, ...) 298 SSL* ssl 299 PREINIT: 300 STRLEN blen; 301 int len; 302 int offset = 0; 303 int keep_trying_to_write = 1; 304 INPUT: 305 char* buf = SvPV(ST(1), blen); 306 CODE: 307 if (items > 2) { 308 len = SvOK(ST(2)) ? SvIV(ST(2)) : blen; 309 if (items > 3) { 310 offset = SvIV(ST(3)); 311 if (offset < 0) { 312 if (-offset > blen) 313 croak("Offset outside string"); 314 offset += blen; 315 } 316 else if (offset >= blen && blen > 0) 317 croak("Offset outside string"); 318 } 319 if (len > blen - offset) 320 len = blen - offset; 321 } 322 else { 323 len = blen; 324 } 325 326 /* try to handle incomplete writes properly 327 * see RT bug #64054 and RT bug #78695 328 * 2012/08/02: Stop trying to distinguish between good & bad 329 * zero returns from underlying SSL_read/SSL_write 330 */ 331 while (keep_trying_to_write) 332 { 333 int n = SSL_write(ssl, buf+offset, len); 334 int x = SSL_get_error(ssl, n); 335 336 if ( n >= 0 ) 337 { 338 keep_trying_to_write = 0; 339 RETVAL = newSViv(n); 340 } 341 else 342 { 343 if 344 ( 345 (x != SSL_ERROR_WANT_READ) && 346 (x != SSL_ERROR_WANT_WRITE) 347 ) 348 { 349 keep_trying_to_write = 0; 350 RETVAL = &PL_sv_undef; 351 } 352 } 353 } 354 OUTPUT: 355 RETVAL 356 357SV* 358SSL_read(ssl, buf, len,...) 359 SSL* ssl 360 int len 361 PREINIT: 362 char *buf; 363 STRLEN blen; 364 int offset = 0; 365 int keep_trying_to_read = 1; 366 INPUT: 367 SV* sv = ST(1); 368 CODE: 369 buf = SvPV_force(sv, blen); 370 if (items > 3) { 371 offset = SvIV(ST(3)); 372 if (offset < 0) { 373 if (-offset > blen) 374 croak("Offset outside string"); 375 offset += blen; 376 } 377 /* this is not a very efficient method of appending 378 * (offset - blen) NUL bytes, but it will probably 379 * seldom happen. 380 */ 381 while (offset > blen) { 382 sv_catpvn(sv, "\0", 1); 383 blen++; 384 } 385 } 386 if (len < 0) 387 croak("Negative length"); 388 389 SvGROW(sv, offset + len + 1); 390 buf = SvPVX(sv); /* it might have been relocated */ 391 392 /* try to handle incomplete writes properly 393 * see RT bug #64054 and RT bug #78695 394 * 2012/08/02: Stop trying to distinguish between good & bad 395 * zero returns from underlying SSL_read/SSL_write 396 */ 397 while (keep_trying_to_read) { 398 int n = SSL_read(ssl, buf+offset, len); 399 int x = SSL_get_error(ssl, n); 400 401 if ( n >= 0 ) 402 { 403 SvCUR_set(sv, offset + n); 404 buf[offset + n] = '\0'; 405 keep_trying_to_read = 0; 406 RETVAL = newSViv(n); 407 } 408 else 409 { 410 if 411 ( 412 (x != SSL_ERROR_WANT_READ) && 413 (x != SSL_ERROR_WANT_WRITE) 414 ) 415 { 416 keep_trying_to_read = 0; 417 RETVAL = &PL_sv_undef; 418 } 419 } 420 } 421 OUTPUT: 422 RETVAL 423 424X509* 425SSL_get_peer_certificate(ssl) 426 SSL* ssl 427 428SV* 429SSL_get_verify_result(ssl) 430 SSL* ssl 431 CODE: 432 RETVAL = newSViv((SSL_get_verify_result(ssl) == X509_V_OK) ? 1 : 0); 433 OUTPUT: 434 RETVAL 435 436char* 437SSL_get_shared_ciphers(ssl) 438 SSL* ssl 439 PREINIT: 440 char buf[512]; 441 CODE: 442 RETVAL = SSL_get_shared_ciphers(ssl, buf, sizeof(buf)); 443 OUTPUT: 444 RETVAL 445 446char* 447SSL_get_cipher(ssl) 448 SSL* ssl 449 CODE: 450 RETVAL = (char*) SSL_get_cipher(ssl); 451 OUTPUT: 452 RETVAL 453 454#if OPENSSL_VERSION_NUMBER >= 0x0090806fL && !defined(OPENSSL_NO_TLSEXT) 455 456void 457SSL_set_tlsext_host_name(ssl, name) 458 SSL *ssl 459 const char *name 460 461#endif 462 463MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::X509 PREFIX = X509_ 464 465void 466X509_free(cert) 467 X509* cert 468 469SV* 470subject_name(cert) 471 X509* cert 472 PREINIT: 473 char* str; 474 CODE: 475 str = X509_NAME_oneline(X509_get_subject_name(cert), NULL, 0); 476 RETVAL = newSVpv(str, 0); 477 CRYPT_SSLEAY_free(str); 478 OUTPUT: 479 RETVAL 480 481SV* 482issuer_name(cert) 483 X509* cert 484 PREINIT: 485 char* str; 486 CODE: 487 str = X509_NAME_oneline(X509_get_issuer_name(cert), NULL, 0); 488 RETVAL = newSVpv(str, 0); 489 CRYPT_SSLEAY_free(str); 490 OUTPUT: 491 RETVAL 492 493char * 494get_notBeforeString(cert) 495 X509* cert 496 CODE: 497 RETVAL = (char *)X509_get_notBefore(cert)->data; 498 OUTPUT: 499 RETVAL 500 501char * 502get_notAfterString(cert) 503 X509* cert 504 CODE: 505 RETVAL = (char *)X509_get_notAfter(cert)->data; 506 OUTPUT: 507 RETVAL 508 509 510