static void sl_ssl_client (void){
// create an ssl object and return the memory managed type back to
// SLang. It needs the file descriptor of the object upon which
// communication will occur, and the protocol to use.
//
SSL_CTX *ctx;
SSL *ssl;
int proto, cret;
SLang_MMT_Type *mmt, *sslmmt;
SLsslctx_Type *slctx;
char *cadir=NULL, *cafile=NULL;
if (SLang_Num_Function_Args == 3)
if (SLang_pop_slstring(&cadir) == -1)
return;
if (SLang_Num_Function_Args > 1)
if (SLANG_NULL_TYPE==SLang_peek_at_stack())
SLdo_pop();
else if (SLang_pop_slstring(&cafile) == -1)
goto free;
if (SLang_pop_integer(&proto) == -1)
goto free;
if (proto==SSL_PROTO_SSL2)
ctx = SSL_CTX_new(SSLv23_client_method());
else if (proto==SSL_PROTO_SSL3)
ctx = SSL_CTX_new(SSLv3_client_method());
else if (proto==SSL_PROTO_TLS1)
ctx = SSL_CTX_new(TLSv1_client_method());
else if (proto==SSL_PROTO_ANY)
ctx = SSL_CTX_new(SSLv23_client_method());
cret = SSL_CTX_load_verify_locations(ctx, cafile, cadir);
if (cret == 0 && SLang_Num_Function_Args > 1){
SLang_verror(SL_APPLICATION_ERROR, "Failed to load CA file or path");
goto free;
}
slctx = (SLsslctx_Type *)malloc(sizeof(SLsslctx_Type));
slctx->is_server = 0;
slctx->ctx = (void *)ctx;
sslmmt = SLang_create_mmt(SLsslctx_Type_Id, (VOID_STAR) slctx);
if (0!=SLang_push_mmt(sslmmt))
SLang_free_mmt(sslmmt);
free:
if (NULL!=cadir)
SLang_free_slstring(cadir);
if (NULL!=cafile)
SLang_free_slstring(cafile);
}
static SLang_MMT_Type *allocate_termios (struct termios *s)
{
struct termios *s1;
SLang_MMT_Type *mmt;
s1 = (struct termios *) SLmalloc (sizeof (struct termios));
if (s1 == NULL)
return NULL;
memcpy (s1, s, sizeof (struct termios));
if (NULL == (mmt = SLang_create_mmt (Termios_Type_Id, (VOID_STAR) s1)))
SLfree ((char *) s1);
return mmt;
}
static int push_onig_type (Onig_Type *o)
{
SLang_MMT_Type *mmt;
if (NULL == (mmt = SLang_create_mmt (Onig_Type_Id, (VOID_STAR) o)))
{
free_onig_type (o);
return -1;
}
if (-1 == SLang_push_mmt (mmt))
{
SLang_free_mmt (mmt);
return -1;
}
return 0;
}
static void new_slrline_intrinsic (char *name)
{
Slsh_Readline_Type *sri;
SLang_MMT_Type *mmt;
if (NULL == (sri = open_slsh_readline (name, SL_RLINE_BLINK_MATCH)))
return;
if (NULL == (mmt = SLang_create_mmt (Rline_Type_Id, (VOID_STAR) sri)))
{
close_slsh_readline (sri);
return;
}
if (-1 == SLang_push_mmt (mmt))
SLang_free_mmt (mmt);
}
static void new_slrline_intrinsic (char *name)
{
SLang_RLine_Info_Type *rli;
SLang_MMT_Type *mmt;
if (NULL == (rli = SLrline_open2 (name, SLtt_Screen_Cols, SL_RLINE_BLINK_MATCH)))
return;
if (NULL == (mmt = SLang_create_mmt (Rline_Type_Id, (VOID_STAR) rli)))
{
SLrline_close (rli);
return;
}
if (-1 == SLang_push_mmt (mmt))
SLang_free_mmt (mmt);
}
static int assoc_anew (SLtype type, unsigned int num_dims)
{
SLang_MMT_Type *mmt;
SLang_Assoc_Array_Type *a;
int has_default_value;
has_default_value = 0;
switch (num_dims)
{
case 0:
type = SLANG_ANY_TYPE;
break;
case 2:
(void) SLreverse_stack (2);
has_default_value = 1;
/* drop */
case 1:
if (0 == SLang_pop_datatype (&type))
break;
num_dims--;
/* drop */
default:
SLdo_pop_n (num_dims);
_pSLang_verror (SL_SYNTAX_ERROR, "Usage: Assoc_Type [DataType_Type]");
return -1;
}
a = alloc_assoc_array (type, has_default_value);
if (a == NULL)
return -1;
if (NULL == (mmt = SLang_create_mmt (SLANG_ASSOC_TYPE, (VOID_STAR) a)))
{
delete_assoc_array (a);
return -1;
}
if (-1 == SLang_push_mmt (mmt))
{
SLang_free_mmt (mmt);
return -1;
}
return 0;
}
static SLang_MMT_Type *allocate_iconv_type (iconv_t cd)
{
ICONV_Type *it;
SLang_MMT_Type *mmt;
it = (ICONV_Type *) SLmalloc (sizeof (ICONV_Type));
if (it == NULL)
return NULL;
it->cd = cd;
if (NULL == (mmt = SLang_create_mmt (ICONV_Type_Id, (VOID_STAR) it)))
{
free_iconv_type (it);
return NULL;
}
return mmt;
}
static void new_csv_encoder_intrin (void)
{
CSV_Type *csv;
SLang_MMT_Type *mmt;
if (NULL == (csv = (CSV_Type *)SLmalloc(sizeof(CSV_Type))))
return;
memset ((char *)csv, 0, sizeof(CSV_Type));
if ((-1 == SLang_pop_int (&csv->flags))
||(-1 == SLang_pop_char (&csv->quotechar))
|| (-1 == SLang_pop_char (&csv->delimchar))
|| (NULL == (mmt = SLang_create_mmt (CSV_Type_Id, (VOID_STAR)csv))))
{
free_csv_type (csv);
return;
}
if (-1 == SLang_push_mmt (mmt))
SLang_free_mmt (mmt);
}
static void sl_ssl_connect (void){
int fd;
SLFile_FD_Type *slfd;
SLsslctx_Type *ctx;
SLssl_Type *slssl;
SSL *ssl;
SLang_MMT_Type *sslmmt;
SLang_MMT_Type *sslmmto;
if (SLfile_pop_fd(&slfd) == -1)
return;
if (NULL==(sslmmt=SLang_pop_mmt(SLsslctx_Type_Id)))
return;
SLfile_get_fd(slfd,&fd);
SLfile_free_fd(slfd);
ctx = (SLsslctx_Type *)SLang_object_from_mmt(sslmmt);
// create the ssl object
ssl = SSL_new((SSL_CTX *)ctx->ctx);
// set the file descriptor for input/output
if (0==SSL_set_fd(ssl,fd)){
return;
}
// fprintf(stderr,"Set client socket fd to %d\n",fd);
slssl = (SLssl_Type *)malloc(sizeof(SLssl_Type));
slssl->ssl = (void *) ssl;
slssl->is_server = ctx->is_server;
sslmmt = SLang_create_mmt(SLssl_Type_Id, (VOID_STAR) slssl);
if (0==SLang_push_mmt(sslmmt))
return;
SLang_free_mmt(sslmmt);
}
static void sl_ssl_server (void){
// create an ssl object and return the memory managed type back to
// SLang. It needs the file descriptor of the object upon which
// communication will occur, and the protocol to use
//
// this is the server, so it also needs the certfile and private key
SSL_CTX *ctx;
SSL *ssl;
int proto, pkey_type, cert_type;
SLang_MMT_Type *sslmmt;
SLFile_FD_Type *slfd;
SLsslctx_Type *slctx;
char *pkey=NULL, *cert=NULL;
if (SLang_pop_slstring(&pkey) == -1 ||
SLang_pop_slstring(&cert) == -1 ||
SLang_pop_integer(&proto) == -1){
goto free;
return;
}
if (proto==SSL_PROTO_SSL2)
ctx = SSL_CTX_new(SSLv23_server_method());
else if (proto==SSL_PROTO_SSL3)
ctx = SSL_CTX_new(SSLv3_server_method());
else if (proto==SSL_PROTO_TLS1)
ctx = SSL_CTX_new(TLSv1_server_method());
else if (proto==SSL_PROTO_ANY)
ctx = SSL_CTX_new(SSLv23_server_method());
// now add the cert file an private key
if (1!=SSL_CTX_use_certificate_file(ctx,cert,SSL_FILETYPE_PEM))
if (1!=SSL_CTX_use_certificate_file(ctx,cert,SSL_FILETYPE_ASN1)){
SLang_verror(0,"Could not load certificate file");
goto free;
}
if (1!=SSL_CTX_use_PrivateKey_file(ctx,pkey,SSL_FILETYPE_PEM))
if (1!=SSL_CTX_use_PrivateKey_file(ctx,pkey,SSL_FILETYPE_ASN1)){
SLang_verror(0,"Could not load private key");
goto free;
}
if (1!=SSL_CTX_check_private_key(ctx)){
SLang_verror(0,"Certificate and private keys do not match");
goto free;
}
slctx = (SLsslctx_Type *)malloc(sizeof(SLsslctx_Type));
slctx->is_server = 1;
slctx->ctx = (void *)ctx;
sslmmt = SLang_create_mmt(SLsslctx_Type_Id, (VOID_STAR) slctx);
if (0!=SLang_push_mmt(sslmmt))
SLang_free_mmt(sslmmt);
free:
if (NULL!=pkey)
SLang_free_slstring(pkey);
if (NULL!=cert)
SLang_free_slstring(cert);
}