char *Plot_configure_axis (char *opt, int is_log, int has_numbers) /*{{{*/
{
char *s;
if (pli_undefined())
return NULL;
if (PLI->configure_axis == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: configure_axis operation is not supported");
return NULL;
}
SLang_start_arg_list ();
SLang_push_string (opt);
SLang_push_integer (is_log);
SLang_push_integer (has_numbers);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->configure_axis))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: configure_axis failed");
return NULL;
}
if (-1 == SLpop_string (&s))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: configure_axis failed");
return NULL;
}
return s;
}
int Plot_subdivide (int num_x_subpanels, int num_y_subpanels) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->subdivide == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: subdivide operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_integer (num_x_subpanels);
SLang_push_integer (num_y_subpanels);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->subdivide))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed subdividing plot device");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed subdividing plot device");
return -1;
}
return status;
}
static void get_passwd_cmd (char *name) /*{{{*/
{
char *password = NULL;
char *dir = NULL;
char *shell = NULL;
int uid = -1, gid = -1;
#if HAS_PASSWORD_CODE
struct passwd *pwent;
if (*name == 0)
pwent = getpwuid (getuid ());
else
pwent = getpwnam (name);
if (pwent != NULL)
{
password = pwent->pw_passwd;
uid = pwent->pw_uid;
gid = pwent->pw_gid;
dir = pwent->pw_dir;
shell = pwent->pw_shell;
}
#endif
if (password == NULL) password = "";
if (dir == NULL) dir = "";
if (shell == NULL) shell = "";
(void) SLang_push_string (dir);
(void) SLang_push_string (shell);
(void) SLang_push_string (password);
(void) SLang_push_integer (uid);
(void) SLang_push_integer (gid);
}
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 push_2_ints (int a, int b)
{
if (-1 == SLang_push_integer (a))
return -1;
return SLang_push_integer (b);
}
static void sl_ssl_read(void){
SLssl_Type *ssl;
SLang_MMT_Type *sslmmt;
SLang_Ref_Type *buff;
void *ibuff;
SLang_BString_Type *data;
int r, rlen;
if (SLang_pop_integer(&rlen)==-1 ||
SLang_pop_ref(&buff)==-1 ||
NULL==(sslmmt=SLang_pop_mmt(SLssl_Type_Id)))
return;
ssl=(SLssl_Type *)SLang_object_from_mmt(sslmmt);
ibuff=(void *)malloc(rlen);
r=SSL_read((SSL *)ssl->ssl,ibuff,rlen);
data=SLbstring_create((unsigned char *)ibuff,r);
SLang_assign_to_ref(buff, SLANG_BSTRING_TYPE, (VOID_STAR)&data);
if (r>=0)
SLang_push_integer(r);
else
SLang_verror(r,"SSL read returned error code %d",
SSL_get_error((SSL *)ssl->ssl,r));
SLang_free_ref(buff);
}
/* This function is reentrant */
static int handle_signal (Signal_Type *s)
{
int status = 0;
int was_blocked;
(void) block_signal (s->sig, &was_blocked);
/* At this point, sig is blocked and the handler is about to be called.
* The pending flag can be safely set to 0 here.
*/
s->pending = 0;
if (s->handler != NULL)
{
int depth = SLstack_depth ();
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_integer (s->sig))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (s->handler)))
status = -1;
if ((status == 0)
&& (depth != SLstack_depth ()))
{
SLang_verror (SL_Application_Error, "The signal handler %s corrupted the stack", s->handler->name);
status = -1;
}
}
if (was_blocked == 0)
(void) unblock_signal (s->sig);
return status;
}
int Plot_select_window (int device) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->select_window == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: select_window operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_integer (device);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->select_window))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed selecting plot device");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed selecting plot device");
return -1;
}
return status;
}
int Plot_points (int n, float *x, float *y, int symbol) /*{{{*/
{
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_points == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: plot_points operation is not supported");
return -1;
}
SLang_start_arg_list ();
status = push_two_float_arrays (n, x, y);
SLang_push_integer (symbol);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_points)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting points");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting points");
return -1;
}
return status;
}
static void atoi_intrin (void)
{
char *s;
SLang_Array_Type *ats;
SLang_Array_Type *ati;
int *ip;
char **strp, **strpmax;
if (-1 == pop_array_or_string (SLANG_INT_TYPE, &s, &ats, &ati))
return;
if (s != NULL)
{
(void) SLang_push_integer (atoi (s));
SLang_free_slstring (s);
return;
}
strp = (char **) ats->data;
strpmax = strp + ats->num_elements;
ip = (int *) ati->data;
while (strp < strpmax)
{
if (*strp == NULL)
*ip++ = 0;
else
*ip++ = atoi (*strp);
strp++;
}
SLang_free_array (ats);
(void) SLang_push_array (ati, 1);
}
static int push_int_2_doubles (int a, double b, double c)
{
if (-1 == SLang_push_integer (a))
return -1;
return push_2_doubles (b, c);
}
static void sl_ssl_verify(void){
SLssl_Type *ssl;
SLang_MMT_Type *sslmmt;
X509 *cert;
if (NULL==(sslmmt=SLang_pop_mmt(SLssl_Type_Id)))
return;
ssl=(SLssl_Type *)SLang_object_from_mmt(sslmmt);
cert=SSL_get_peer_certificate((SSL *)ssl->ssl);
if (cert==NULL)
SLang_push_integer(-1);
else
SLang_push_integer(SSL_get_verify_result((SSL *)ssl->ssl));
X509_free(cert);
}
/* Usage: Uint write (f, buf); */
static void posix_write (SLFile_FD_Type *f, SLang_BString_Type *bstr)
{
unsigned int len;
char *p;
if ((NULL == (p = (char *)SLbstring_get_pointer (bstr, &len)))
|| (-1 == do_write (f, p, &len)))
{
SLang_push_integer (-1);
return;
}
(void) SLang_push_uinteger (len);
}
int _Plot_draw_box (char *xopt, float xtick, int nxsub, /*{{{*/
char *yopt, float ytick, int nysub)
{
int status;
if (pli_undefined())
return -1;
if (PLI->draw_box == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: draw_box operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_string (xopt);
SLang_push_float (xtick);
SLang_push_integer (nxsub);
SLang_push_string (yopt);
SLang_push_float (ytick);
SLang_push_integer (nysub);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->draw_box))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: draw_box failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: draw_box failed");
return -1;
}
return status;
}
static void eob_bob_error (int f)
{
char *str;
if ((CBuf->buffer_hooks != NULL)
&& (CBuf->buffer_hooks->bob_eob_error_hook != NULL))
{
SLang_push_integer (f);
SLexecute_function (CBuf->buffer_hooks->bob_eob_error_hook);
return;
}
if (f < 0)
str = Top_Of_Buffer_Error;
else
str = End_Of_Buffer_Error;
msg_error (str);
}
static void sl_ssl_handshake (void){
SLssl_Type *ssl;
SLang_MMT_Type *sslmmt;
int r;
if (NULL==(sslmmt=SLang_pop_mmt(SLssl_Type_Id)))
return;
ssl=(SLssl_Type *)SLang_object_from_mmt(sslmmt);
if (ssl->is_server==1)
r=SSL_accept((SSL *)ssl->ssl);
else
r=SSL_connect((SSL *)ssl->ssl);
if (r==1)
SLang_push_integer(r);
else
SLang_verror(r,"SSL handshake returned %d (error code %d)",r,
SSL_get_error((SSL *)ssl->ssl,r));
}
static int push_string_array_elements (SLang_Array_Type *at)
{
char **strs;
unsigned int num;
unsigned int i;
if (at == NULL)
return -1;
strs = (char **)at->data;
num = at->num_elements;
for (i = 0; i < num; i++)
{
if (-1 == SLang_push_string (strs[i]))
{
SLdo_pop_n (i);
return -1;
}
}
SLang_push_integer ((int) num);
return 0;
}
/* Usage: nn = read (f, &buf, n); */
static void posix_read (SLFile_FD_Type *f, SLang_Ref_Type *ref, unsigned int *nbytes)
{
unsigned int len;
char *b;
SLang_BString_Type *bstr;
b = NULL;
len = *nbytes;
if ((NULL == (b = SLmalloc (len + 1)))
|| (-1 == do_read (f, b, &len)))
goto return_error;
if (len != *nbytes)
{
char *b1 = SLrealloc (b, len + 1);
if (b1 == NULL)
goto return_error;
b = b1;
}
bstr = SLbstring_create_malloced ((unsigned char *) b, len, 0);
if (bstr != NULL)
{
if (-1 == SLang_assign_to_ref (ref, SLANG_BSTRING_TYPE, (VOID_STAR)&bstr))
{
SLbstring_free (bstr);
return;
}
SLbstring_free (bstr);
(void) SLang_push_uinteger (len);
return;
}
return_error:
if (b != NULL) SLfree ((char *)b);
(void) SLang_assign_to_ref (ref, SLANG_NULL_TYPE, NULL);
(void) SLang_push_integer (-1);
}
static void sl_ssl_write(void){
SLssl_Type *ssl;
SLang_MMT_Type *sslmmt;
SLang_BString_Type *data;
int r, dlen;
if (SLang_pop_bstring(&data)==-1 ||
NULL==(sslmmt=SLang_pop_mmt(SLssl_Type_Id)))
return;
ssl=(SLssl_Type *)SLang_object_from_mmt(sslmmt);
const void *idata = SLbstring_get_pointer(data,&dlen);
r=SSL_write((SSL *)ssl->ssl,idata,dlen);
if (r>=0)
SLang_push_integer(r);
else
SLang_verror(r,"SSL write returned error code %d",
SSL_get_error((SSL *)ssl->ssl,r));
SLbstring_free(data);
}
