Beispiel #1
0
static void posix_fdopen (SLFile_FD_Type *f, char *mode)
{
   Stdio_MMT_List_Type *elem;

   if (NULL == (elem = alloc_stdio_list_elem ()))
     return;

   if (-1 == _pSLstdio_fdopen (f->name, f->fd, mode))
     {
	SLfree ((char *)elem);
	return;
     }

   if (NULL == (elem->stdio_mmt = SLang_pop_mmt (SLANG_FILE_PTR_TYPE)))
     {
	SLfree ((char *) elem);
	return;
     }

   if (-1 == SLang_push_mmt (elem->stdio_mmt))
     {
	SLfree ((char *) elem);
	return;
     }

   elem->next = f->stdio_mmt_list;
   f->stdio_mmt_list = elem;
}
Beispiel #2
0
static void rline_call_update_hook (SLrline_Type *rli,
                                    SLFUTURE_CONST char *prompt,
                                    SLFUTURE_CONST char *buf,
                                    unsigned int len,
                                    unsigned int point, VOID_STAR cd)
{
    Rline_CB_Type *cb;

    (void) rli;
    (void) len;
    cb = (Rline_CB_Type *)cd;

    if (-1 == SLang_start_arg_list ())
        return;

    if ((-1 == SLang_push_mmt (cb->mmt))
            || (-1 == SLang_push_string (prompt))
            || (-1 == SLang_push_string (buf))
            || (-1 == SLang_push_int ((int) point))
            || ((cb->cd != NULL) && (-1 == SLang_push_anytype (cb->cd))))
    {
        (void) SLang_end_arg_list ();
        return;
    }

    (void) SLexecute_function (cb->update_hook);
}
Beispiel #3
0
static void _iconv_open(char *tocode, char *fromcode)
{
   iconv_t cd;
   SLang_MMT_Type *mmt;

   cd = iconv_open(tocode, fromcode);
   if (cd == (iconv_t)(-1))
     {
	SLang_verror (SL_INTRINSIC_ERROR, "Error preparing iconv to convert from '%s' to '%s'.", fromcode, tocode);
	return;
     }

   if (NULL == (mmt = allocate_iconv_type (cd)))
     {
	iconv_close(cd);
	return;
     }

   if (-1 == SLang_push_mmt (mmt))
     {
	SLang_free_mmt (mmt);
	return;
     }
   return;
}
static int default_push_mmt (SLtype type_unused, VOID_STAR ptr)
{
   SLang_MMT_Type *ref;

   (void) type_unused;
   ref = *(SLang_MMT_Type **) ptr;
   return SLang_push_mmt (ref);
}
Beispiel #5
0
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);
}
Beispiel #6
0
static void test_pop_mmt (void)
{
   SLang_MMT_Type *mmt;

   if (NULL == (mmt = SLang_pop_mmt (SLang_peek_at_stack ())))
     return;

   if (-1 == SLang_push_mmt (mmt))
     SLang_free_mmt (mmt);
}
static void tcgetattr_intrin (SLFile_FD_Type *f)
{
    struct termios s;
    SLang_MMT_Type *mmt;

    if (-1 == DO_SYSCALL_STRUCT_1(tcgetattr,f,&s))
    {
        SLang_push_null ();
        return;
    }

    mmt = allocate_termios (&s);	       /* NULL ok */
    if (-1 == SLang_push_mmt (mmt))
        SLang_free_mmt (mmt);
}
Beispiel #8
0
static int call_simple_update_cb (SLang_Name_Type *f, Rline_CB_Type *cb, int *opt)
{
    if (f == NULL)
        return 0;

    if (-1 == SLang_start_arg_list ())
        return -1;
    if ((-1 == SLang_push_mmt (cb->mmt))
            || ((opt != NULL) && (-1 == SLang_push_int (*opt)))
            || ((cb->cd != NULL) && (-1 == SLang_push_anytype (cb->cd))))
    {
        (void) SLang_end_arg_list ();
        return -1;
    }
    return SLexecute_function (f);
}
Beispiel #9
0
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;
}
Beispiel #10
0
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);
}
Beispiel #11
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);
}
Beispiel #12
0
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 int termios_dereference (SLtype type, VOID_STAR addr)
{
    struct termios *s;
    SLang_MMT_Type *mmt;

    (void) type;
    mmt = *(SLang_MMT_Type **) addr;
    if (NULL == (s = (struct termios *)SLang_object_from_mmt (mmt)))
        return -1;

    mmt = allocate_termios (s);
    if (-1 == SLang_push_mmt (mmt))
    {
        SLang_free_mmt (mmt);
        return -1;
    }

    return 0;
}
Beispiel #14
0
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);
}
Beispiel #15
0
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);
}  
Beispiel #16
0
static int slfe_optimize (Isis_Fit_Type *ift, void *clientdata, /*{{{*/
                          double *x, double *y, double *weights, unsigned int npts,
                          double *pars, unsigned int npars)
{
   Isis_Fit_Engine_Type *e;
   SLang_Array_Type *sl_pars=NULL, *sl_pars_min=NULL, *sl_pars_max=NULL;
   SLang_Array_Type *sl_new_pars=NULL;
   SLindex_Type n;
   int status = -1;

   (void) clientdata; (void) x; (void) y; (void) weights; (void) npts;

   if ((ift == NULL) || (pars == NULL) || (npars <= 0)
       || (Current_Fit_Object_MMT == NULL))
     return -1;

   e = ift->engine;

   n = (SLindex_Type) npars;
   sl_pars = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1);
   sl_pars_min = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1);
   sl_pars_max = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1);

   if ((NULL == sl_pars) || (NULL == sl_pars_min) || (NULL == sl_pars_max))
     return -1;

   memcpy ((char *)sl_pars->data, (char *)pars, npars * sizeof(double));
   memcpy ((char *)sl_pars_min->data, (char *)e->par_min, npars * sizeof(double));
   memcpy ((char *)sl_pars_max->data, (char *)e->par_max, npars * sizeof(double));

   /* FIXME: Increment the reference count to prevent a segv.
    * There must be a better way.
    */
   SLang_inc_mmt (Current_Fit_Object_MMT);

   SLang_start_arg_list ();
   if ((-1 == SLang_push_mmt (Current_Fit_Object_MMT))
       || (-1 == SLang_push_array (sl_pars, 1))
       || (-1 == SLang_push_array (sl_pars_min, 1))
       || (-1 == SLang_push_array (sl_pars_max, 1)))
     {
        isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
                    "calling user-defined optimization method '%s'",
                    e->engine_name);
        goto return_error;
     }
   SLang_end_arg_list ();

   if (-1 == SLexecute_function (e->sl_optimize))
     {
        isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
                    "executing optimization method '%s'",
                    e->engine_name);
        goto return_error;
     }

   if (-1 == SLang_pop_array_of_type (&sl_new_pars, SLANG_DOUBLE_TYPE))
     {
        isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
                    "returning results from optimization method '%s'",
                    e->engine_name);
        goto return_error;
     }

   if ((sl_new_pars == NULL) || (sl_new_pars->num_elements != npars))
     {
        isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__,
                    "corrupted parameter array returned from optimization method '%s'",
                    e->engine_name);
        goto return_error;
     }

   memcpy ((char *)pars, (char *)sl_new_pars->data, npars * sizeof(double));

   status = 0;
return_error:
   SLang_free_array (sl_new_pars);

   if (SLang_get_error())
     {
        isis_throw_exception (SLang_get_error());
        return -1;
     }

   return status;
}
Beispiel #17
0
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);
}