value hh_read_file(value filename) {
CAMLparam1(filename);
CAMLlocal1(result);
int fd;
struct stat sb;
char* memblock;
fd = open(String_val(filename), O_RDONLY);
if(fd == -1) {
result = caml_alloc_string(0);
}
else if(fstat(fd, &sb) == -1) {
result = caml_alloc_string(0);
close(fd);
}
else if((memblock =
(char*)mmap(NULL, sb.st_size, PROT_READ, MAP_PRIVATE, fd, 0))
== MAP_FAILED) {
result = caml_alloc_string(0);
close(fd);
}
else {
result = caml_alloc_string(sb.st_size);
memcpy(String_val(result), memblock, sb.st_size);
munmap(memblock, sb.st_size);
close(fd);
}
CAMLreturn(result);
}
/* Copy out all the pbufs in a chain into a string, and ack/free pbuf.
* @return 0: nothing, -1: closed connection, +n: bytes read
*/
CAMLprim value
caml_tcp_read(value v_tw)
{
CAMLparam1(v_tw);
CAMLlocal1(v_str);
/* Not using tcp_wrap_of_value as we need to clear out the remaining
RX queue before raising the Connection_closed exception. Check that
tw->pcb is set for the rest of the function before using it. */
tcp_wrap *tw = Tcp_wrap_val(v_tw);
struct pbuf_list *pl = tw->desc->rx;
unsigned int tot_len;
char *s;
LWIP_STUB_DPRINTF("caml_tcp_rx_read");
if (!pl) {
v_str = caml_alloc_string(0);
CAMLreturn(v_str);
}
tot_len = pbuf_list_length(pl);
v_str = caml_alloc_string(tot_len);
s = String_val(v_str);
do {
pbuf_copy_partial(pl->p, s, pl->p->tot_len, 0);
s += pl->p->tot_len;
} while ((pl = pl->next));
if (tw->pcb)
tcp_recved(tw->pcb, tot_len);
pbuf_list_free(tw->desc->rx);
tw->desc->rx = NULL;
CAMLreturn(v_str);
}
CAMLprim value caml_mdb_cursor_get(value curs,value key,value data,value op){
CAMLparam4(curs,key,data,op);
CAMLlocal3(result,mlkey,mldata);
MDB_val key_,data_;
key_.mv_data=String_val(key);
key_.mv_size=caml_string_length(key);
data_.mv_data=String_val(data);
data_.mv_size=caml_string_length(data);
int ret;
if((ret=mdb_cursor_get( (MDB_cursor*)curs, &key_, &data_, Int_val(op) ))){
if(ret==MDB_NOTFOUND) {
static value *exn=NULL;
if(exn==NULL) exn=caml_named_value("lmdb_not_found");
caml_raise_constant(*exn);
} else
caml_failwith("error in mdb_cursor_get");
}
mlkey=caml_alloc_string(key_.mv_size);
memcpy(String_val(mlkey),key_.mv_data,key_.mv_size);
mldata=caml_alloc_string(data_.mv_size);
memcpy(String_val(mldata),data_.mv_data,data_.mv_size);
result=caml_alloc(2,0);
Store_field(result,0,mlkey);
Store_field(result,1,mldata);
CAMLreturn(result);
}
CAMLprim value
stub_pcap_next (value p_p)
{
CAMLparam1 (p_p);
CAMLlocal2 (ret, ml_data);
pcap_t *p;
const u_char *packet;
struct pcap_pkthdr header;
p = (pcap_t *) p_p;
packet = pcap_next(p, &header);
if (packet == NULL) {
raise_error ("No next packet received");
}
ret = caml_alloc (3, 0);
Store_field (ret, 0, Val_int (header.len));
Store_field (ret, 1, Val_int (header.caplen));
ml_data = caml_alloc_string (header.caplen);
memcpy (String_val(ml_data), packet, header.caplen);
Store_field (ret, 2, ml_data);
CAMLreturn (ret);
}
CAMLprim value get_ptr_string_stub(char *sptr, char *eptr)
{
unsigned long len = eptr - sptr;
value v_str = caml_alloc_string((mlsize_t) len);
memcpy(String_val(v_str), sptr, (size_t) len);
return v_str;
}
CAMLprim value pcre_firsttable_stub(value v_rex)
{
const unsigned char *ftable;
int ret =
pcre_fullinfo_stub(v_rex, PCRE_INFO_FIRSTTABLE, (void *) &ftable);
if (ret != 0) raise_internal_error("pcre_firsttable_stub");
if (ftable == NULL) return None;
else {
value v_res, v_res_str;
char *ptr;
int i;
Begin_roots1(v_rex);
v_res_str = caml_alloc_string(32);
End_roots();
ptr = String_val(v_res_str);
for (i = 0; i <= 31; ++i) { *ptr = *ftable; ++ptr; ++ftable; }
Begin_roots1(v_res_str);
/* Allocates [Some string] from firsttable */
v_res = caml_alloc_small(1, 0);
End_roots();
Field(v_res, 0) = v_res_str;
return v_res;
}
}
/* Contrary to caml_md5_chan, this function releases the runtime lock.
[fd] must be a file descriptor open for reading and not be
nonblocking, otherwise the function might fail non-deterministically.
*/
CAMLprim value caml_md5_fd(value fd)
{
CAMLparam1 (fd);
value res;
struct MD5Context ctx;
caml_enter_blocking_section();
{
intnat bytes_read;
char buffer[4096];
caml_MD5Init(&ctx);
while (1){
bytes_read = read (Int_val(fd), buffer, sizeof(buffer));
if (bytes_read < 0) {
if (errno == EINTR) continue;
caml_leave_blocking_section();
uerror("caml_md5_fd", Nothing);
}
if (bytes_read == 0) break;
caml_MD5Update (&ctx, (unsigned char *) buffer, bytes_read);
}
}
caml_leave_blocking_section();
res = caml_alloc_string(16);
caml_MD5Final(&Byte_u(res, 0), &ctx);
CAMLreturn (res);
}
CAMLprim value caml_bjack_read(value device, value len)
{
CAMLparam2(device,len);
CAMLlocal1(ans);
int n = Int_val(len) ;
char* buf = malloc(n) ;
jack_driver_t* drv = Bjack_drv_val(device);
long ret;
if (drv->num_input_channels > 0)
{
caml_enter_blocking_section();
ret = JACK_Read(drv,(unsigned char *)buf,n);
caml_leave_blocking_section();
}
else
{
caml_raise_constant(*caml_named_value("bio2jack_exn_too_many_input_channels"));
}
if (ret < 0) caml_failwith("jack_read");
ans = caml_alloc_string(ret);
memcpy(String_val(ans),buf,ret);
free(buf);
CAMLreturn(ans);
}
CAMLprim value recv_stub(value socket, value rcv_option) {
CAMLparam2 (socket, rcv_option);
CAMLlocal1 (message);
void *sock = Socket_val(socket)->wrapped;
zmq_msg_t request;
int result = zmq_msg_init (&request);
stub_raise_if (result == -1);
caml_release_runtime_system();
result = zmq_recvmsg(sock, &request, Int_val(rcv_option));
caml_acquire_runtime_system();
stub_raise_if (result == -1);
size_t size = zmq_msg_size (&request);
if (size == 0) {
message = EMPTY_STRING;
} else {
message = caml_alloc_string(size);
memcpy (String_val(message), zmq_msg_data (&request), size);
}
result = zmq_msg_close(&request);
stub_raise_if (result == -1);
CAMLreturn (message);
}
value get_section_data_internal( bhp _p )
{
CAMLparam0();
CAMLlocal4( data, v, str, tupl );
bh* p = (bh*) _p;
struct bfd* abfd = p->bfdp;
asection *sect;
bfd_size_type datasize = 0;
data = Val_emptylist;
if ( p->is_from_file ) {
for ( sect = abfd->sections; sect != NULL; sect = sect->next ) {
datasize = bfd_get_section_size( sect );
str = caml_alloc_string( datasize );
bfd_get_section_contents( abfd, sect,
(bfd_byte*)String_val(str),
0, datasize );
tupl = caml_alloc_tuple( 3 );
Store_field( tupl, 0, str );
Store_field( tupl, 1, caml_copy_int64( sect->vma ) );
Store_field( tupl, 2, caml_copy_int64( sect->vma + datasize ) );
v = caml_alloc_small( 2, 0 );
Field( v, 0 ) = tupl;
Field( v, 1 ) = data;
data = v;
}
}
CAMLreturn( data );
}
/**
* Beware! The getsect* functions do NOT play well with ASLR, so we cannot just
* copy the data out of the memory address at sect->addr. We could link this
* with -Wl,-no_pie, but it is easier to just open the binary and read it from
* disk.
*/
CAMLprim value get_embedded_flowlib_data(value filename) {
CAMLparam1(filename);
CAMLlocal1(result);
const struct section_64 *sect = getsectbyname("__text", "flowlib");
if (sect == NULL) {
goto fail_early;
}
int fd = open(String_val(filename), O_RDONLY);
if (fd < 0) {
goto fail_early;
}
lseek(fd, sect->offset, SEEK_SET);
result = caml_alloc_string(sect->size);
if (read(fd, String_val(result), sect->size) != sect->size) {
goto fail_after_open;
}
close(fd);
CAMLreturn(SOME(result));
fail_after_open:
close(fd);
fail_early:
CAMLreturn(NONE);
}
CAMLprim value
get_hwaddr(value devname) {
CAMLparam1(devname);
CAMLlocal1(v_mac);
struct ifaddrs *ifap, *p;
char *mac_addr[6];
int found = 0;
char name[IFNAMSIZ];
snprintf(name, sizeof name, "%s", String_val(devname));
if (getifaddrs(&ifap) != 0) {
err(1, "get_mac_addr");
}
for(p = ifap; p != NULL; p = p->ifa_next) {
if((strcmp(p->ifa_name, name) == 0) &&
(p->ifa_addr != NULL)){
char *tmp = LLADDR((struct sockaddr_dl *)(p)->ifa_addr);
memcpy(mac_addr, tmp, 6);
found = 1;
break;
}
}
freeifaddrs(ifap);
if (!found)
err(1, "get_mac_addr");
v_mac = caml_alloc_string(6);
memcpy(String_val(v_mac), mac_addr, 6);
CAMLreturn (v_mac);
}
static inline value unescape_bytea_9x(const char *str)
{
value v_res;
char *res;
size_t n_hex_pairs = 0;
const char *end = str;
/* Length calculation and encoding verification */
while (*end != '\0') {
if (isspace(*end)) end++;
else if (is_hex_digit(*end)) {
end++;
if (is_hex_digit(*end)) { end++; n_hex_pairs++; }
else return raise_invalid_hex_encoding();
}
else return raise_invalid_hex_encoding();
}
/* Assumption: string has not changed since length calculation above! */
v_res = caml_alloc_string(n_hex_pairs);
res = String_val(v_res);
while (str < end) {
if (isspace(*str)) str++;
else {
*res = (char) ((unhexdigit(*str) << 4) | unhexdigit(str[1]));
str += 2;
res++;
}
}
return v_res;
}
CAMLprim value caml_create_string(value len)
{
mlsize_t size = Long_val(len);
if (size > Bsize_wsize (Max_wosize) - 1){
caml_invalid_argument("String.create");
}
return caml_alloc_string(size);
}
CAMLprim value PQocaml_init(value __unused v_unit)
{
v_empty_string = caml_alloc_string(0);
caml_register_generational_global_root(&v_empty_string);
v_exc_Oid = caml_named_value("Postgresql.Oid");
v_null_param = caml_named_value("Postgresql.null");
return Val_unit;
}
value
Val_sfIpAddress(sfIpAddress address)
{
CAMLparam0();
CAMLlocal1(addr);
addr = caml_alloc_string(16);
memcpy(String_val(addr), address.address, 16);
CAMLreturn(addr);
}
/**
* Export the constants provided by Facebook's build system to ocaml-land, since
* their FFI only allows you to call functions, not reference variables. Doing
* it this way makes sense for Facebook internally since our build system has
* machinery for providing these two constants automatically (and no machinery
* for doing codegen in a consistent way to build an ocaml file with them) but
* is very roundabout for external users who have to have CMake codegen these
* constants anyways. Sorry about that.
*/
value hh_get_build_revision(void) {
CAMLparam0();
CAMLlocal1(result);
size_t len = strlen(BuildInfo_kRevision);
result = caml_alloc_string(len);
memcpy(String_val(result), BuildInfo_kRevision, len);
CAMLreturn(result);
}
CAMLprim value stub_sha256_finalize(value ctx)
{
CAMLparam1(ctx);
CAMLlocal1(result);
result = caml_alloc_string(32);
sha256_finalize(GET_CTX_STRUCT(ctx), String_val(result));
CAMLreturn(result);
}
value hh_get_compiler_id(void) {
CAMLparam0();
const char* const buf = build_id;
const ssize_t len = strlen(buf);
value result;
result = caml_alloc_string(len);
memcpy(String_val(result), buf, len);
CAMLreturn(result);
}
CAMLexport value caml_copy_string(char const *s)
{
int len;
value res;
len = strlen(s);
res = caml_alloc_string(len);
memmove(String_val(res), s, len);
return res;
}
static value copy_wstring(LPCWSTR s)
{
int len;
value res;
len = 2 * wcslen(s) + 2; /* NULL character included */
res = caml_alloc_string(len);
memmove(String_val(res), s, len);
return res;
}
CAMLprim value stub_sha1_finalize(value ctx)
{
CAMLparam1(ctx);
CAMLlocal1(result);
result = caml_alloc_string(20);
sha1_finalize(GET_CTX_STRUCT(ctx), (sha1_digest *) result);
CAMLreturn(result);
}
value my_alloc_sockaddr(struct sockaddr_storage *ss)
{
value res, a;
struct sockaddr_un *sun;
struct sockaddr_in *sin;
struct sockaddr_in6 *sin6;
switch(ss->ss_family) {
case AF_UNIX:
sun = (struct sockaddr_un *) ss;
a = caml_copy_string(sun->sun_path);
Begin_root (a);
res = caml_alloc_small(1, 0);
Field(res,0) = a;
End_roots();
break;
case AF_INET:
sin = (struct sockaddr_in *) ss;
a = caml_alloc_string(4);
memcpy(String_val(a), &sin->sin_addr, 4);
Begin_root (a);
res = caml_alloc_small(2, 1);
Field(res, 0) = a;
Field(res, 1) = Val_int(ntohs(sin->sin_port));
End_roots();
break;
case AF_INET6:
sin6 = (struct sockaddr_in6 *) ss;
a = caml_alloc_string(16);
memcpy(String_val(a), &sin6->sin6_addr, 16);
Begin_root (a);
res = caml_alloc_small(2, 1);
Field(res, 0) = a;
Field(res, 1) = Val_int(ntohs(sin6->sin6_port));
End_roots();
break;
default:
unix_error(EAFNOSUPPORT, "", Nothing);
}
return res;
}
CAMLprim value stub_sha1_file(value name)
{
CAMLparam1(name);
CAMLlocal1(result);
result = caml_alloc_string(20);
if (sha1_file(String_val(name), String_val(result)))
caml_failwith("file error");
CAMLreturn(result);
}
static
const char* get_pair(const char *kbuf, size_t ksiz, const char *vbuf, size_t vsiz, size_t *sp, void *opq)
{
CAMLparam0();
CAMLlocal3(key,val,pair);
key = caml_alloc_string(ksiz);
memcpy(String_val(key ), kbuf, ksiz);
val = caml_alloc_string(vsiz);
memcpy(String_val(val), vbuf, vsiz);
pair = caml_alloc(2,0); // (tuple)
Store_field(pair, 0, key);
Store_field(pair, 1, val);
value *block = (value*) opq;
*block = pair;
return KCVISNOP;
}
CAMLprim value brlapiml_recvRaw(value handle, value unit)
{
CAMLparam2(handle, unit);
unsigned char packet[BRLAPI_MAXPACKETSIZE];
int i, size;
CAMLlocal1(str);
brlapiCheckErrorWithCode(recvRaw, &size, packet, sizeof(packet));
str = caml_alloc_string(size);
for (i=0; i<size; i++) Byte(str, i) = packet[i];
CAMLreturn(str);
}
CAMLprim value hh_shared_load(void) {
CAMLparam0();
CAMLlocal1(result);
size_t size = global_storage[0];
assert(size != 0);
result = caml_alloc_string(size);
memcpy(&Field(result, 0), &global_storage[1], size);
CAMLreturn(result);
}
value
supermin_binary_init (value unitv)
{
CAMLparam1 (unitv);
CAMLlocal1 (sv);
sv = caml_alloc_string (_binary_init_len);
memcpy (String_val (sv), _binary_init, _binary_init_len);
CAMLreturn (sv);
}
CAMLprim value
caml_gnttab_read(value v_gw, value v_off, value v_size)
{
CAMLparam3(v_gw, v_off, v_size);
CAMLlocal1(v_ret);
gnttab_wrap *gw = Gnttab_wrap_val(v_gw);
BUG_ON(gw->page == NULL);
v_ret = caml_alloc_string(Int_val(v_size));
memcpy(String_val(v_ret), gw->page + Int_val(v_off), Int_val(v_size));
CAMLreturn(v_ret);
}
CAMLprim value hh_get(value key) {
CAMLparam1(key);
CAMLlocal1(result);
unsigned int slot = find_slot(key);
assert(hashtbl[slot].hash == get_hash(key));
size_t size = *(size_t*)(hashtbl[slot].addr - sizeof(size_t));
result = caml_alloc_string(size);
memcpy(String_val(result), hashtbl[slot].addr, size);
CAMLreturn(result);
}
