// Establish a connection using an SSL layer
void ssl_connect(mongo_link* link, SV *client) {
tcp_setup(link);
SV *ca_file_sv, *ca_path_sv;
char *ca_file, *ca_path;
if (link->master->socket){
// Register the error strings for libcrypto & libssl
SSL_load_error_strings();
// Register the available ciphers and digests
SSL_library_init();
// New context saying we are a client, and using SSL 2 or 3
link->ssl_context = SSL_CTX_new(SSLv23_client_method());
if(link->ssl_context == NULL){
ERR_print_errors_fp(stderr);
}
ca_file_sv = perl_mongo_call_method( client, "ssl_ca_file", 0, 0 );
ca_path_sv = perl_mongo_call_method( client, "ssl_ca_path", 0, 0 );
if ( SvPOK( ca_file_sv ) && SvPOK( ca_path_sv ) ) {
ca_file = SvPV_nolen( ca_file_sv );
ca_path = SvPV_nolen( ca_path_sv );
SSL_CTX_load_verify_locations( link->ssl_context, ca_file, ca_path );
}
// Create an SSL struct for the connection
link->ssl_handle = SSL_new(link->ssl_context);
if(link->ssl_handle == NULL){
ERR_print_errors_fp(stderr);
}
// Connect the SSL struct to our connection
if(!SSL_set_fd(link->ssl_handle, link->master->socket)){
ERR_print_errors_fp(stderr);
}
// Initiate SSL handshake
if(SSL_connect (link->ssl_handle) != 1){
ERR_print_errors_fp(stderr);
}
SSL_CTX_set_timeout(link->ssl_context, (long)link->timeout);
link->master->connected = 1;
}
}
void perl_mongo_connect(SV *client, mongo_link* link) {
#ifdef MONGO_SSL
if(link->ssl){
ssl_connect(link, client);
link->sender = ssl_send;
link->receiver = ssl_recv;
return;
}
#endif
non_ssl_connect(link);
link->sender = non_ssl_send;
link->receiver = non_ssl_recv;
SV* sasl_flag = perl_mongo_call_method( client, "sasl", 0, 0 );
if ( SvIV(sasl_flag) == 1 ) {
#ifdef MONGO_SASL
sasl_authenticate( client, link );
#else
croak( "MongoDB: sasl => 1 specified, but this driver was not compiled with SASL support\n" );
#endif
}
SvREFCNT_dec(sasl_flag);
}
static void sasl_authenticate( SV *client, mongo_link *link ) {
Gsasl *ctx = NULL;
Gsasl_session *session;
SV *username, *mechanism, *conv_id;
HV *result; /* response document from mongod */
char *p, *buf; /* I/O buffers for gsasl */
int rc;
char out_buf[8192];
mechanism = perl_mongo_call_method( client, "sasl_mechanism", 0, 0 );
if ( !SvOK( mechanism ) ) {
croak( "MongoDB: Could not retrieve SASL mechanism from client object\n" );
}
if ( strncmp( "PLAIN", SvPV_nolen( mechanism ), 5 ) == 0 ) {
/* SASL PLAIN does not require a libgsasl conversation loop, so we can handle it elsewhere */
return perl_mongo_call_method( client, "_sasl_plain_authenticate", 0, 0 );
}
if ( ( rc = gsasl_init( &ctx ) ) != GSASL_OK ) {
croak( "MongoDB: Cannot initialize libgsasl (%d): %s\n", rc, gsasl_strerror(rc) );
}
if ( ( rc = gsasl_client_start( ctx, SvPV_nolen( mechanism ), &session ) ) != GSASL_OK ) {
croak( "MongoDB: Cannot initialize SASL client (%d): %s\n", rc, gsasl_strerror(rc) );
}
username = perl_mongo_call_method( client, "username", 0, 0 );
if ( !SvOK( username ) ) {
croak( "MongoDB: Cannot start SASL session without username. Specify username in constructor\n" );
}
gsasl_property_set( session, GSASL_SERVICE, "mongodb" );
gsasl_property_set( session, GSASL_HOSTNAME, link->master->host );
gsasl_property_set( session, GSASL_AUTHID, SvPV_nolen( username ) );
rc = gsasl_step64( session, "", &p );
if ( ( rc != GSASL_OK ) && ( rc != GSASL_NEEDS_MORE ) ) {
croak( "MongoDB: No data from GSSAPI. Did you run kinit?\n" );
}
if ( ! strncpy( out_buf, p, 8192 ) ) {
croak( "MongoDB: Unable to copy SASL output buffer\n" );
}
gsasl_free( p );
result = (HV *)SvRV( perl_mongo_call_method( client, "_sasl_start", 0, 2, newSVpv( out_buf, 0 ), mechanism ) );
#if 0
fprintf( stderr, "result conv id = [%s]\n", SvPV_nolen( *hv_fetch( result, "conversationId", 14, FALSE ) ) );
fprintf( stderr, "result payload = [%s]\n", SvPV_nolen( *hv_fetch( result, "payload", 7, FALSE ) ) );
#endif
buf = SvPV_nolen( *hv_fetch( result, "payload", 7, FALSE ) );
conv_id = *hv_fetch( result, "conversationId", 14, FALSE );
do {
rc = gsasl_step64( session, buf, &p );
if ( ( rc != GSASL_OK ) && ( rc != GSASL_NEEDS_MORE ) ) {
croak( "MongoDB: SASL step error (%d): %s\n", rc, gsasl_strerror(rc) );
}
if ( ! strncpy( out_buf, p, 8192 ) ) {
croak( "MongoDB: Unable to copy SASL output buffer\n" );
}
gsasl_free( p );
result = (HV *)SvRV( perl_mongo_call_method( client, "_sasl_continue", 0, 2, newSVpv( out_buf, 0 ), conv_id ) );
#if 0
fprintf( stderr, "result conv id = [%s]\n", SvPV_nolen( *hv_fetch( result, "conversationId", 14, FALSE ) ) );
fprintf( stderr, "result payload = [%s]\n", SvPV_nolen( *hv_fetch( result, "payload", 7, FALSE ) ) );
#endif
buf = SvPV_nolen( *hv_fetch( result, "payload", 7, FALSE ) );
} while( rc == GSASL_NEEDS_MORE );
if ( rc != GSASL_OK ) {
croak( "MongoDB: SASL Authentication error (%d): %s\n", rc, gsasl_strerror(rc) );
}
gsasl_finish( session );
gsasl_done( ctx );
}