CAMLexport void caml_seek_in(struct channel *channel, file_offset dest) { if (dest >= channel->offset - (channel->max - channel->buff) && dest <= channel->offset) { channel->curr = channel->max - (channel->offset - dest); } else { caml_sys_error(NO_ARG); caml_leave_blocking_section(); channel->offset = dest; channel->curr = channel->max = channel->buff; } }
CAMLprim value ocaml_ssl_set_client_SNI_hostname(value socket, value vhostname) { CAMLparam2(socket, vhostname); SSL *ssl = SSL_val(socket); char *hostname = String_val(vhostname); caml_enter_blocking_section(); SSL_set_tlsext_host_name(ssl, hostname); caml_leave_blocking_section(); CAMLreturn(Val_unit); }
CAMLprim value ocaml_ssl_get_issuer(value certificate) { CAMLparam1(certificate); X509 *cert = Cert_val(certificate); caml_enter_blocking_section(); char *issuer = X509_NAME_oneline(X509_get_issuer_name(cert), 0, 0); caml_leave_blocking_section(); if (!issuer) caml_raise_not_found (); CAMLreturn(caml_copy_string(issuer)); }
CAMLprim value ocaml_ssl_get_file_descr(value socket) { CAMLparam1(socket); SSL *ssl = SSL_val(socket); int fd; caml_enter_blocking_section(); fd = SSL_get_fd(ssl); caml_leave_blocking_section(); CAMLreturn(Val_int(fd)); }
CAMLprim value ocaml_ssl_get_subject(value certificate) { CAMLparam1(certificate); X509 *cert = Cert_val(certificate); caml_enter_blocking_section(); char *subject = X509_NAME_oneline(X509_get_subject_name(cert), 0, 0); caml_leave_blocking_section(); if (subject == NULL) caml_raise_not_found (); CAMLreturn(caml_copy_string(subject)); }
CAMLprim value ocaml_ssl_get_verify_result(value socket) { CAMLparam1(socket); int ans; SSL *ssl = SSL_val(socket); caml_enter_blocking_section(); ans = SSL_get_verify_result(ssl); caml_leave_blocking_section(); CAMLreturn(Val_int(ans)); }
/* caml_do_read is exported for Cash */ CAMLexport int caml_do_read(int fd, char *p, unsigned int n) { int retcode; do { caml_enter_blocking_section(); retcode = read(fd, p, n); caml_leave_blocking_section(); } while (retcode == -1 && errno == EINTR); if (retcode == -1) caml_sys_io_error(NO_ARG); return retcode; }
CAMLprim value ocaml_faad_mp4_total_tracks(value m) { CAMLparam1(m); mp4_t *mp = Mp4_val(m); int n; caml_enter_blocking_section(); n = mp4ff_total_tracks(mp->ff); caml_leave_blocking_section(); CAMLreturn(Val_int(n)); }
CAMLprim value unix_fstat(value fd) { int ret; struct stat buf; caml_enter_blocking_section(); ret = fstat(Int_val(fd), &buf); caml_leave_blocking_section(); if (ret == -1) uerror("fstat", Nothing); if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG) unix_error(EOVERFLOW, "fstat", Nothing); return stat_aux(0, &buf); }
CAMLprim value bigstring_write_stub( value v_fd, value v_pos, value v_len, value v_bstr) { CAMLparam1(v_bstr); char *bstr = get_bstr(v_bstr, v_pos); size_t len = Long_val(v_len); ssize_t written; caml_enter_blocking_section(); written = write(Int_val(v_fd), bstr, len); caml_leave_blocking_section(); if (written == -1) uerror("write", Nothing); CAMLreturn(Val_long(written)); }
CAMLprim value lo_write_ba_stub(value v_conn, value v_fd, value v_buf, value v_pos, value v_len) { CAMLparam2(v_conn, v_buf); PGconn *conn = get_conn(v_conn); value v_res; size_t len = Long_val(v_len); char *buf = ((char *) Caml_ba_data_val(v_buf)) + Long_val(v_pos); caml_enter_blocking_section(); v_res = Val_long(lo_write(conn, Int_val(v_fd), buf, len)); caml_leave_blocking_section(); CAMLreturn(v_res); }
apr_array_header_t *svn_support_diff(char *rep_path, char *filename, int revision1, int revision2) { apr_pool_t *subpool = svn_pool_create(pool); svn_stringbuf_t * rep = svn_stringbuf_create(rep_path, subpool); svn_stringbuf_t * file = svn_stringbuf_create(filename, subpool); caml_enter_blocking_section (); apr_array_header_t *res = svn_support_diff_call(rep->data,file->data,revision1,revision2,subpool); caml_leave_blocking_section (); return res; }
CAMLprim value ocaml_ssl_ctx_load_verify_locations(value context, value ca_file, value ca_path) { CAMLparam3(context, ca_file, ca_path); SSL_CTX *ctx = Ctx_val(context); char *CAfile = String_val(ca_file); char *CApath = String_val(ca_path); if(*CAfile == 0) CAfile = NULL; if(*CApath == 0) CApath = NULL; caml_enter_blocking_section(); if(SSL_CTX_load_verify_locations(ctx, CAfile, CApath) != 1) { caml_leave_blocking_section(); caml_invalid_argument("cafile or capath"); } caml_leave_blocking_section(); CAMLreturn(Val_unit); }
CAMLprim value ocaml_ssl_write_certificate(value vfilename, value certificate) { CAMLparam2(vfilename, certificate); char *filename = String_val(vfilename); X509 *cert = Cert_val(certificate); FILE *fh = NULL; if((fh = fopen(filename, "w")) == NULL) caml_raise_constant(*caml_named_value("ssl_exn_certificate_error")); caml_enter_blocking_section(); if(PEM_write_X509(fh, cert) == 0) { fclose(fh); caml_leave_blocking_section(); caml_raise_constant(*caml_named_value("ssl_exn_certificate_error")); } fclose(fh); caml_leave_blocking_section(); CAMLreturn(Val_unit); }
CAMLprim value ocaml_ssl_get_current_cipher(value socket) { CAMLparam1(socket); SSL *ssl = SSL_val(socket); caml_enter_blocking_section(); SSL_CIPHER *cipher = (SSL_CIPHER*)SSL_get_current_cipher(ssl); caml_leave_blocking_section(); if (!cipher) caml_raise_constant(*caml_named_value("ssl_exn_cipher_error")); CAMLreturn((value)cipher); }
CAMLprim value unix_unlink(value path) { CAMLparam1(path); char * p; int ret; p = caml_strdup(String_val(path)); caml_enter_blocking_section(); ret = unlink(p); caml_leave_blocking_section(); caml_stat_free(p); if (ret == -1) uerror("unlink", path); CAMLreturn(Val_unit); }
CAMLprim value unix_chmod(value path, value perm) { CAMLparam2(path, perm); char * p; int ret; p = caml_strdup(String_val(path)); caml_enter_blocking_section(); ret = chmod(p, Int_val(perm)); caml_leave_blocking_section(); caml_stat_free(p); if (ret == -1) uerror("chmod", path); CAMLreturn(Val_unit); }
CAMLprim value caml_sys_remove(value name) { CAMLparam1(name); char * p; int ret; p = caml_strdup(String_val(name)); caml_enter_blocking_section(); ret = unlink(p); caml_leave_blocking_section(); caml_stat_free(p); if (ret != 0) caml_sys_error(name); CAMLreturn(Val_unit); }
CAMLprim value unix_chown(value path, value uid, value gid) { CAMLparam1(path); char * p; int ret; p = caml_strdup(String_val(path)); caml_enter_blocking_section(); ret = chown(p, Int_val(uid), Int_val(gid)); caml_leave_blocking_section(); caml_stat_free(p); if (ret == -1) uerror("chown", path); CAMLreturn(Val_unit); }
CAMLprim value unix_lseek_64(value fd, value ofs, value cmd) { file_offset ret; /* [ofs] is an Int64, which is stored as a custom block; we must therefore extract its contents before dropping the runtime lock, or it might be moved. */ file_offset ofs_c = File_offset_val(ofs); caml_enter_blocking_section(); ret = lseek(Int_val(fd), ofs_c, seek_command_table[Int_val(cmd)]); caml_leave_blocking_section(); if (ret == -1) uerror("lseek", Nothing); return Val_file_offset(ret); }
CAMLprim value caml_sys_chdir(value dirname) { CAMLparam1(dirname); char * p; int ret; p = caml_strdup(String_val(dirname)); caml_enter_blocking_section(); ret = chdir(p); caml_leave_blocking_section(); caml_stat_free(p); if (ret != 0) caml_sys_error(dirname); CAMLreturn(Val_unit); }
// Same as Faad.decode (Faad.Mp4.read_sample) but more efficient. Share code? CAMLprim value ocaml_faad_mp4_decode(value m, value track, value sample, value dh) { CAMLparam4(m, track, sample, dh); CAMLlocal1(outbuf); mp4_t *mp = Mp4_val(m); int t = Int_val(track); int s = Int_val(sample); NeAACDecHandle dec = Dec_val(dh); NeAACDecFrameInfo frameInfo; unsigned char *inbuf = NULL; unsigned int inbuflen = 0; float *data; int c, i, ret; caml_enter_blocking_section(); ret = mp4ff_read_sample(mp->ff, t, s, &inbuf, &inbuflen); caml_leave_blocking_section(); check_err(ret); caml_enter_blocking_section(); data = NeAACDecDecode(dec, &frameInfo, inbuf, inbuflen); caml_leave_blocking_section(); free(inbuf); if (!data) caml_raise_constant(*caml_named_value("ocaml_faad_exn_failed")); if (frameInfo.error != 0) caml_raise_with_arg(*caml_named_value("ocaml_faad_exn_error"), Val_int(frameInfo.error)); outbuf = caml_alloc_tuple(frameInfo.channels); for(c = 0; c < frameInfo.channels; c++) Store_field(outbuf, c, caml_alloc(frameInfo.samples / frameInfo.channels * Double_wosize, Double_array_tag)); for(i = 0; i < frameInfo.samples; i++) Store_double_field(Field(outbuf, i % frameInfo.channels), i / frameInfo.channels, data[i]); CAMLreturn(outbuf); }
CAMLprim value ocaml_faad_mp4_num_samples(value m, value track) { CAMLparam2(m, track); mp4_t *mp = Mp4_val(m); int t = Int_val(track); int ans; caml_enter_blocking_section(); ans = mp4ff_num_samples(mp->ff, t); caml_leave_blocking_section(); CAMLreturn(Val_int(ans)); }
CAMLprim value netsys_poll_event_sources(value pav, value tmov) { #ifdef HAVE_POLL_AGGREG struct poll_aggreg *pa; int code; int tmo; int k; int e; #ifdef USABLE_EPOLL struct epoll_event ee[EPOLL_NUM]; #endif CAMLparam2(pav, tmov); CAMLlocal3(r, r_item, r_cons); tmo = Int_val(tmov); pa = *(Poll_aggreg_val(pav)); #ifdef USABLE_EPOLL caml_enter_blocking_section(); code = epoll_wait(pa->fd, ee, EPOLL_NUM, tmo); e = errno; caml_leave_blocking_section(); if (code == -1) unix_error(e, "epoll_wait", Nothing); r = Val_int(0); for (k=0; k<code; k++) { if (ee[k].data.u64 == 1) { /* This is the reserved cancel_fd */ uint64_t buf; int p; p = read(pa->cancel_fd, (char *) &buf, 8); } else { r_item = caml_alloc(3,0); Store_field(r_item, 0, Val_long(ee[k].data.u64 >> 1)); Store_field(r_item, 1, Val_long(0)); /* i.e. mask = 0 */ Store_field(r_item, 2, Val_int(translate_to_poll_events(ee[k].events))); r_cons = caml_alloc(2,0); Store_field(r_cons, 0, r_item); Store_field(r_cons, 1, r); r = r_cons; } }; #endif CAMLreturn(r); #else invalid_argument("Netsys_posix.pull_event_sources not available"); #endif }
static int dispatch_suspend(void *arg) { value * __suspend_closure; int domid = (int) arg; int ret; __suspend_closure = caml_named_value("suspend_callback"); if (!__suspend_closure) return 0; caml_leave_blocking_section(); ret = Int_val(caml_callback(*__suspend_closure, Val_int(domid))); caml_enter_blocking_section(); return ret; }
CAMLprim value lwt_glib_iter(value may_block) { GMainContext *gc; gint max_priority, timeout; GPollFD *pollfds = NULL; gint pollfds_size = 0; gint nfds; gint i; /* Get the main context. */ gc = g_main_context_default(); /* Try to acquire it. */ if (!g_main_context_acquire(gc)) caml_failwith("Lwt_glib.iter"); /* Dispatch pending events. */ g_main_context_dispatch(gc); /* Prepare the context for polling. */ g_main_context_prepare(gc, &max_priority); /* Get all file descriptors to poll. */ while (pollfds_size < (nfds = g_main_context_query(gc, max_priority, &timeout, pollfds, pollfds_size))) { free(pollfds); pollfds_size = nfds; pollfds = lwt_unix_malloc(pollfds_size * sizeof (GPollFD)); } /* Clear all revents fields. */ for (i = 0; i < nfds; i++) pollfds[i].revents = 0; /* Set the timeout to 0 if we do not want to block. */ if (!Bool_val(may_block)) timeout = 0; /* Do the blocking call. */ caml_enter_blocking_section(); g_main_context_get_poll_func(gc)(pollfds, nfds, timeout); caml_leave_blocking_section(); /* Let glib parse the result. */ g_main_context_check(gc, max_priority, pollfds, nfds); /* Release the context. */ g_main_context_release(gc); free(pollfds); return Val_unit; }
CAMLprim value unix_chroot(value path) { CAMLparam1(path); char * p; int ret; caml_unix_check_path(path, "chroot"); p = caml_strdup(String_val(path)); caml_enter_blocking_section(); ret = chroot(p); caml_leave_blocking_section(); caml_stat_free(p); if (ret == -1) uerror("chroot", path); CAMLreturn(Val_unit); }
/* XXX: WARNING: this function leaks memory if v_ident is not None! No way around that if syslog is called in a multi-threaded environment! Therefore it shouldn't be called too often. What for, anyway? */ CAMLprim value openlog_stub(value v_ident, value v_option, value v_facility) { char *ident = NULL; /* default to argv[0], as per syslog(3) */ if (v_ident != Val_none) { int len = caml_string_length(Some_val(v_ident)) + 1; ident = caml_stat_alloc(len); memcpy(ident, String_val(Some_val(v_ident)), len); } caml_enter_blocking_section(); openlog(ident, Int_val(v_option), Int_val(v_facility)); /* openlog doesn't inter ident (if specified), so freeing it here would create an invalid program. */ caml_leave_blocking_section(); return Val_unit; }
CAMLprim value unix_posix_openpt(value flags) { CAMLparam1(flags); int fd, cv_flags; cv_flags = caml_convert_flag_list(flags, posix_openpt_flag_table); caml_enter_blocking_section(); fd = posix_openpt(cv_flags); caml_leave_blocking_section(); if (fd == -1) uerror("posix_openpt", Nothing); CAMLreturn (Val_int(fd)); }
CAMLprim value unix_unlockpt(value mlfd) { CAMLparam1(mlfd); int fd, err; fd = Int_val(mlfd); caml_enter_blocking_section(); err = unlockpt(fd); caml_leave_blocking_section(); if (err == -1) uerror("unlockpt", Nothing); CAMLreturn (Val_int(0)); }