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 void sl_base64_encode (void){
SLang_BString_Type* input;
unsigned char* inbuf;
BIO *bio, *b64;
BUF_MEM *bptr;
char *buff;
int i,inlen;
if (SLang_Num_Function_Args != 1 ||
SLang_pop_bstring(&input) == -1 ){
return; }
inbuf = SLbstring_get_pointer(input, &inlen);
b64 = BIO_new(BIO_f_base64());
bio = BIO_new(BIO_s_mem());
b64 = BIO_push(b64,bio);
BIO_write(b64,inbuf,inlen);
BIO_flush(b64);
BIO_get_mem_ptr(b64, &bptr);
buff = (char*)malloc(bptr->length);
memcpy(buff, bptr->data, bptr->length-1);
buff[bptr->length-1] = 0;
BIO_free_all(b64);
SLang_push_string((char*)buff);
SLbstring_free(input);
free(buff);
}
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 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);
}
void _pSLbstring_foreach_close (SLtype type, SLang_Foreach_Context_Type *c)
{
(void) type;
if (c == NULL) return;
SLbstring_free (c->bstr);
SLfree ((char *) c);
}
static void free_n_bstrings (SLang_BString_Type **a, unsigned int n)
{
unsigned int i;
if (a == NULL) return;
for (i = 0; i < n; i++)
{
SLbstring_free (a[i]);
a[i] = NULL;
}
}
/* 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_hmac (void){
char *dtype;
SLang_BString_Type *key, *data;
unsigned char *ikey, *idata;
unsigned char hash[EVP_MAX_MD_SIZE];
unsigned int hashlen, klen, dlen;
SLang_BString_Type *output;
const EVP_MD *md;
if (SLang_Num_Function_Args != 3 ||
SLang_pop_slstring(&dtype) == -1 ){
return; } /* should return error there of course */
md=EVP_get_digestbyname(dtype);
if (!md){
SLang_verror(SL_UNDEFINED_NAME,"could not find digest %s",dtype);
SLang_free_slstring(dtype);
return; }
if (SLang_pop_bstring(&key) == -1 ||
SLang_pop_bstring(&data) == -1 ){
return; }
ikey = SLbstring_get_pointer(key, &klen);
idata = SLbstring_get_pointer(data, &dlen);
HMAC(md,ikey,klen,idata,dlen,&hash,&hashlen);
output = SLbstring_create(hash, hashlen);
SLang_push_bstring(output);
SLbstring_free(data);
SLbstring_free(key);
SLbstring_free(output);
SLang_free_slstring(dtype);
}
static void sl_digest (void){
SLang_BString_Type* data; /* we will give a slang string */
unsigned char output[EVP_MAX_MD_SIZE];
const EVP_MD *md;
EVP_MD_CTX ctx;
char* dtype;
int dlen, hashlen;
SLang_BString_Type *out;
if (SLang_Num_Function_Args != 2 ||
SLang_pop_slstring(&dtype) == -1 ){
return;}
md = EVP_get_digestbyname(dtype);
if (!md){
SLang_verror(SL_UNDEFINED_NAME,"could not find digest %s",dtype);
SLang_free_slstring(dtype);
return;
}
if (SLang_pop_bstring(&data) == -1 ){
return;
}
unsigned char* idata = SLbstring_get_pointer (data,&dlen);
EVP_MD_CTX_init(&ctx);
EVP_DigestInit_ex(&ctx, md, NULL);
EVP_DigestUpdate(&ctx, idata, dlen);
EVP_DigestFinal(&ctx, output, &hashlen);
out = SLbstring_create (output, hashlen);
SLang_push_bstring(out);
SLbstring_free(data);
SLbstring_free(out);
}
static void _iconv_reset_shift(ICONV_Type *it)
{
size_t n = SHIFT_BUF_LEN;
char buf[SHIFT_BUF_LEN], *p = buf;
SLang_BString_Type *bstr;
size_t rc;
rc = iconv(it->cd, NULL, NULL, &p, &n);
if ((rc == (size_t)(-1)) || (n > rc))
{
SLang_verror (SL_Internal_Error, "Internal error: shift buffer too small in iconv_reset_shift!");
return;
}
buf[SHIFT_BUF_LEN-n] = '\0';
bstr = SLbstring_create((unsigned char *)buf, SHIFT_BUF_LEN-n);
if (bstr == NULL)
return;
(void) SLang_push_bstring(bstr);
SLbstring_free (bstr);
}
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);
}
static void bstring_destroy (unsigned char unused, VOID_STAR s)
{
(void) unused;
SLbstring_free (*(SLang_BString_Type **) s);
}
static void sl_generate_key (void){
char* pass, *ctype, *dtype;
SLang_BString_Type* salta;
const EVP_CIPHER *cipher;
const EVP_MD *md;
unsigned char *salt;
unsigned char *key;
unsigned char *iv;
SLang_BString_Type* outkey, *outiv;
int count,i,keylen,ivlen,saltlen;
if (SLang_Num_Function_Args != 5 ||
SLang_pop_slstring(&dtype) == -1 ||
SLang_pop_slstring(&ctype) == -1 ){
return; }
cipher = EVP_get_cipherbyname(ctype);
if (!cipher){
SLang_verror(SL_UNDEFINED_NAME,"could not find cipher %s",ctype);
SLang_free_slstring(ctype);
return;
}
md = EVP_get_digestbyname(dtype);
if (!md){
SLang_verror(SL_UNDEFINED_NAME,"could not find digest %s",dtype);
SLang_free_slstring(ctype);
SLang_free_slstring(dtype);
return;
}
if (SLang_pop_integer(&count) == -1 ||
SLang_pop_bstring(&salta) == -1 ||
SLang_pop_slstring(&pass) == -1 ){
return; }
keylen = EVP_CIPHER_key_length(cipher);
ivlen = EVP_CIPHER_iv_length(cipher);
key = (char*)malloc(keylen);
iv = (char*)malloc(ivlen);
salt = SLbstring_get_pointer(salta,&saltlen);
if (saltlen==0){
salt=NULL;
}
else if (saltlen!=8){
SLang_verror(SL_USAGE_ERROR,"Salt must not exceed 8 bytes");
SLbstring_free(salta);
SLang_free_slstring(pass);
SLang_free_slstring(ctype);
SLang_free_slstring(dtype);
return;
}
EVP_BytesToKey(cipher,md,salt,pass,(int)strlen(pass),count,key,iv);
outkey = SLbstring_create(key, keylen);
outiv = SLbstring_create(iv, ivlen);
SLang_push_bstring(outkey);
SLang_push_bstring(outiv);
SLbstring_free(salta);
SLbstring_free(outkey);
SLbstring_free(outiv);
SLang_free_slstring(pass);
SLang_free_slstring(ctype);
SLang_free_slstring(dtype);
free(key);free(iv);
}
static void _iconv(ICONV_Type *it, SLang_BString_Type *bstr)
{
char *buf = NULL;
size_t rc;
char ICONV_CONST *instr;
char *outstr;
size_t inn, outn, bufn;
size_t fail = (size_t)-1;
SLstrlen_Type bstrlen;
if (NULL == (instr = (char ICONV_CONST *)SLbstring_get_pointer(bstr, &bstrlen)))
return;
inn = (size_t) bstrlen;
bufn = outn = 2*inn + 2;
if (NULL == (buf = (char *)SLmalloc(bufn)))
return;
outstr = buf;
while (1)
{
errno = 0;
rc = iconv(it->cd, &instr, &inn, &outstr, &outn);
if (rc != (size_t)-1)
break; /* ok! */
if (fail == inn)
{
SLang_verror (SL_Unknown_Error, "Unknown error in iconv");
goto error;
}
fail = inn;
switch (errno)
{
case EILSEQ:
SLang_verror (SL_InvalidUTF8_Error, "Invalid multibyte sequence or unable to convert to the target encoding");
goto error;
case EINVAL:
SLang_verror (SL_InvalidUTF8_Error, "Incomplete multibyte sequence");
goto error;
case 0:
/* drop */
/* grrrr
* At least on windows, libiconv returns with errno = 0
* (or unmodified?) when there's no more roon on outstr
* if so, fallback
*/
case E2BIG:
{
char *p;
long outdelta;
outdelta = outstr - buf;
outn += bufn;
bufn += bufn;
p = (char *)SLrealloc(buf, bufn);
if (p == NULL)
goto error;
buf = p;
outstr = buf + outdelta;
}
break;
default:
SLang_verror (SL_Unknown_Error, "Unknown iconv error");
goto error;
}
}
bstr = SLbstring_create((unsigned char *) buf, outstr - buf);
if (bstr != NULL)
(void) SLang_push_bstring(bstr);
SLbstring_free (bstr);
/* drop */
error:
SLfree(buf);
}
/* Usage: onig_search (o, str [start, end] [,option]) */
static int do_onig_search (void)
{
int start_pos = 0, end_pos = -1;
char *str, *str_end;
SLang_BString_Type *bstr = NULL;
Onig_Type *o;
SLang_MMT_Type *mmt;
int status = -1;
OnigOptionType option = ONIG_OPTION_NONE;
switch (SLang_Num_Function_Args)
{
default:
SLang_verror (SL_Usage_Error, "Usage: n = onig_search (compiled_pattern, str [,start_ofs, end_ofs] [,option])");
return -1;
case 5:
if (-1 == pop_onig_option (&option))
return -1;
/* drop */
case 4:
if (-1 == SLang_pop_int (&end_pos))
return -1;
if (-1 == SLang_pop_int (&start_pos))
return -1;
break;
case 3:
if (-1 == pop_onig_option (&option))
return -1;
break;
case 2:
break;
}
switch(SLang_peek_at_stack())
{
case SLANG_STRING_TYPE:
if (-1 == SLang_pop_slstring (&str))
return -1;
str_end = str + strlen (str);
break;
case SLANG_BSTRING_TYPE:
default:
{
unsigned int len;
if (-1 == SLang_pop_bstring(&bstr))
return -1;
str = (char *)SLbstring_get_pointer(bstr, &len);
if (str == NULL)
{
SLbstring_free (bstr);
return -1;
}
str_end = str + len;
}
break;
}
if (end_pos < 0)
end_pos = (int) (str_end - str);
if (NULL == (mmt = SLang_pop_mmt (Onig_Type_Id)))
goto free_and_return;
o = (Onig_Type *)SLang_object_from_mmt (mmt);
status = do_onig_search_internal (o, option, (UChar *)str, (UChar *)str_end, start_pos, end_pos);
if (status >= 0)
{
o->match_pos = status;
status = o->region->num_regs;
goto free_and_return;
}
o->match_pos = -1;
if (status == -1)
{ /* no match */
status = 0;
goto free_and_return;
}
/* Else an error occurred */
/* drop */
free_and_return:
SLang_free_mmt (mmt);
if (bstr != NULL)
SLbstring_free (bstr);
else
SLang_free_slstring (str);
return status;
}
void _pSLunpack (char *format, SLang_BString_Type *bs)
{
Format_Type ft;
unsigned char *b;
unsigned int len;
unsigned int num_bytes;
check_native_byte_order ();
if (-1 == compute_size_for_format (format, &num_bytes))
return;
b = SLbstring_get_pointer (bs, &len);
if (b == NULL)
return;
if (len < num_bytes)
{
_pSLang_verror (SL_INVALID_PARM,
"unpack format %s is too large for input string",
format);
return;
}
while (1 == parse_a_format (&format, &ft))
{
char *str, *s;
if (ft.repeat == 0)
continue;
if (ft.data_type == 0)
{ /* skip padding */
b += ft.repeat;
continue;
}
if (ft.is_scalar)
{
SLang_Array_Type *at;
SLindex_Type dims;
if (ft.repeat == 1)
{
SLang_Class_Type *cl;
cl = _pSLclass_get_class (ft.data_type);
memcpy ((char *)cl->cl_transfer_buf, (char *)b, ft.sizeof_type);
if (ft.byteorder != NATIVE_ORDER)
byteswap (ft.byteorder, (unsigned char *)cl->cl_transfer_buf, ft.sizeof_type, 1);
if (-1 == (cl->cl_apush (ft.data_type, cl->cl_transfer_buf)))
return;
b += ft.sizeof_type;
continue;
}
dims = (SLindex_Type) ft.repeat;
at = SLang_create_array (ft.data_type, 0, NULL, &dims, 1);
if (at == NULL)
return;
num_bytes = ft.repeat * ft.sizeof_type;
memcpy ((char *)at->data, (char *)b, num_bytes);
if (ft.byteorder != NATIVE_ORDER)
byteswap (ft.byteorder, (unsigned char *)at->data, ft.sizeof_type, ft.repeat);
if (-1 == SLang_push_array (at, 1))
return;
b += num_bytes;
continue;
}
/* string type: s, S, or Z */
if (ft.format_type == 's')
len = ft.repeat;
else
len = get_unpadded_strlen ((char *)b, ft.pad, ft.repeat);
str = SLmalloc (len + 1);
if (str == NULL)
return;
memcpy ((char *) str, (char *)b, len);
str [len] = 0;
/* Avoid a bstring if possible */
s = SLmemchr (str, 0, len);
if (s == NULL)
{
if (-1 == SLang_push_malloced_string (str))
return;
}
else
{
SLang_BString_Type *new_bs;
new_bs = SLbstring_create_malloced ((unsigned char *)str, len, 1);
if (new_bs == NULL)
return;
if (-1 == SLang_push_bstring (new_bs))
{
SLfree (str);
return;
}
SLbstring_free (new_bs);
}
b += ft.repeat;
}
}
static SLang_BString_Type *
pack_according_to_format (char *format, unsigned int nitems)
{
unsigned int size, num;
unsigned char *buf, *b;
SLang_BString_Type *bs;
Format_Type ft;
buf = NULL;
if (-1 == compute_size_for_format (format, &size))
goto return_error;
if (NULL == (buf = (unsigned char *) SLmalloc (size + 1)))
goto return_error;
b = buf;
while (1 == parse_a_format (&format, &ft))
{
unsigned char *ptr;
unsigned int repeat;
repeat = ft.repeat;
if (ft.data_type == 0)
{
memset ((char *) b, ft.pad, repeat);
b += repeat;
continue;
}
if (ft.is_scalar)
{
unsigned char *bstart;
num = repeat;
bstart = b;
while (repeat != 0)
{
unsigned int nelements;
SLang_Array_Type *at;
if (nitems == 0)
{
_pSLang_verror (SL_INVALID_PARM,
"Not enough items for pack format");
goto return_error;
}
if (-1 == SLang_pop_array_of_type (&at, ft.data_type))
goto return_error;
nelements = at->num_elements;
if (repeat < nelements)
nelements = repeat;
repeat -= nelements;
nelements = nelements * ft.sizeof_type;
memcpy ((char *)b, (char *)at->data, nelements);
b += nelements;
SLang_free_array (at);
nitems--;
}
if (ft.byteorder != NATIVE_ORDER)
byteswap (ft.byteorder, bstart, ft.sizeof_type, num);
continue;
}
/* Otherwise we have a string */
if (-1 == SLang_pop_bstring (&bs))
goto return_error;
ptr = SLbstring_get_pointer (bs, &num);
if (repeat < num) num = repeat;
memcpy ((char *)b, (char *)ptr, num);
b += num;
repeat -= num;
if ((repeat == 0) && (ft.format_type == 'z'))
{
if (num) *(b-1) = 0;
}
else memset ((char *)b, ft.pad, repeat);
SLbstring_free (bs);
b += repeat;
nitems--;
}
*b = 0;
bs = SLbstring_create_malloced (buf, size, 0);
if (bs == NULL)
goto return_error;
SLdo_pop_n (nitems);
return bs;
return_error:
SLdo_pop_n (nitems);
if (buf != NULL)
SLfree ((char *) buf);
return NULL;
}
static void bstring_destroy (SLtype unused, VOID_STAR s)
{
(void) unused;
SLbstring_free (*(SLang_BString_Type **) s);
}
SLang_Foreach_Context_Type *
_pSLbstring_foreach_open (SLtype type, unsigned int num)
{
char *u;
SLang_Foreach_Context_Type *c;
int using_chars = 0;
SLang_BString_Type *bstr;
unsigned int len;
(void) type;
if (-1 == SLang_pop_bstring (&bstr))
return NULL;
switch (num)
{
case 1:
if (-1 == SLang_pop_slstring (&u))
{
SLbstring_free (bstr);
return NULL;
}
if (0 == strcmp (u, "chars"))
using_chars = 1;
else if (0 == strcmp (u, "bytes"))
using_chars = 0;
else
{
_pSLang_verror (SL_InvalidParm_Error, "Expected foreach ([B]String_Type) using (chars|bytes)");
SLang_free_slstring (u);
SLbstring_free (bstr);
return NULL;
}
SLang_free_slstring (u);
break;
case 0:
using_chars = 0;
break;
default:
_pSLang_verror (SL_NumArgs_Error,
"'foreach ([B]String_Type) using' requires single control value (chars|bytes)");
return NULL;
}
/* In UTF-8 mode, chars and bytes are synonymous */
if (_pSLinterp_UTF8_Mode == 0)
using_chars = 0;
c = (SLang_Foreach_Context_Type *)SLmalloc (sizeof (SLang_Foreach_Context_Type));
if (c == NULL)
{
SLbstring_free (bstr);
return NULL;
}
memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type));
c->bstr = bstr;
c->s = SLbstring_get_pointer (bstr, &len);
c->smax = c->s + len;
c->using_chars = using_chars;
return c;
}