Exemple #1
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);
}
Exemple #2
0
static int is_numeric_intrinsic (void)
{
   int type;
   
   if (-1 == (type = SLang_peek_at_stack1 ()))
     return -1;

   (void) SLdo_pop ();
   return is_numeric ((SLtype) type);
}
Exemple #3
0
static Isis_Fit_Engine_Type *add_slang_fit_engine (char *eng_name, char *stat_name) /*{{{*/
{
   Isis_Fit_Engine_Type *e;

   if (NULL == (e = (Isis_Fit_Engine_Type *) ISIS_MALLOC (sizeof(Isis_Fit_Engine_Type))))
     return NULL;
   memset ((char *)e, 0, sizeof (*e));

   if ((NULL == (e->engine_name = isis_make_string (eng_name)))
       || (NULL == (e->default_statistic_name = isis_make_string (stat_name))))
     {
        slfe_deallocate (e);
        ISIS_FREE (e);
        return NULL;
     }

   e->method = &slfe_optimize;
   e->deallocate = &slfe_deallocate;
   e->set_options = &slfe_set_options;
   e->set_range_hook = NULL;
   e->range_hook = NULL;
   e->verbose_hook = NULL;
   e->warn_hook = NULL;

   if (NULL == (e->sl_optimize = SLang_pop_function ()))
     {
        slfe_deallocate (e);
        return NULL;
     }

   if (SLANG_NULL_TYPE == SLang_peek_at_stack())
     SLdo_pop();
   else if (NULL == (e->sl_set_options = SLang_pop_function ()))
     {
        slfe_deallocate (e);
        return NULL;
     }

   if (NULL == (e->option_string = isis_make_string (eng_name)))
     {
        slfe_deallocate (e);
        return NULL;
     }

   return e;
}
Exemple #4
0
static int is_callable_intrinsic (void)
{
   SLang_Ref_Type *ref;
   int ret;

   if (SLang_peek_at_stack () != SLANG_REF_TYPE)
     {
	(void) SLdo_pop ();
	return 0;
     }

   if (-1 == SLang_pop_ref (&ref))
     return -1;
   
   ret = _pSLang_ref_is_callable (ref);
   SLang_free_ref (ref);

   return ret;
}
Exemple #5
0
static void qualifier_intrin (void)
{
   int has_default;
   char *name;
   SLang_Struct_Type *q;
   SLang_Object_Type *objp;

   if (-1 == _pSLang_get_qualifiers (&q))
     return;

   has_default = (SLang_Num_Function_Args == 2);
   if (has_default)
     {
	if (-1 == SLroll_stack (2))
	  return;
     }

   if (-1 == SLang_pop_slstring (&name))
     return;

   if (q != NULL)
     objp = _pSLstruct_get_field_value (q, name);
   else
     objp = NULL;
   
   SLang_free_slstring (name);

   if (objp != NULL)
     {
	if (has_default)
	  SLdo_pop ();
	_pSLpush_slang_obj (objp);
     }
   else if (has_default == 0)
     (void) SLang_push_null ();
   
   /* Note: objp and q should _not_ be freed since they were not allocated */
}
Exemple #6
0
int SLang_assign_to_ref (SLang_Ref_Type *ref, SLtype type, VOID_STAR v)
{
   SLang_Object_Type *stkptr;
   SLang_Class_Type *cl;
   
   cl = _pSLclass_get_class (type);

   /* Use apush since this function is passing ``array'' bytes rather than the
    * address of the data.  I need to somehow make this more consistent.  To
    * see what I mean, consider:
    * 
    *    double z[2];
    *    char *s = "silly";
    *    char bytes[10];  BAD--- Don't do this
    *    int i;
    * 
    *    SLang_assign_to_ref (ref, SLANG_INT_TYPE,    &i);
    *    SLang_assign_to_ref (ref, SLANG_STRING_TYPE, &s);
    *    SLang_assign_to_ref (ref, SLANG_COMPLEX_TYPE, z);
    * 
    * That is, all external routines that take a VOID_STAR argument need to
    * be documented such that how the function should be called with the
    * various class_types.
    */
   if (-1 == (*cl->cl_apush) (type, v))
     return -1;

   stkptr = _pSLang_get_run_stack_pointer ();
   if (0 == _pSLang_deref_assign (ref))
     return 0;

   if (stkptr != _pSLang_get_run_stack_pointer ())
     SLdo_pop ();

   return -1;
}
Exemple #7
0
/* Usage: array_reverse (a, [,from, to] [,dim]) */
static void array_reverse (void)
{
   int len;
   unsigned char *src, *dst;
   size_t sizeof_type;
   int dim = 0;
   /* int has_dim = 0; */
   int from = 0;
   int to = -1;
   int nargs;

   SLang_Array_Type *at;

   nargs = SLang_Num_Function_Args;
   if ((nargs == 2) || (nargs == 4))
     {
	/* FIXME!!! */
	/* has_dim = 1; */
	if (-1 == SLang_pop_integer (&dim))
	  return;
	_pSLang_verror (SL_NotImplemented_Error, "dim argument not yet implemented");
	return;
     }

   if (nargs >= 3)
     {
	if ((-1 == SLang_pop_integer (&to))
	    || (-1 == SLang_pop_integer (&from)))
	  return;
     }

   if ((from == to)
       || (SLang_peek_at_stack () != SLANG_ARRAY_TYPE))
     {
	(void) SLdo_pop ();	       /* do nothing */
	return;
     }

   if (-1 == pop_writable_array (&at))
     return;

   len = (int) at->num_elements;
   if (len == 0)
     {				       /* nothing to reverse */
	SLang_free_array (at);
	return;
     }

   if (-1 == check_range_indices (len, &from, &to))
     {
	SLang_free_array (at);
	return;
     }

   sizeof_type = at->cl->cl_sizeof_type;

   src = (unsigned char *)at->data + from*sizeof_type;
   dst = (unsigned char *)at->data + to*sizeof_type;
   while (src < dst)
     {
	unsigned int k;

	for (k = 0; k < sizeof_type; k++)
	  {
	     unsigned char tmp = src[k];
	     src[k] = dst[k];
	     dst[k] = tmp;
	  }

	src += sizeof_type;
	dst -= sizeof_type;
     }
   SLang_free_array (at);
}