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 _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_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);
}
void sl_ioctl (void)
{
char *argp = NULL;
int fd, retval;
unsigned int length, request;
SLFile_FD_Type *f;
SLang_BString_Type *bstr;
if (SLang_Num_Function_Args == 3)
{
if (SLang_pop_bstring (&bstr) == -1)
goto usage_error;
if (SLang_pop_uint ((unsigned int *) &request) == -1)
goto usage_error;
if (SLfile_pop_fd (&f) == -1)
goto usage_error;
argp = SLbstring_get_pointer (bstr, &length);
}
else if (SLang_Num_Function_Args == 2)
{
if (SLang_pop_uint ((unsigned int *) &request) == -1)
goto usage_error;
if (SLfile_pop_fd (&f) == -1)
goto usage_error;
}
else
goto usage_error;
if (SLfile_get_fd (f, &fd) == -1)
return;
if ((retval = ioctl (fd, request, argp)) == -1)
{
SLang_set_error (SL_OS_Error);
(void) SLerrno_set_errno (errno);
return;
}
(void) SLang_push_int (retval);
if (argp != NULL)
(void) SLang_push_bstring (bstr);
return;
usage_error :
SLang_set_error (SL_Usage_Error);
return;
}
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_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 int bstring_push (unsigned char unused, VOID_STAR sptr)
{
(void) unused;
return SLang_push_bstring (*(SLang_BString_Type **) sptr);
}
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);
}
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 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);
}
