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); }
/* {SO_PEERCRED, NULL, get_peercred_sockopt}, */ # endif # ifdef SO_RCVTIMEO {SO_RCVTIMEO, set_timeval_sockopt, get_timeval_sockopt}, # endif # ifdef SO_SNDTIMEO {SO_SNDTIMEO, set_timeval_sockopt, get_timeval_sockopt}, # endif # ifdef SO_LINGER {SO_LINGER, set_linger_sockopt, get_linger_sockopt}, # endif {-1, NULL, NULL} }; #endif /* SOL_SOCKET */ #if defined(IP_ADD_MEMBERSHIP) /* either add or drop same args */ static int set_multicast_sockopt (Socket_Type *s, int level, int option) { struct ip_mreq group; char *multi; char *local = NULL; Host_Addr_Info_Type *multi_info = NULL; Host_Addr_Info_Type *local_info = NULL; int ret = -1; if (-1 == SLang_pop_slstring(&multi)) return -1; if (5 == SLang_Num_Function_Args) { if (-1 == SLang_pop_slstring(&local)) { SLang_free_slstring (multi); return -1; } } if (NULL == (multi_info = get_host_addr_info (multi))) goto free_and_return; if (local != NULL) { if (NULL == (local_info = get_host_addr_info (local))) goto free_and_return; memcpy ((char *) &group.imr_interface.s_addr, local_info->h_addr_list[0], local_info->h_length); } else { group.imr_interface.s_addr = INADDR_ANY; } memcpy ((char *) &group.imr_multiaddr.s_addr, multi_info->h_addr_list[0], multi_info->h_length); ret = do_setsockopt (s->fd, level, option, (void *)&group, sizeof(group)); free_and_return: SLang_free_slstring(multi); if (NULL != local) SLang_free_slstring(local); free_host_addr_info (multi_info); if (NULL != local_info) free_host_addr_info (local_info); return ret; }
static void sl_base64_decode (void){ char* input, *in; BIO* bmem,* b64; SLang_BString_Type* output; int i, outlen; char nl[]="\n"; if (SLang_Num_Function_Args != 1 || SLang_pop_slstring(&in) == -1 ){ return; } /* For some reason, the input is required to have a newline at the end, doesn't matter how many, so tack one on here*/ input = SLang_concat_slstrings(in,nl); SLang_free_slstring(in); unsigned char* buff = (char*)malloc((int)strlen(input)+1); memset(buff,0,(int)strlen(input)); b64 = BIO_new(BIO_f_base64()); bmem = BIO_new_mem_buf(input,(int)strlen(input)); bmem = BIO_push(b64,bmem); outlen = BIO_read(bmem,buff,(int)strlen(input)); BIO_free_all(bmem); output = SLbstring_create(buff, outlen); SLang_push_bstring(output); SLang_free_slstring(input); SLbstring_free(output); free(buff); }
static int sl_report_function (Isis_Fit_Statistic_Type *s, void *pfp, double stat, unsigned int npts, unsigned int nvpars) /*{{{*/ { FILE *fp = (FILE *)pfp; char *str; if (s == NULL || s->sl_report == NULL) return -1; SLang_start_arg_list (); if ((-1 == SLang_push_double (stat)) || (-1 == SLang_push_integer ((int) npts)) || (-1 == SLang_push_integer ((int) nvpars))) return -1; SLang_end_arg_list (); if (-1 == SLexecute_function ((SLang_Name_Type *)s->sl_report)) return -1; if (-1 == SLang_pop_slstring (&str)) return -1; if (EOF == fputs (str, fp)) { SLang_free_slstring (str); return -1; } SLang_free_slstring (str); return 0; }
static int pop_index (unsigned int num_indices, SLang_MMT_Type **mmt, SLang_Assoc_Array_Type **a, SLstr_Type **str, unsigned long *hashp) { /* if (NULL == (*mmt = SLang_pop_mmt (SLANG_ASSOC_TYPE))) */ if (-1 == SLclass_pop_ptr_obj (SLANG_ASSOC_TYPE, (VOID_STAR *) mmt)) { *a = NULL; *str = NULL; return -1; } if ((num_indices != 1) || (-1 == SLang_pop_slstring (str))) { _pSLang_verror (SL_NOT_IMPLEMENTED, "Assoc_Type arrays require a single string index"); SLang_free_mmt (*mmt); *mmt = NULL; *a = NULL; *str = NULL; return -1; } /* *a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (*mmt); */ *a = (SLang_Assoc_Array_Type *) (*mmt)->user_data; *hashp = _pSLstring_get_hash (*str); return 0; }
void _pSLpack (void) { SLang_BString_Type *bs; char *fmt; int nitems; check_native_byte_order (); nitems = SLang_Num_Function_Args; if (nitems <= 0) { _pSLang_verror (SL_SYNTAX_ERROR, "pack: not enough arguments"); return; } if ((-1 == SLreverse_stack (nitems)) || (-1 == SLang_pop_slstring (&fmt))) bs = NULL; else { bs = pack_according_to_format (fmt, (unsigned int)nitems - 1); SLang_free_slstring (fmt); } SLang_push_bstring (bs); SLbstring_free (bs); }
static void read_image (int flipped) { int color_type; char *file; SLang_Ref_Type *ref = NULL; SLang_Array_Type *at; if ((SLang_Num_Function_Args == 2) && (-1 == SLang_pop_ref (&ref))) return; if (-1 == SLang_pop_slstring (&file)) { file = NULL; goto free_return; } if (NULL == (at = read_image_internal (file, flipped, &color_type))) goto free_return; if ((ref != NULL) && (-1 == SLang_assign_to_ref (ref, SLANG_INT_TYPE, &color_type))) { SLang_free_array (at); goto free_return; } (void) SLang_push_array (at, 1); free_return: SLang_free_slstring (file); if (ref != NULL) SLang_free_ref (ref); }
static int bind_af_unix (Socket_Type *s, int nargs) { struct sockaddr_un addr; char *file; if (nargs != 1) { SLang_verror (SL_NumArgs_Error, "This socket expects a filename"); return -1; } if (-1 == SLang_pop_slstring (&file)) return -1; if (strlen (file) >= sizeof(addr.sun_path)) { SLang_verror (SL_InvalidParm_Error, "filename too long for PF_UNIX socket"); SLang_free_slstring (file); return -1; } memset ((char *)&addr, 0, sizeof (struct sockaddr_un)); addr.sun_family = AF_UNIX; strcpy (addr.sun_path, file); /* \0 terminated */ (void) unlink (file); s->socket_data = (VOID_STAR) file; return perform_bind (s->fd, (struct sockaddr *)&addr, sizeof (addr)); }
static void rline_setkey_intrinsic (char *keyseq) { char *str; SLkeymap_Type *kmap; if (NULL == (kmap = get_keymap ())) return; if (SLang_peek_at_stack () == SLANG_REF_TYPE) { SLang_Name_Type *nt; if (NULL == (nt = SLang_pop_function ())) return; (void) SLkm_define_slkey (keyseq, nt, kmap); return; } if (-1 == SLang_pop_slstring (&str)) return; (void) SLang_define_key (keyseq, str, kmap); SLang_free_slstring (str); }
SLang_Name_Type *SLang_pop_function (void) { SLang_Ref_Type *ref; SLang_Name_Type *f; if (SLang_peek_at_stack () == SLANG_STRING_TYPE) { char *name; if (-1 == SLang_pop_slstring (&name)) return NULL; if (NULL == (f = SLang_get_function (name))) { _pSLang_verror (SL_UNDEFINED_NAME, "Function %s does not exist", name); SLang_free_slstring (name); return NULL; } SLang_free_slstring (name); return f; } if (-1 == SLang_pop_ref (&ref)) return NULL; f = SLang_get_fun_from_ref (ref); SLang_free_ref (ref); return f; }
static int exec_what (int what, int has_envp) { SLang_Array_Type *at_argv = NULL; SLang_Array_Type *at_envp = NULL; char **argv = NULL, **envp = NULL; char *path = NULL; int status = -1; if (has_envp) { if (NULL == (envp = pop_argv (&at_envp))) goto free_and_return; } if (NULL == (argv = pop_argv (&at_argv))) goto free_and_return; if (-1 == SLang_pop_slstring (&path)) goto free_and_return; status = call_what (what, path, argv, envp); free_and_return: if (path != NULL) SLang_free_slstring (path); if (argv != NULL) SLfree ((char *)argv); if (at_argv != NULL) SLang_free_array (at_argv); if (envp != NULL) SLfree ((char *)envp); if (at_envp != NULL) SLang_free_array (at_envp); return status; }
static SLang_Foreach_Context_Type * cl_foreach_open (SLtype type, unsigned int num) { SLang_Foreach_Context_Type *c; unsigned char flags; SLang_MMT_Type *mmt; (void) type; if (NULL == (mmt = SLang_pop_mmt (SLANG_ASSOC_TYPE))) return NULL; flags = 0; while (num--) { char *s; if (-1 == SLang_pop_slstring (&s)) { SLang_free_mmt (mmt); return NULL; } if (0 == strcmp (s, "keys")) flags |= CTX_WRITE_KEYS; else if (0 == strcmp (s, "values")) flags |= CTX_WRITE_VALUES; else { _pSLang_verror (SL_NOT_IMPLEMENTED, "using '%s' not supported by SLassoc_Type", s); _pSLang_free_slstring (s); SLang_free_mmt (mmt); return NULL; } _pSLang_free_slstring (s); } if (NULL == (c = (SLang_Foreach_Context_Type *) SLmalloc (sizeof (SLang_Foreach_Context_Type)))) { SLang_free_mmt (mmt); return NULL; } memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type)); if (flags == 0) flags = CTX_WRITE_VALUES|CTX_WRITE_KEYS; c->flags = flags; c->mmt = mmt; c->a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (mmt); #if SLANG_OPTIMIZE_FOR_SPEED c->is_scalar = (SLANG_CLASS_TYPE_SCALAR == _pSLang_get_class_type (c->a->type)); #endif return c; }
static void strftime_cmd (void) { /* Rather then using some sort of portable version of strftime, which would * miss the locale-specific features, just call the system routine. However, * it cannot be called blindly because some versions (e.g., the the one from * c.snippets.org) do no input checking, and use code such as * * static char *day[] = {"Sunday", "Monday", ..., "Saturday"}; * [...] * switch (*f++) * { * case 'A' : * r = day[t->tm_wday]; * break; * [...] * * and lead to a SEGV if t->tm_wday is not in the range [0:6]. */ struct tm tms; char buf[4096]; int status; char *fmt; if (SLang_Num_Function_Args == 1) { time_t t = time(NULL); if (-1 == call_localtime (t, &tms)) return; if (-1 == validate_tm (&tms)) return; } else if (-1 == pop_tm_struct (&tms)) return; if (-1 == SLang_pop_slstring (&fmt)) return; /* Ugh. The man page says: * * The strftime() function returns the number of characters placed in the * array s, not including the terminating NUL character, provided the * string, including the terminating NUL, fits. Otherwise, it returns 0, * and the contents of the array is undefined. (Thus at least since libc * 4.4.4; very old versions of libc, such as libc 4.4.1, would return max * if the array was too small.) * * Note that the return value 0 does not necessarily indicate an error; * for example, in many locales %p yields an empty string. * * Was this too designed by committee? */ status = strftime (buf, sizeof(buf), fmt, &tms); if (status == 0) buf[0] = 0; buf[sizeof(buf)-1] = 0; (void) SLang_push_string (buf); SLang_free_slstring (fmt); }
static int pop_string_int (char **s, int *i) { *s = NULL; if ((-1 == SLang_pop_integer (i)) || (-1 == SLang_pop_slstring (s))) return -1; return 0; }
static int pop_hooks_info (char **s, SLang_Name_Type **nt) { if (NULL == (*nt = SLang_pop_function ())) return -1; if (-1 == SLang_pop_slstring (s)) return -1; return 0; }
static void intrin_apropos (void) { int num_args; char *pat; char *namespace_name; unsigned int flags; SLang_Array_Type *at; num_args = SLang_Num_Function_Args; if (-1 == SLang_pop_uinteger (&flags)) return; if (-1 == SLang_pop_slstring (&pat)) return; namespace_name = NULL; at = NULL; if (num_args == 3) { if (-1 == SLang_pop_slstring (&namespace_name)) goto free_and_return; } at = _pSLang_apropos (namespace_name, pat, flags); if (num_args == 3) { (void) SLang_push_array (at, 0); goto free_and_return; } /* Maintain compatibility with old version of the function. That version * did not take three arguments and returned everything to the stack. * Yuk. */ (void) push_string_array_elements (at); free_and_return: /* NULLs ok */ SLang_free_slstring (namespace_name); SLang_free_slstring (pat); SLang_free_array (at); }
static void usage (void) { char *msg; _pSLstrops_do_sprintf_n (SLang_Num_Function_Args - 1); /* do not include format */ if (-1 == SLang_pop_slstring (&msg)) return; _pSLang_verror (SL_USAGE_ERROR, "Usage: %s", msg); SLang_free_slstring (msg); }
static void import_module_intrin (void) { char *module; char *ns = NULL; if (SLang_Num_Function_Args == 2) { if (-1 == SLang_pop_slstring (&ns)) return; } if (-1 == SLang_pop_slstring (&module)) { SLang_free_slstring (ns); /* NULL ok */ return; } (void) import_module (module, ns); SLang_free_slstring (module); SLang_free_slstring (ns); /* NULL ok */ }
static void sl_decrypt (void){ /* input types */ char *ctype; unsigned char *outbuf, *iiv, *ikey, *idata; SLang_BString_Type *iv, *key, *data; /* internal types */ EVP_CIPHER_CTX ctx; const EVP_CIPHER *cipher; int outlen, tmplen, dlen, i; /* output types */ SLang_BString_Type *output; if (SLang_Num_Function_Args != 4 || SLang_pop_slstring(&ctype) == -1 ){ return; } cipher = EVP_get_cipherbyname(ctype); if (!cipher){ SLang_verror(SL_UNDEFINED_NAME,"could not find cipher %s",ctype); return; } if (SLang_pop_bstring(&iv) == -1 || SLang_pop_bstring(&key) == -1 || SLang_pop_bstring(&data) == -1 ){ return; } iiv = SLbstring_get_pointer (iv,&i); ikey = SLbstring_get_pointer (key,&i); idata = SLbstring_get_pointer (data,&dlen); outbuf = (char*)malloc(dlen+EVP_CIPHER_block_size(cipher)); EVP_CIPHER_CTX_init(&ctx); EVP_DecryptInit_ex(&ctx, cipher, NULL, ikey, iiv); if (!EVP_DecryptUpdate(&ctx, outbuf, &outlen, idata, dlen)){ return; /*emit an error here*/ } if (!EVP_DecryptFinal(&ctx, outbuf + outlen, &tmplen)){ return; /*emit an error here*/ } outlen+=tmplen; output = SLbstring_create (outbuf, outlen); SLang_push_bstring(output); SLbstring_free(output); SLbstring_free(data); SLbstring_free(key); SLbstring_free(iv); free(outbuf); }
static int set_str_sockopt (Socket_Type *s, int level, int optname) { char *val; socklen_t len; int ret; if (-1 == SLang_pop_slstring (&val)) return -1; len = strlen (val); len++; ret = do_setsockopt (s->fd, level, optname, (void *)val, len); SLang_free_slstring (val); return ret; }
static void run_hooks_cmd (void) { unsigned int n; SLang_Array_Type *at; int method; char *hook; n = (unsigned int) SLang_Num_Function_Args; at = NULL; hook = NULL; switch (n) { case 3: if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE)) return; /* drop */ case 2: if (-1 == SLang_pop_integer (&method)) goto the_return; if (-1 == SLang_pop_slstring (&hook)) goto the_return; break; default: SLang_verror (SL_USAGE_ERROR, "usage: expecting 2 or 3 arguments"); return; } switch (method) { case JED_HOOKS_RUN_ALL: case JED_HOOKS_RUN_UNTIL_0: case JED_HOOKS_RUN_UNTIL_NON_0: break; default: SLang_verror (SL_INVALID_PARM, "run method %d is not supported", method); goto the_return; } if (at == NULL) (void) jed_run_hooks (hook, method, 0, NULL); else (void) jed_run_hooks (hook, method, at->num_elements, (char **) at->data); the_return: SLang_free_slstring (hook); SLang_free_array (at); }
static int load_string_or_file (int (*f) (SLFUTURE_CONST char *, SLFUTURE_CONST char *)) { char *file; char *ns = NULL; int status; if (SLang_Num_Function_Args == 2) { if (-1 == SLang_pop_slstring (&ns)) return -1; } if (-1 == SLang_pop_slstring (&file)) { SLang_free_slstring (ns); return -1; } status = (*f) (file, ns); SLang_free_slstring (file); SLang_free_slstring (ns); return status; }
int _pSLerr_throw (void) { int e; int nargs = SLang_Num_Function_Args; char *msg = NULL; free_thrown_object (); switch (nargs) { case 3: if (-1 == SLang_pop (&Object_Thrown)) return -1; Object_Thrownp = &Object_Thrown; /* drop */ case 2: if (-1 == SLang_pop_slstring (&msg)) { free_thrown_object (); return -1; } case 1: /* drop */ if (-1 == _pSLerr_pop_exception (&e)) { SLang_free_slstring (msg);/* NULL ok */ free_thrown_object (); return -1; } break; case 0: /* rethrow */ return rethrow_error (); default: _pSLang_verror (SL_NumArgs_Error, "expecting: throw error [, optional-message [, optional-arg]]"); return -1; } if (msg != NULL) { _pSLang_verror (e, "%s", msg); SLang_free_slstring (msg); } else SLang_set_error (e); return 0; }
static void set_frame_variable (void) { char *name; int depth; if (-1 == SLroll_stack (3)) return; if (-1 == SLang_pop_slstring (&name)) return; if (0 == SLang_pop_int (&depth)) (void) _pSLang_set_frame_variable ((unsigned int) depth, name); SLang_free_slstring (name); }
static void _pgtick (void) { float x1, x2, y1, y2, v, tikl, tikr, orient, disp; char *s; if (-1 == SLang_pop_slstring (&s)) return; if ((0 == pop_5_floats (&v, &tikl, &tikr, &disp, &orient)) && (0 == pop_5_floats (&x1, &y1, &x2, &y2, NULL))) { cpgtick (x1, y1, x2, y2, v, tikl, tikr, disp, orient, s); } SLang_free_slstring (s); }
int SLpop_string (char **s) /*{{{*/ { char *sls; *s = NULL; if (-1 == SLang_pop_slstring (&sls)) return -1; if (NULL == (*s = SLmake_string (sls))) { SLang_free_slstring (sls); return -1; } SLang_free_slstring (sls); return 0; }
/*}}}*/ #if defined(PF_INET) && defined(AF_INET) /*{{{*/ static int pop_host_port (SLFUTURE_CONST char *what, int nargs, char **hostp, int *portp) { char *host; int port; if (nargs != 2) { SLang_verror (SL_NumArgs_Error, "%s on an PF_INET socket requires a hostname and portnumber", what); return -1; } *hostp = NULL; if ((-1 == SLang_pop_int (&port)) || (-1 == SLang_pop_slstring (&host))) return -1; *hostp = host; *portp = port; return 0; }
static int set_multicast_if_sockopt (Socket_Type *s, int level, int option) { struct in_addr iface; char *local; Host_Addr_Info_Type *local_info; if (-1 == SLang_pop_slstring(&local)) return -1; if (NULL == (local_info = get_host_addr_info (local))) { SLang_free_slstring (local); return -1; } memcpy ((char *) &iface.s_addr, local_info->h_addr_list[0], local_info->h_length); SLang_free_slstring(local); free_host_addr_info (local_info); return do_setsockopt (s->fd, level, option, (void *)&iface, sizeof(iface)); }
static VOID_STAR pop_onig_name_ptr (Name_Map_Type *map, char *onig_object) { char *str; if (-1 == SLang_pop_slstring (&str)) return NULL; while (map->name != NULL) { if (0 == strcmp (str, map->name)) { SLang_free_slstring (str); return map->ptr; } map++; } SLang_verror (SL_InvalidParm_Error, "Unsupported or unknown onig %s: %s", onig_object, str); SLang_free_slstring (str); return NULL; }
static void _pgaxis (void) { char *opt; float x1, y_1, x2, y2, v1, v2, step; int nsub; float dmajl, dmajr, f_min, disp, orient; if (-1 == pop_5_floats (&dmajl, &dmajr, &f_min, &disp, &orient)) return; if (-1 == SLang_pop_integer (&nsub)) return; if (-1 == pop_5_floats (&x2, &y2, &v1, &v2, &step)) return; if (-1 == pop_5_floats (&x1, &y_1, NULL, NULL, NULL)) return; if (-1 == SLang_pop_slstring (&opt)) return; cpgaxis (opt, x1, y_1, x2, y2, v1, v2, step, nsub, dmajl, dmajr, f_min, disp, orient); SLang_free_slstring (opt); }