static value Val_level(xentoollog_level c_level)
{
switch (c_level) {
case XTL_NONE: /* Not a real value */
caml_raise_sys_error(caml_copy_string("Val_level XTL_NONE"));
break;
case XTL_DEBUG:
return Val_int(0);
case XTL_VERBOSE:
return Val_int(1);
case XTL_DETAIL:
return Val_int(2);
case XTL_PROGRESS:
return Val_int(3);
case XTL_INFO:
return Val_int(4);
case XTL_NOTICE:
return Val_int(5);
case XTL_WARN:
return Val_int(6);
case XTL_ERROR:
return Val_int(7);
case XTL_CRITICAL:
return Val_int(8);
case XTL_NUM_LEVELS: /* Not a real value! */
caml_raise_sys_error(
caml_copy_string("Val_level XTL_NUM_LEVELS"));
#if 0 /* Let the compiler catch this */
default:
caml_raise_sys_error(caml_copy_string("Val_level Unknown"));
break;
#endif
}
abort();
}
static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
const char *context,
const char *doing_what /* no \r,\n */,
int percent, unsigned long done, unsigned long total)
{
caml_leave_blocking_section();
CAMLparam0();
CAMLlocalN(args, 5);
struct caml_xtl *xtl = (struct caml_xtl*)logger;
value *func = caml_named_value(xtl->progress_cb) ;
if (func == NULL)
caml_raise_sys_error(caml_copy_string("Unable to find callback"));
/* progress : string option -> string -> int -> int64 -> int64 -> unit; */
args[0] = Val_context(context);
args[1] = caml_copy_string(doing_what);
args[2] = Val_int(percent);
args[3] = caml_copy_int64(done);
args[4] = caml_copy_int64(total);
caml_callbackN(*func, 5, args);
CAMLdone;
caml_enter_blocking_section();
}
static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
xentoollog_level level,
int errnoval,
const char *context,
const char *format,
va_list al)
{
caml_leave_blocking_section();
CAMLparam0();
CAMLlocalN(args, 4);
struct caml_xtl *xtl = (struct caml_xtl*)logger;
value *func = caml_named_value(xtl->vmessage_cb) ;
char *msg;
if (func == NULL)
caml_raise_sys_error(caml_copy_string("Unable to find callback"));
if (vasprintf(&msg, format, al) < 0)
caml_raise_out_of_memory();
/* vmessage : level -> int option -> string option -> string -> unit; */
args[0] = Val_level(level);
args[1] = Val_errno(errnoval);
args[2] = Val_context(context);
args[3] = caml_copy_string(msg);
free(msg);
caml_callbackN(*func, 4, args);
CAMLdone;
caml_enter_blocking_section();
}
static void caml_ba_sys_error(void)
{
char buffer[512];
DWORD errnum;
errnum = GetLastError();
if (!FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
NULL,
errnum,
0,
buffer,
sizeof(buffer),
NULL))
sprintf(buffer, "Unknown error %ld\n", errnum);
caml_raise_sys_error(caml_copy_string(buffer));
}
CAMLexport void caml_sys_error(value arg)
{
CAMLparam1 (arg);
char * err;
CAMLlocal1 (str);
err = "unknown error";
if (arg == NO_ARG) {
str = caml_copy_string(err);
} else {
int err_len = strlen(err);
int arg_len = caml_string_length(arg);
str = caml_alloc_string(arg_len + 2 + err_len);
memmove(&Byte(str, 0), String_val(arg), arg_len);
memmove(&Byte(str, arg_len), ": ", 2);
memmove(&Byte(str, arg_len + 2), err, err_len);
}
caml_raise_sys_error(str);
CAMLnoreturn;
}
