static value Val_context(const char *context) { if (context == NULL) return Val_none; return Val_some(caml_copy_string(context)); }
CAMLprim value caml_sqlite3_errmsg(value v_db) { db_wrap *dbw = Sqlite3_val(v_db); check_db(dbw, "errmsg"); return caml_copy_string(sqlite3_errmsg(dbw->db)); }
CAMLprim value get_real_path( value path ) { #ifdef _WIN32 const char sep = '\\'; size_t len, i, last; WIN32_FIND_DATA data; HANDLE handle; char out[MAX_PATH]; // this will ensure the full class path with proper casing if( GetFullPathName(String_val(path),MAX_PATH,out,NULL) == 0 ) failwith("get_real_path"); len = strlen(out); i = 0; if (len >= 2 && out[1] == ':') { // convert drive letter to uppercase if (out[0] >= 'a' && out[0] <= 'z') out[0] += 'A' - 'a'; if (len >= 3 && out[2] == sep) i = 3; else i = 2; } last = i; while (i < len) { // skip until separator while (i < len && out[i] != sep) i++; // temporarily strip string to last found component out[i] = 0; // get actual file/dir name with proper case if ((handle = FindFirstFile(out, &data)) != INVALID_HANDLE_VALUE) { int klen = strlen(data.cFileName); // a ~ was expanded ! if( klen != i - last ) { int d = klen - (i - last); memmove(out + i + d, out + i, len - i + 1); len += d; i += d; } // replace the component with proper case memcpy(out + last, data.cFileName, klen + 1); FindClose(handle); } // if we're not at the end, restore the path if (i < len) out[i] = sep; // advance i++; last = i; } return caml_copy_string(out); #else return path; #endif }
CAMLextern_C value caml_sfHttpResponse_getBody(value httpResponse) { const std::string& resp = SfHttpResponse_val(httpResponse)->getBody(); return caml_copy_string(resp.c_str()); }
CAMLprim value ocaml_plugin_archive (value unit __attribute__ ((unused))) { char v[] = "dummy"; return(caml_copy_string(v)); }
/* Target.t -> string */ CAMLprim value llvm_target_description(LLVMTargetRef Target) { return caml_copy_string(LLVMGetTargetDescription(Target)); }
CAMLprim value mmdb_ml_version(void) { return caml_copy_string(MMDB_lib_version()); }
value alpm_to_caml_strelem ( void * elem ) { CAMLparam0(); CAMLreturn( caml_copy_string( (char *) elem )); }
void caml_raise_with_string(value tag, char const *msg) { caml_raise_with_arg(tag, caml_copy_string(msg)); }
CAMLprim value iface_name(value ifap) { return caml_copy_string(((struct ifaddrs *)ifap)->ifa_name); }
/* alloc */ value bap_disasm_backend_name_stub(value n) { CAMLparam1(n); CAMLlocal1(s); s = caml_copy_string(bap_disasm_backend_name(Int_val(n))); CAMLreturn(s); }
void lwt_unix_not_available(char const *feature) { caml_raise_with_arg(*caml_named_value("lwt:not-available"), caml_copy_string(feature)); }
CAMLprim value ocaml_get_routing_table(value unit) { CAMLparam1(unit); CAMLlocal3( ret, tmp, entry ); struct nl_sock *fd; struct nl_cache *res, *links; struct rtnl_route *it; uint32 i_ip, netmask = 0, mask_len, gw; int i; struct nl_addr *ip; char device_name[IFNAMSIZ]; struct rtnl_nexthop *to; fd = nl_socket_alloc(); if (!fd) { fprintf(stderr, "error nl_socket_alloc\n"); exit(1); } if(nl_connect(fd, NETLINK_ROUTE) < 0) { fprintf(stderr, "error nl_connect\n"); exit(1); } ret = Val_emptylist; if(rtnl_route_alloc_cache(fd, AF_UNSPEC, 0, &res) < 0) { fprintf(stderr, "error rtnl_route_alloc_cache"); exit(1); } if(rtnl_link_alloc_cache (fd, AF_UNSPEC, &links) < 0) { fprintf(stderr, "error rtnl_link_alloc_cache"); exit(1); } it = (struct rtnl_route *)nl_cache_get_first(res); for(; it != NULL; it = (struct rtnl_route *) nl_cache_get_next((struct nl_object *)it) ) { if(rtnl_route_get_family (it) == AF_INET) { ip = rtnl_route_get_dst(it); i_ip = ntohl(*(int *)nl_addr_get_binary_addr(ip)); mask_len = nl_addr_get_prefixlen(ip); for(i = 0; i < 32; i++) netmask = (netmask << 1) + (i< mask_len?1:0); to = rtnl_route_nexthop_n(it, 0); rtnl_link_i2name(links, rtnl_route_nh_get_ifindex(to), device_name, IFNAMSIZ); if ( rtnl_route_nh_get_gateway (to) != NULL) gw = ntohl(*(int *)nl_addr_get_binary_addr( rtnl_route_nh_get_gateway (to))); else gw = 0; /*printf("src ip:%x mask:%x gw:%x dev:%s\n", i_ip, netmask, */ /*gw, device_name);*/ entry = caml_alloc(7,0); Store_field(entry, 0, Val_int(i_ip & 0xFFFF)); Store_field(entry, 1, Val_int(i_ip >> 16)); Store_field(entry, 2, Val_int(netmask & 0xFFFF)); Store_field(entry, 3, Val_int(netmask >> 16)); Store_field(entry, 4, Val_int(gw & 0xFFFF)); Store_field(entry, 5, Val_int(gw >> 16)); Store_field(entry, 6, caml_copy_string(device_name)); // store in list tmp = caml_alloc(2, 0); Store_field( tmp, 0, entry); // head Store_field( tmp, 1, ret); // tail ret = tmp; } }
/* get library version */ value mlgz_zlibversion(value unit) { return caml_copy_string(zlibVersion()); }
CAMLprim value stub_avahi_string_list_get_text(value l) { CAMLparam1(l); CAMLreturn(caml_copy_string((const char *)avahi_string_list_get_text((AvahiStringList *)l))); }
CAMLprim value caml_spf_strreason(value reason_val) { CAMLparam1(reason_val); CAMLreturn(caml_copy_string(SPF_strreason(Int_val(reason_val)))); }
/* Target.t -> string */ CAMLprim value llvm_target_name(LLVMTargetRef Target) { return caml_copy_string(LLVMGetTargetName(Target)); }
CAMLprim value ocaml_faad_get_error_message(value err) { return caml_copy_string((char*)NeAACDecGetErrorMessage(Int_val(err))); }
CAMLprim value mmdb_ml_lookup_path(value ip, value query_list, value mmdb) { CAMLparam3(ip, query_list, mmdb); CAMLlocal3(iter_count, caml_clean_result, query_r); int total_len = 0, copy_count = 0, gai_error = 0, mmdb_error = 0; char *clean_result; long int int_result; iter_count = query_list; unsigned int len = caml_string_length(ip); char *as_string = caml_strdup(String_val(ip)); if (strlen(as_string) != (size_t)len) { caml_failwith("Could not copy IP address properly"); } MMDB_s *as_mmdb = (MMDB_s*)Data_custom_val(mmdb); MMDB_lookup_result_s *result = caml_stat_alloc(sizeof(*result)); *result = MMDB_lookup_string(as_mmdb, as_string, &gai_error, &mmdb_error); check_error(gai_error, mmdb_error); caml_stat_free(as_string); while (iter_count != Val_emptylist) { total_len++; iter_count = Field(iter_count, 1); } char **query = caml_stat_alloc(sizeof(char *) * (total_len + 1)); while (query_list != Val_emptylist) { query[copy_count] = caml_strdup(String_val(Field(query_list, 0))); copy_count++; query_list = Field(query_list, 1); } query[total_len] = NULL; MMDB_entry_data_s entry_data; int status = MMDB_aget_value(&result->entry, &entry_data, (const char *const *const)query); check_status(status); check_data(entry_data); caml_stat_free(result); for (int i = 0; i < copy_count; caml_stat_free(query[i]), i++); caml_stat_free(query); query_r = caml_alloc(2, 0); as_mmdb = NULL; switch (entry_data.type) { case MMDB_DATA_TYPE_BYTES: clean_result = caml_stat_alloc(entry_data.data_size + 1); memcpy(clean_result, entry_data.bytes, entry_data.data_size); caml_clean_result = caml_copy_string(clean_result); caml_stat_free(clean_result); goto string_finish; case MMDB_DATA_TYPE_UTF8_STRING: clean_result = strndup(entry_data.utf8_string, entry_data.data_size); caml_clean_result = caml_copy_string(clean_result); free(clean_result); goto string_finish; case MMDB_DATA_TYPE_FLOAT: Store_field(query_r, 0, polymorphic_variants.poly_float); Store_field(query_r, 1, caml_copy_double(entry_data.float_value)); goto finish; case MMDB_DATA_TYPE_BOOLEAN: Store_field(query_r, 0, polymorphic_variants.poly_bool); Store_field(query_r, 1, Val_true ? entry_data.boolean : Val_false); goto finish; case MMDB_DATA_TYPE_DOUBLE: Store_field(query_r, 0, polymorphic_variants.poly_float); Store_field(query_r, 1, caml_copy_double(entry_data.double_value)); goto finish; case MMDB_DATA_TYPE_UINT16: Store_field(query_r, 0, polymorphic_variants.poly_int); int_result = Val_long(entry_data.uint16); goto int_finish; case MMDB_DATA_TYPE_UINT32: Store_field(query_r, 0, polymorphic_variants.poly_int); int_result = Val_long(entry_data.uint32); goto int_finish; case MMDB_DATA_TYPE_UINT64: Store_field(query_r, 0, polymorphic_variants.poly_int); int_result = Val_long(entry_data.uint32); goto int_finish; // look at /usr/bin/sed -n 1380,1430p src/maxminddb.c case MMDB_DATA_TYPE_ARRAY: case MMDB_DATA_TYPE_MAP: caml_failwith("Can't return a Map or Array yet"); } string_finish: Store_field(query_r, 0, polymorphic_variants.poly_string); Store_field(query_r, 1, caml_clean_result); CAMLreturn(query_r); int_finish: Store_field(query_r, 1, int_result); CAMLreturn(query_r); finish: CAMLreturn(query_r); }
CAMLprim value getsockopt_stub(value sock, value sockopt) { CAMLparam2 (sock, sockopt); CAMLlocal1 (result); int error = -1; int native_sockopt = Int_val(sockopt); struct wrap *socket = Socket_val(sock); switch (native_sockopt) { case ZMQ_SNDHWM: case ZMQ_RCVHWM: case ZMQ_RATE: case ZMQ_RECOVERY_IVL: case ZMQ_SNDBUF: case ZMQ_RCVBUF: case ZMQ_LINGER: case ZMQ_RECONNECT_IVL: case ZMQ_RECONNECT_IVL_MAX: case ZMQ_BACKLOG: case ZMQ_MULTICAST_HOPS: case ZMQ_RCVTIMEO: case ZMQ_SNDTIMEO: case ZMQ_RCVMORE: case ZMQ_RCVLABEL: case ZMQ_TYPE: { int res; size_t size = sizeof(res); error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size); stub_raise_if (error == -1); result = Val_int(res); } break; case ZMQ_AFFINITY: case ZMQ_MAXMSGSIZE: { int64 res; size_t size = sizeof(res); error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size); stub_raise_if (error == -1); result = caml_copy_int64(res); } break; case ZMQ_EVENTS: { int res; size_t size = sizeof(res); error = zmq_getsockopt(socket->wrapped, native_sockopt, &res, &size); stub_raise_if (error == -1); result = POOL_LIST_CACHE[res]; } break; case ZMQ_IDENTITY: { char buffer[256]; buffer[255] = '\0'; size_t size = sizeof(buffer); error = zmq_getsockopt(socket->wrapped, native_sockopt, buffer, &size); stub_raise_if (error == -1); if (size == 0) { result = EMPTY_STRING; } else { result = caml_copy_string(buffer); } } break; case ZMQ_FD: { #if defined(_WIN32) || defined(_WIN64) SOCKET fd; #else int fd; #endif size_t size = sizeof (fd); error = zmq_getsockopt (socket->wrapped, native_sockopt, (void *) (&fd), &size); stub_raise_if (error == -1); #if defined(_WIN32) || defined(_WIN64) result = win_alloc_socket(fd); #else result = Val_int(fd); #endif } break; default: caml_failwith("Bidings error"); } CAMLreturn (result); }
value get_adverb(char* adverb_name) { CAMLparam0(); CAMLlocal1(ocaml_adverb_name); ocaml_adverb_name = caml_copy_string(adverb_name); CAMLreturn(caml_callback(*ocaml_get_adverb, ocaml_adverb_name)); }
CAMLprim value libssh_ml_version(void) { return caml_copy_string(SSH_STRINGIFY(LIBSSH_VERSION)); }
CAMLprim value caml_extunix_recvmsg(value fd_val) { CAMLparam1(fd_val); CAMLlocal2(data, res); struct msghdr msg; int fd = Int_val(fd_val); int recvfd; ssize_t len; struct iovec iov[1]; char buf[4096]; #if defined(CMSG_SPACE) union { struct cmsghdr cmsg; /* just for alignment */ char control[CMSG_SPACE(sizeof recvfd)]; } control_un; struct cmsghdr *cmsgp; memset(&msg, 0, sizeof msg); msg.msg_control = control_un.control; msg.msg_controllen = CMSG_LEN(sizeof recvfd); #else msg.msg_accrights = (caddr_t)&recvfd; msg.msg_accrightslen = sizeof recvfd; #endif iov[0].iov_base = buf; iov[0].iov_len = sizeof buf; msg.msg_iov = iov; msg.msg_iovlen = 1; caml_enter_blocking_section(); len = recvmsg(fd, &msg, 0); caml_leave_blocking_section(); if (len == -1) uerror("recvmsg", Nothing); res = caml_alloc(2, 0); #if defined(CMSG_SPACE) cmsgp = CMSG_FIRSTHDR(&msg); if (cmsgp == NULL) { Store_field(res, 0, Val_none); } else { CAMLlocal1(some_fd); if (cmsgp->cmsg_len != CMSG_LEN(sizeof recvfd)) unix_error(EINVAL, "recvmsg", caml_copy_string("wrong descriptor size")); if (cmsgp->cmsg_level != SOL_SOCKET || cmsgp->cmsg_type != SCM_RIGHTS) unix_error(EINVAL, "recvmsg", caml_copy_string("invalid protocol")); some_fd = caml_alloc(1, 0); Store_field(some_fd, 0, Val_int(*(int *)CMSG_DATA(cmsgp))); Store_field(res, 0, some_fd); } #else if (msg.msg_accrightslen != sizeof recvfd) { Store_field(res, 0, Val_none); } else { CAMLlocal1(some_fd); some_fd = caml_alloc(1, 0); Store_field(some_fd, 0, Val_int(recvfd)); Store_field(res, 0, some_fd); } #endif data = caml_alloc_string(len); memcpy(String_val(data), buf, len); Store_field(res, 1, data); CAMLreturn (res); }
CAMLprim value ocaml_plugin_archive_digest (value unit __attribute__ ((unused))) { return(caml_copy_string("dummy")); }
value ml_lua_modinfo (value string) { CAMLparam1 (string); CAMLlocal4 (name, version, depends, tuple); int err, i, n; lua_State *L = luaL_newstate(); luaL_openlibs(L); err = luaL_dostring (L, String_val(string)); if (err != 0) { caml_failwith("Lua.modinfo"); } name = caml_alloc_string(0); version = caml_alloc_string(0); depends = caml_alloc_tuple(0); lua_pushnil(L); while (lua_next(L, -2) != 0) { const char *s = lua_tostring(L, -2); // Get name string if (strcasecmp(s, "name") == 0) { const char *s = lua_tostring(L, -1); name = caml_copy_string(s); } // Get depends array else if (strcasecmp(s, "depend") == 0) { lua_pushstring(L, "table"); lua_gettable(L, LUA_GLOBALSINDEX); lua_pushstring(L, "getn"); lua_gettable(L, -2); lua_pushvalue(L, -3); lua_call(L, 1, 1); n = lua_tonumber(L, -1); lua_pop(L, 2); depends = caml_alloc_tuple(n); i = 0; lua_pushnil(L); while (lua_next(L, -2) != 0) { const char *s = lua_tostring(L, -1); Store_field(depends, i, caml_copy_string(s)); i++; lua_pop(L, 1); } } // Get version string else if (strcasecmp(s, "version") == 0) { const char *s = lua_tostring(L, -1); version = caml_copy_string(s); } lua_pop(L, 1); } tuple = caml_alloc_tuple(3); Store_field(tuple, 0, name); Store_field(tuple, 1, version); Store_field(tuple, 2, depends); CAMLreturn (tuple); }
/* Makes OCaml-string from PCRE-version */ CAMLprim value pcre_version_stub(value __unused v_unit) { return caml_copy_string((char *) pcre_version()); }
static inline value Val_string_option(const char *str) { return (str == NULL) ? Val_None : Val_Some(caml_copy_string(str)); }
/* Executes a pattern match with runtime options, a regular expression, a string offset, a string length, a subject string, a number of subgroup offsets, an offset vector and an optional callout function */ CAMLprim value pcre_exec_stub(value v_opt, value v_rex, value v_ofs, value v_subj, value v_subgroups2, value v_ovec, value v_maybe_cof) { const int ofs = Int_val(v_ofs), len = caml_string_length(v_subj); if (ofs > len || ofs < 0) caml_invalid_argument("Pcre.pcre_exec_stub: illegal offset"); { const pcre *code = (pcre *) Field(v_rex, 1); /* Compiled pattern */ const pcre_extra *extra = (pcre_extra *) Field(v_rex, 2); /* Extra info */ const char *ocaml_subj = String_val(v_subj); /* Subject string */ const int opt = Int_val(v_opt); /* Runtime options */ int subgroups2 = Int_val(v_subgroups2); const int subgroups2_1 = subgroups2 - 1; const int subgroups3 = (subgroups2 >> 1) + subgroups2; /* Special case when no callout functions specified */ if (v_maybe_cof == None) { int *ovec = (int *) &Field(v_ovec, 0); /* Performs the match */ const int ret = pcre_exec(code, extra, ocaml_subj, len, ofs, opt, ovec, subgroups3); if (ret < 0) { switch(ret) { case PCRE_ERROR_NOMATCH : caml_raise_constant(*pcre_exc_Not_found); case PCRE_ERROR_PARTIAL : caml_raise_constant(*pcre_exc_Partial); case PCRE_ERROR_MATCHLIMIT : caml_raise_constant(*pcre_exc_MatchLimit); case PCRE_ERROR_BADPARTIAL : caml_raise_constant(*pcre_exc_BadPartial); case PCRE_ERROR_BADUTF8 : caml_raise_constant(*pcre_exc_BadUTF8); case PCRE_ERROR_BADUTF8_OFFSET : caml_raise_constant(*pcre_exc_BadUTF8Offset); default : caml_raise_with_string(*pcre_exc_InternalError, "pcre_exec_stub"); } } else { const int *ovec_src = ovec + subgroups2_1; long int *ovec_dst = (long int *) ovec + subgroups2_1; /* Converts offsets from C-integers to OCaml-Integers This is a bit tricky, because there are 32- and 64-bit platforms around and OCaml chooses the larger possibility for representing integers when available (also in arrays) - not so the PCRE */ while (subgroups2--) { *ovec_dst = Val_int(*ovec_src); --ovec_src; --ovec_dst; } } } /* There are callout functions */ else { value v_cof = Field(v_maybe_cof, 0); value v_substrings; char *subj = caml_stat_alloc(sizeof(char) * len); int *ovec = caml_stat_alloc(sizeof(int) * subgroups3); int ret; struct cod cod = { (value *) NULL, (value *) NULL, (value) NULL }; struct pcre_extra new_extra = #ifdef PCRE_CONFIG_MATCH_LIMIT_RECURSION { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL, 0 }; #else { PCRE_EXTRA_CALLOUT_DATA, NULL, 0, NULL, NULL }; #endif memcpy(subj, ocaml_subj, len); Begin_roots3(v_rex, v_cof, v_substrings); Begin_roots2(v_subj, v_ovec); v_substrings = caml_alloc_small(2, 0); End_roots(); Field(v_substrings, 0) = v_subj; Field(v_substrings, 1) = v_ovec; cod.v_substrings_p = &v_substrings; cod.v_cof_p = &v_cof; new_extra.callout_data = &cod; if (extra == NULL) { ret = pcre_exec(code, &new_extra, subj, len, ofs, opt, ovec, subgroups3); } else { new_extra.flags = PCRE_EXTRA_CALLOUT_DATA | extra->flags; new_extra.study_data = extra->study_data; new_extra.match_limit = extra->match_limit; new_extra.tables = extra->tables; #ifdef PCRE_CONFIG_MATCH_LIMIT_RECURSION new_extra.match_limit_recursion = extra->match_limit_recursion; #endif ret = pcre_exec(code, &new_extra, subj, len, ofs, opt, ovec, subgroups3); } free(subj); End_roots(); if (ret < 0) { free(ovec); switch(ret) { case PCRE_ERROR_NOMATCH : caml_raise_constant(*pcre_exc_Not_found); case PCRE_ERROR_PARTIAL : caml_raise_constant(*pcre_exc_Partial); case PCRE_ERROR_MATCHLIMIT : caml_raise_constant(*pcre_exc_MatchLimit); case PCRE_ERROR_BADPARTIAL : caml_raise_constant(*pcre_exc_BadPartial); case PCRE_ERROR_BADUTF8 : caml_raise_constant(*pcre_exc_BadUTF8); case PCRE_ERROR_BADUTF8_OFFSET : caml_raise_constant(*pcre_exc_BadUTF8Offset); case PCRE_ERROR_CALLOUT : caml_raise(cod.v_exn); default : caml_raise_with_string(*pcre_exc_InternalError, "pcre_exec_stub"); } } else { int *ovec_src = ovec + subgroups2_1; long int *ovec_dst = &Field(v_ovec, 0) + subgroups2_1; while (subgroups2--) { *ovec_dst = Val_int(*ovec_src); --ovec_src; --ovec_dst; } free(ovec); } } } return Val_unit; } /* Byte-code hook for pcre_exec_stub Needed, because there are more than 5 arguments */ CAMLprim value pcre_exec_stub_bc(value *argv, int __unused argn) { return pcre_exec_stub(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } /* Generates a new set of chartables for the current locale (see man page of PCRE */ CAMLprim value pcre_maketables_stub(value __unused v_unit) { /* GC will do a full cycle every 100 table set allocations (one table set consumes 864 bytes -> maximum of 86400 bytes unreclaimed table sets) */ const value v_res = caml_alloc_final(2, pcre_dealloc_tables, 864, 86400); Field(v_res, 1) = (value) pcre_maketables(); return v_res; } /* Wraps around the isspace-function */ CAMLprim value pcre_isspace_stub(value v_c) { return Val_bool(isspace(Int_val(v_c))); } /* Returns number of substring associated with a name */ CAMLprim value pcre_get_stringnumber_stub(value v_rex, value v_name) { const int ret = pcre_get_stringnumber((pcre *) Field(v_rex, 1), String_val(v_name)); if (ret == PCRE_ERROR_NOSUBSTRING) caml_invalid_argument("Named string not found"); return Val_int(ret); } /* Returns array of names of named substrings in a regexp */ CAMLprim value pcre_names_stub(value v_rex) { CAMLparam0(); CAMLlocal1(v_res); int name_count; int entry_size; const char *tbl_ptr; int i; int ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMECOUNT, &name_count); if (ret != 0) caml_raise_with_string(*pcre_exc_InternalError, "pcre_names_stub"); ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMEENTRYSIZE, &entry_size); if (ret != 0) caml_raise_with_string(*pcre_exc_InternalError, "pcre_names_stub"); ret = pcre_fullinfo_stub(v_rex, PCRE_INFO_NAMETABLE, &tbl_ptr); if (ret != 0) caml_raise_with_string(*pcre_exc_InternalError, "pcre_names_stub"); v_res = caml_alloc(name_count, 0); for (i = 0; i < name_count; ++i) { value v_name = caml_copy_string(tbl_ptr + 2); Store_field(v_res, i, v_name); tbl_ptr += entry_size; } CAMLreturn(v_res); }
CAMLprim value sys_dlalloc_string( value v ) { return caml_copy_string((char*)v); }
CAMLprim CAMLweakdef value ocaml_plugin_archive_metadata (value unit __attribute__ ((unused))) { return(caml_copy_string(s)); }