/**
unserialize : string -> #loader -> any
<doc>Unserialize a stored value.
Need a loader to look for modules if some bytecode functions have been serialized.
</doc>
**/
static value unserialize( value s, value loader ) {
sbuffer b;
val_check(s,string);
b.cur = (unsigned char*)val_string(s);
b.pos = 0;
b.olds = NULL;
b.trefs = NULL;
b.tsize = 0;
b.nrefs = 0;
b.size = val_strlen(s);
b.totlen = 0;
return unserialize_rec(&b,loader);
}
static value dump_prof() {
dump_param p;
value o = val_this();
value cache;
val_check(o,object);
cache = val_field(o,id_cache);
val_check(cache,object);
p.tot = 0;
p.callb = profile_total;
val_iter_fields(cache,dump_module,&p);
printf("Summary :\n");
p.callb = profile_summary;
val_iter_fields(cache,dump_module,&p);
printf("%10d\n\n",p.tot);
printf("Functions :\n");
p.callb = profile_functions;
val_iter_fields(cache,dump_module,&p);
printf("\n");
p.callb = profile_details;
val_iter_fields(cache,dump_module,&p);
return val_true;
}
/**
socket_connect : 'socket -> host:'int32 -> port:int -> void
<doc>Connect the socket the given [host] and [port]</doc>
**/
static value socket_connect( value o, value host, value port ) {
struct sockaddr_in addr;
val_check_kind(o,k_socket);
val_check(host,int32);
val_check(port,int);
memset(&addr,0,sizeof(addr));
addr.sin_family = AF_INET;
addr.sin_port = htons(val_int(port));
*(int*)&addr.sin_addr.s_addr = val_int32(host);
if( connect(val_sock(o),(struct sockaddr*)&addr,sizeof(addr)) != 0 )
return block_error();
return val_true;
}
/**
$sset : string -> n:int -> c:int -> int?
<doc>
Set the [n]th char of a string to ([c] & 255).
Returns the char set or [null] if out of bounds.
</doc>
**/
static value builtin_sset( value s, value p, value c ) {
int pp;
unsigned char cc;
val_check(s,string);
val_check(p,int);
val_check(c,int);
pp = val_int(p);
if( pp < 0 || pp >= val_strlen(s) )
return val_null;
cc = (unsigned char)val_int(c);
val_string(s)[pp] = (char)cc;
return alloc_int(cc);
}
value fcFindFont( value _familyName, value _weight, value _slant, value _size ) {
val_check(_familyName,string);
val_check(_weight,number);
val_check(_slant,number);
val_check(_size,number);
const char *familyName = val_string(_familyName);
int weight = val_number(_weight);
int slant = val_number(_slant);
float size = val_number(_size);
FcPattern *pattern;
pattern = FcNameParse( (FcChar8*)familyName );
FcDefaultSubstitute( pattern );
FcConfigSubstitute( FcConfigGetCurrent(), pattern, FcMatchPattern );
FcResult result;
FcPattern *match = FcFontMatch( 0, pattern, &result );
FcPatternDestroy( pattern );
if( !match ) val_throw(alloc_string("Could not find font"));
FcChar8 *temp;
int id;
pattern = FcPatternDuplicate(match);
if( FcPatternGetString( pattern, FC_FILE, 0, &temp ) != FcResultMatch ||
FcPatternGetInteger( pattern, FC_INDEX, 0, &id ) != FcResultMatch ) {
val_throw(alloc_string("Could not load font"));
}
value ret = alloc_string((const char *)temp);
FcPatternDestroy( pattern );
FcPatternDestroy( match );
return ret;
}
/**
float_bytes : number -> bigendian:bool -> string
<doc>Returns the 4 bytes representation of the number as an IEEE 32-bit float</doc>
**/
static value float_bytes( value n, value be ) {
float f;
val_check(n,number);
val_check(be,bool);
f = (float)val_number(n);
if( neko_is_big_endian() != val_bool(be) ) {
char *c = (char*)&f;
char tmp;
tmp = c[0]; c[0] = c[3]; c[3] = tmp;
tmp = c[1]; c[1] = c[2]; c[2] = tmp;
}
return copy_string((char *)&f,4);
}
/**
$aconcat : array array -> array
<doc>
Build a single array from several ones.
</doc>
**/
static value builtin_aconcat( value arrs ) {
int tot = 0;
int len;
int i;
value all;
val_check(arrs,array);
len = val_array_size(arrs);
for(i=0;i<len;i++) {
value a = val_array_ptr(arrs)[i];
val_check(a,array);
tot += val_array_size(a);
}
all = alloc_array(tot);
tot = 0;
for(i=0;i<len;i++) {
value a = val_array_ptr(arrs)[i];
int j, max = val_array_size(a);
for(j=0;j<max;j++)
val_array_ptr(all)[tot++] = val_array_ptr(a)[j];
}
return all;
}
/**
Returns the ENetPeer that generated an event, with the Event
allocated pointer in Peer->data. The returned ENetPeer must not
be destroyed, since it's a copy of an existing peer pointer.
Timeout is float number of seconds (0.001 == 1 ms)
**/
static value udpr_poll(value h, value timeout)
{
//ENetPeerHandle hndPeer = enet_host_peer_to_handle(host, event->peer);
ENetEvent *event;
int res;
if( !val_is_abstract(h) || !val_is_kind(h,k_udprhost) )
neko_error();
val_check(timeout,number);
enet_uint32 tout = (enet_uint32)(val_number(timeout)*1000);
event = (ENetEvent *) enet_malloc (sizeof (ENetEvent));
// Wait up to timeout milliseconds for an event.
res = enet_host_service ((ENetHost *)val_data(h), event, tout);
if(res <= 0) {
if(res == 0)
return val_null;
neko_error();
}
switch (event->type)
{
case ENET_EVENT_TYPE_NONE:
//if(event->peer != NULL)
//free_peer_event(event->peer);
enet_free(event);
return val_null;
break;
default:
// auto frees any existing unhandled event, add this event.
#ifdef ENET_DEBUG_FULL
if(event->type == ENET_EVENT_TYPE_RECEIVE)
fprintf(stderr, "udpr_poll: event type %s %0.*s\n", event_to_string(event->type), event->packet->dataLength, event->packet->data);
else
fprintf(stderr, "udpr_poll: event type %s\n", event_to_string(event->type));
#endif
break;
}
value v = alloc_abstract(k_udprevent,event);
val_gc(v, destroy_enetevent);
return v;
#ifdef ENET_DEBUG
//fprintf(stderr, "udpr_poll: returning peer %x\n", event->peer);
#endif
//value v = alloc_abstract(k_udprpeer, event->peer);
//return v;
}
static value loader_loadmodule( value mname, value vthis ) {
value o = val_this();
value cache;
val_check(o,object);
val_check(mname,string);
val_check(vthis,object);
cache = val_field(o,id_cache);
val_check(cache,object);
{
reader r;
readp p;
neko_module *m;
neko_vm *vm = NEKO_VM();
field mid = val_id(val_string(mname));
value mv = val_field(cache,mid);
if( val_is_kind(mv,neko_kind_module) ) {
m = (neko_module*)val_data(mv);
return m->exports;
}
open_module(val_field(o,id_path),val_string(mname),&r,&p);
if( vm->fstats ) vm->fstats(vm,"neko_read_module",1);
m = neko_read_module(r,p,vthis);
if( vm->fstats ) vm->fstats(vm,"neko_read_module",0);
close_module(p);
if( m == NULL ) {
buffer b = alloc_buffer("Invalid module : ");
val_buffer(b,mname);
bfailure(b);
}
m->name = alloc_string(val_string(mname));
mv = alloc_abstract(neko_kind_module,m);
alloc_field(cache,mid,mv);
if( vm->fstats ) vm->fstats(vm,val_string(mname),1);
neko_vm_execute(neko_vm_current(),m);
if( vm->fstats ) vm->fstats(vm,val_string(mname),0);
return m->exports;
}
}
/**
socket_recv_from : 'socket -> buf:string -> pos:int -> length:int -> addr:{host:'int32,port:int} -> int
<doc>
Read data from an unconnected UDP socket, store the address from which we received data in addr.
</doc>
**/
static value socket_recv_from( value o, value data, value pos, value len, value addr ) {
int p,l,dlen,ret;
int retry = 0;
struct sockaddr_in saddr;
int slen = sizeof(saddr);
val_check_kind(o,k_socket);
val_check(data,string);
val_check(pos,int);
val_check(len,int);
val_check(addr,object);
p = val_int(pos);
l = val_int(len);
dlen = val_strlen(data);
if( p < 0 || l < 0 || p > dlen || p + l > dlen )
neko_error();
POSIX_LABEL(recv_from_again);
if( retry++ > NRETRYS ) {
sock_tmp t;
t.sock = val_sock(o);
t.buf = val_string(data) + p;
t.size = l;
neko_thread_blocking(tmp_recv,&t);
ret = t.ret;
} else
ret = recvfrom(val_sock(o), val_string(data) + p , l, MSG_NOSIGNAL, (struct sockaddr*)&saddr, &slen);
if( ret == SOCKET_ERROR ) {
HANDLE_EINTR(recv_from_again);
#ifdef NEKO_WINDOWS
if( WSAGetLastError() == WSAECONNRESET )
ret = 0;
else
#endif
return block_error();
}
alloc_field(addr,f_host,alloc_int32(*(int*)&saddr.sin_addr));
alloc_field(addr,f_port,alloc_int(ntohs(saddr.sin_port)));
return alloc_int(ret);
}
/**
sys_remove_dir : string -> void
<doc>Remove a directory. Exception on error</doc>
**/
static value sys_remove_dir( value path ) {
#ifdef EPPC
return alloc_bool(true);
#else
val_check(path,string);
gc_enter_blocking();
if( rmdir(val_string(path)) != 0 )
{
gc_exit_blocking();
return alloc_null();
}
return alloc_bool(true);
#endif
}
static value systray_create_icon( value w, value iconpath, value tooltip )
{
val_check(tooltip,string);
if ( !(val_is_string(iconpath) || val_is_null(iconpath)) )
val_throw(alloc_string(tray_icon_error));
else {
tray_icon *tray = systools_win_create_tray_icon(val_hwnd(w),val_string(iconpath),val_string(tooltip));
if (!tray)
val_throw(alloc_string(tray_icon_error));
return alloc_abstract(k_tray_icon,tray);
}
return val_null;
}
static value dgst_verify( value data, value sign, value key, value alg ){
const mbedtls_md_info_t *md;
int r = -1;
unsigned char hash[32];
val_check(data, string);
val_check(sign, string);
val_check_kind(key, k_pkey);
val_check(alg, string);
md = mbedtls_md_info_from_string(val_string(alg));
if( md == NULL ){
val_throw(alloc_string("Invalid hash algorithm"));
return val_null;
}
if( (r = mbedtls_md( md, (const unsigned char *)val_string(data), val_strlen(data), hash )) != 0 )
return ssl_error(r);
if( (r = mbedtls_pk_verify( val_pkey(key), mbedtls_md_get_type(md), hash, 0, (unsigned char *)val_string(sign), val_strlen(sign) )) != 0 )
return val_false;
return val_true;
}
static value cert_load_path(value path){
int r;
mbedtls_x509_crt *x;
value v;
val_check(path,string);
x = (mbedtls_x509_crt *)alloc(sizeof(mbedtls_x509_crt));
mbedtls_x509_crt_init( x );
if( (r = mbedtls_x509_crt_parse_path(x, val_string(path))) != 0 ){
return ssl_error(r);
}
v = alloc_abstract(k_cert, x);
val_gc(v,free_cert);
return v;
}
/**
module_read : fread:(buf:string -> pos:int -> len:int -> int) -> loader:object -> 'module
<doc>
Read a module using the specified read function and the specified loader.
</doc>
**/
static value module_read( value fread, value loader ) {
value p;
neko_module *m;
val_check_function(fread,3);
val_check(loader,object);
p = alloc_array(2);
val_array_ptr(p)[0] = fread;
val_array_ptr(p)[1] = alloc_empty_string(READ_BUFSIZE);
m = neko_read_module(read_proxy,p,loader);
if( m == NULL )
neko_error();
m->name = alloc_string("");
return alloc_abstract(neko_kind_module,m);
}
/**
float_of_bytes : string -> bigendian:bool -> float
<doc>Returns a float from a 4 bytes IEEE 32-bit representation</doc>
**/
static value float_of_bytes( value s, value be ) {
float f;
val_check(s,string);
val_check(be,bool);
if( val_strlen(s) != 4 )
neko_error();
f = *(float*)val_string(s);
if( neko_is_big_endian() != val_bool(be) ) {
char *c = (char*)&f;
char tmp;
tmp = c[0]; c[0] = c[3]; c[3] = tmp;
tmp = c[1]; c[1] = c[2]; c[2] = tmp;
}
return alloc_float(f);
}
static value win_create_process( value app, value args, value wd, value hide, value wait) {
int r;
const char *_args = 0;
const char *_wd = 0;
val_check(app,string);
val_check(hide,int);
val_check(wait,int);
if (args != val_null) {
val_check(args,string);
_args = val_string(args);
}
if (wd != val_null) {
val_check(wd,string);
_wd = val_string(wd);
}
r = systools_win_create_process
( val_string(app)
, _args
, _wd
, val_int(hide)
, val_int(wait)
);
return alloc_int(r);
}
/**
sys_rename : from:string -> to:string -> void
<doc>Rename the file or directory. Exception on error.</doc>
**/
static value sys_rename( value path, value newname ) {
val_check(path,string);
val_check(newname,string);
#if defined(NEKO_WINDOWS) && !defined(KORE_CONSOLE)
const wchar_t* _path = val_wstring(path);
const wchar_t* _newname = val_wstring(newname);
gc_enter_blocking();
if( MoveFileExW(_path,_newname,MOVEFILE_COPY_ALLOWED|MOVEFILE_WRITE_THROUGH) != 0 )
{
gc_exit_blocking();
return alloc_null();
}
#elif (!defined(KORE_CONSOLE))
gc_enter_blocking();
if( rename(val_string(path),val_string(newname)) != 0 )
{
gc_exit_blocking();
return alloc_null();
}
#endif
gc_exit_blocking();
return alloc_bool(true);
}
/**
file_open : f:string -> r:string -> 'file
<doc>
Call the C function [fopen] with the file path and access rights.
Return the opened file or throw an exception if the file couldn't be open.
</doc>
**/
static value file_open( value name, value r ) {
val_check(name,string);
val_check(r,string);
fio *f = new fio(val_filename(name));
#ifdef NEKO_WINDOWS
const wchar_t *fname = val_wstring(name);
const wchar_t *mode = val_wstring(r);
gc_enter_blocking();
f->io = _wfopen(fname,mode);
#else
const char *fname = val_string(name);
const char *mode = val_string(r);
gc_enter_blocking();
f->io = fopen(fname,mode);
#endif
if( f->io == NULL )
{
file_error("file_open",f,true);
}
gc_exit_blocking();
value result = alloc_abstract(k_file,f);
val_gc(result,free_file);
return result;
}
value cptr_copy( value from, value from_i, value to, value to_i, value l ) {
val_check( from, string );
val_check( to, string );
val_check( from_i, number );
val_check( to_i, number );
val_check( l, number );
int from_idx = val_number(from_i);
int to_idx = val_number(to_i);
int length = val_number(l);
if( val_strlen( from ) < from_idx+length ) {
length = val_strlen(from)-(from_idx);
}
if( val_strlen( to ) < to_idx+length ) {
length = val_strlen(to)-(to_idx);
}
if( length<=0 ) return val_false;
memcpy( &(( char* )val_string(to))[to_idx], &(( char* )val_string(from))[from_idx], length );
return( val_true );
}
static value do_replace( value o, value s, value s2, bool all ) {
val_check_kind(o,k_regexp);
val_check(s,string);
val_check(s2,string);
{
pcredata *d = PCRE(o);
buffer b = alloc_buffer(NULL);
int pos = 0;
int len = val_strlen(s);
const char *str = val_string(s);
const char *str2 = val_string(s2);
int len2 = val_strlen(s2);
while( pcre_exec(d->r,NULL,str,len,pos,0,d->matchs,d->nmatchs * 3) >= 0 ) {
buffer_append_sub(b,str+pos,d->matchs[0] - pos);
buffer_append_sub(b,str2,len2);
pos = d->matchs[1];
if( !all )
break;
}
d->str = alloc_null();
buffer_append_sub(b,str+pos,len-pos);
return buffer_to_string(b);
}
}
/**
request : 'connection -> string -> 'result
<doc>Execute an SQL request. Exception on error</doc>
**/
static value request( value o, value r ) {
MYSQL_RES *res;
val_check_kind(o,k_connection);
val_check(r,string);
if( mysql_real_query(MYSQLDATA(o),val_string(r),val_strlen(r)) != 0 )
error(MYSQLDATA(o),val_string(r));
res = mysql_store_result(MYSQLDATA(o));
if( res == NULL ) {
if( mysql_field_count(MYSQLDATA(o)) == 0 )
return alloc_int( (int)mysql_affected_rows(MYSQLDATA(o)) );
else
error(MYSQLDATA(o),val_string(r));
}
return alloc_result(res);
}
static value cgi_set_config( value v ) {
mconfig c;
value f;
val_check(v,object);
FGET(hits,int);
FGET(use_jit,bool);
FGET(use_stats,bool);
FGET(use_prim_stats,bool);
FGET(use_cache,bool);
FGET(exceptions,int);
FGET(gc_period,int);
FGET(max_post_size,int);
mod_neko_set_config(&c);
return val_null;
}
/**
double_bytes : number -> bigendian:bool -> string
<doc>Returns the 8 bytes representation of the number as an IEEE 64-bit float</doc>
**/
static value double_bytes( value n, value be ) {
double f;
val_check(n,number);
val_check(be,bool);
f = (double)val_number(n);
if( neko_is_big_endian() != val_bool(be) ) {
char *c = (char*)&f;
char tmp;
tmp = c[0]; c[0] = c[7]; c[7] = tmp;
tmp = c[1]; c[1] = c[6]; c[6] = tmp;
tmp = c[2]; c[2] = c[5]; c[5] = tmp;
tmp = c[3]; c[3] = c[4]; c[4] = tmp;
}
return copy_string((char*)&f,8);
}
/**
file_delete : string -> void
<doc>Delete the file. Exception on error.</doc>
**/
static value file_delete( value path ) {
#ifdef EPPC
return alloc_bool(true);
#else
val_check(path,string);
gc_enter_blocking();
if( unlink(val_string(path)) != 0 )
{
gc_exit_blocking();
return alloc_null();
}
gc_exit_blocking();
return alloc_bool(true);
#endif
}
/**
lock_wait : 'lock -> timeout:number? -> bool
<doc>
Waits for a lock to be released and acquire it.
If [timeout] (in seconds) is not null and expires then
the returned value is false
</doc>
**/
static value lock_wait( value lock, value timeout ) {
int has_timeout = !val_is_null(timeout);
val_check_kind(lock,k_lock);
if( has_timeout )
val_check(timeout,number);
# ifdef NEKO_WINDOWS
switch( WaitForSingleObject(val_lock(lock),has_timeout?(DWORD)(val_number(timeout) * 1000.0):INFINITE) ) {
case WAIT_ABANDONED:
case WAIT_OBJECT_0:
return val_true;
case WAIT_TIMEOUT:
return val_false;
default:
neko_error();
}
# else
{
vlock l = val_lock(lock);
pthread_mutex_lock(&l->lock);
while( l->counter == 0 ) {
if( has_timeout ) {
struct timeval tv;
struct timespec t;
double delta = val_number(timeout);
int idelta = (int)delta, idelta2;
delta -= idelta;
delta *= 1.0e9;
gettimeofday(&tv,NULL);
delta += tv.tv_usec * 1000.0;
idelta2 = (int)(delta / 1e9);
delta -= idelta2 * 1e9;
t.tv_sec = tv.tv_sec + idelta + idelta2;
t.tv_nsec = (long)delta;
if( pthread_cond_timedwait(&l->cond,&l->lock,&t) != 0 ) {
pthread_mutex_unlock(&l->lock);
return val_false;
}
} else
pthread_cond_wait(&l->cond,&l->lock);
}
l->counter--;
if( l->counter > 0 )
pthread_cond_signal(&l->cond);
pthread_mutex_unlock(&l->lock);
return val_true;
}
# endif
}
/**
connect : filename:string -> 'db
<doc>Open or create the database stored in the specified file.</doc>
**/
static value connect( value filename ) {
int err;
database *db = (database*)alloc(sizeof(database));
value v;
val_check(filename,string);
db->last = NULL;
if( (err = sqlite3_open(val_string(filename),&db->db)) != SQLITE_OK ) {
buffer b = alloc_buffer("Sqlite error : ");
buffer_append(b,sqlite3_errmsg(db->db));
sqlite3_close(db->db);
val_throw(buffer_to_string(b));
}
v = alloc_abstract(k_db,db);
val_gc(v,free_db);
return v;
}
/**
sys_command : string -> int
<doc>Run the shell command and return exit code</doc>
**/
static value sys_command( value cmd ) {
#if defined(HX_WINRT) || defined(EMSCRIPTEN) || defined(EPPC)
return alloc_int( -1 );
#else
val_check(cmd,string);
if( val_strlen(cmd) == 0 )
return alloc_int(-1);
gc_enter_blocking();
int result = system(val_string(cmd));
gc_exit_blocking();
#if !defined(NEKO_WINDOWS) && !defined(ANDROID)
result = WEXITSTATUS(result) | (WTERMSIG(result) << 8);
#endif
return alloc_int( result );
#endif
}
/**
$asub : array -> p:int -> l:int -> array
<doc>
Return [l] elements starting at position [p] of an array.
An error occurs if out of array bounds.
</doc>
**/
static value builtin_asub( value a, value p, value l ) {
value a2;
int i;
int pp, ll;
val_check(a,array);
val_check(p,int);
val_check(l,int);
pp = val_int(p);
ll = val_int(l);
if( pp < 0 || ll < 0 || pp+ll < 0 || pp+ll > val_array_size(a) )
neko_error();
a2 = alloc_array(ll);
for(i=0;i<ll;i++)
val_array_ptr(a2)[i] = val_array_ptr(a)[pp+i];
return a2;
}
/**
escape : 'connection -> string -> string
<doc>Escape the string for inserting into a SQL request</doc>
**/
static value escape( value o, value s ) {
int len;
value sout;
val_check_kind(o,k_connection);
val_check(s,string);
len = val_strlen(s) * 2;
sout = alloc_empty_string(len);
len = mysql_real_escape_string(CNX(o)->m,val_string(sout),val_string(s),val_strlen(s));
if( len < 0 ) {
buffer b = alloc_buffer("Unsupported charset : ");
buffer_append(b,mysql_character_set_name(CNX(o)->m));
bfailure(b);
}
val_set_length(sout,len);
val_string(sout)[len] = 0;
return sout;
}
