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;
}