Repositories / agent-snapshot.git
src/ocaml/ptrace_stubs.c

Clone (read-only): git clone http://git.guha-anderson.com/git/agent-snapshot.git
4593 bytes · 9a149a03b673
#include <caml/alloc.h>
#include <caml/fail.h>
#include <caml/memory.h>
#include <caml/unixsupport.h>
#include <caml/mlvalues.h>

#include <errno.h>
#include <signal.h>
#include <stdint.h>
#include <string.h>
#include <sys/ptrace.h>
#include <sys/syscall.h>
#include <sys/types.h>
#include <sys/user.h>
#include <sys/wait.h>
#include <unistd.h>

static void raise_unix_error(const char *call) {
  uerror(call, Nothing);
}

CAMLprim value as_fork(value unit) {
  CAMLparam1(unit);
  pid_t pid = fork();
  if (pid < 0) raise_unix_error("fork");
  CAMLreturn(Val_int(pid));
}

CAMLprim value as_traceme(value unit) {
  CAMLparam1(unit);
  if (ptrace(PTRACE_TRACEME, 0, NULL, NULL) != 0) raise_unix_error("ptrace_traceme");
  CAMLreturn(Val_unit);
}

CAMLprim value as_setoptions(value pid_v) {
  CAMLparam1(pid_v);
  long options = PTRACE_O_TRACESYSGOOD | PTRACE_O_TRACEFORK | PTRACE_O_TRACEVFORK |
                 PTRACE_O_TRACECLONE | PTRACE_O_TRACEEXEC | PTRACE_O_TRACEEXIT;
  if (ptrace(PTRACE_SETOPTIONS, Int_val(pid_v), NULL, (void *)options) != 0) {
    raise_unix_error("ptrace_setoptions");
  }
  CAMLreturn(Val_unit);
}

CAMLprim value as_syscall(value pid_v, value signal_v) {
  CAMLparam2(pid_v, signal_v);
  if (ptrace(PTRACE_SYSCALL, Int_val(pid_v), NULL, (void *)(long)Int_val(signal_v)) != 0) {
    raise_unix_error("ptrace_syscall");
  }
  CAMLreturn(Val_unit);
}

CAMLprim value as_geteventmsg(value pid_v) {
  CAMLparam1(pid_v);
  unsigned long msg = 0;
  if (ptrace(PTRACE_GETEVENTMSG, Int_val(pid_v), NULL, &msg) != 0) {
    raise_unix_error("ptrace_geteventmsg");
  }
  CAMLreturn(Val_int((int)msg));
}

CAMLprim value as_getregs(value pid_v) {
  CAMLparam1(pid_v);
  CAMLlocal1(tuple);
  struct user_regs_struct regs;
  if (ptrace(PTRACE_GETREGS, Int_val(pid_v), NULL, &regs) != 0) {
    raise_unix_error("ptrace_getregs");
  }
  tuple = caml_alloc_tuple(8);
  Store_field(tuple, 0, Val_int((int)regs.orig_rax));
  Store_field(tuple, 1, caml_copy_int64((int64_t)regs.rdi));
  Store_field(tuple, 2, caml_copy_int64((int64_t)regs.rsi));
  Store_field(tuple, 3, caml_copy_int64((int64_t)regs.rdx));
  Store_field(tuple, 4, caml_copy_int64((int64_t)regs.r10));
  Store_field(tuple, 5, caml_copy_int64((int64_t)regs.r8));
  Store_field(tuple, 6, caml_copy_int64((int64_t)regs.r9));
  Store_field(tuple, 7, caml_copy_int64((int64_t)regs.rax));
  CAMLreturn(tuple);
}

CAMLprim value as_peek_word(value pid_v, value addr_v) {
  CAMLparam2(pid_v, addr_v);
  CAMLlocal1(out);
  union {
    long value;
    char bytes[sizeof(long)];
  } data;
  errno = 0;
  data.value = ptrace(PTRACE_PEEKDATA, Int_val(pid_v), (void *)(uintptr_t)Int64_val(addr_v), NULL);
  if (errno != 0) raise_unix_error("ptrace_peekdata");
  out = caml_alloc_string(sizeof(long));
  memcpy(Bytes_val(out), data.bytes, sizeof(long));
  CAMLreturn(out);
}

CAMLprim value as_wait(value pid_v, value wall_v) {
  CAMLparam2(pid_v, wall_v);
  CAMLlocal1(result);
  int status = 0;
  int options = Bool_val(wall_v) ? __WALL : 0;
  pid_t pid;
  do {
    pid = waitpid(Int_val(pid_v), &status, options);
  } while (pid < 0 && errno == EINTR);
  if (pid < 0) raise_unix_error("waitpid");
  if (WIFEXITED(status)) {
    result = caml_alloc(2, 0);
    Store_field(result, 0, Val_int(pid));
    Store_field(result, 1, Val_int(WEXITSTATUS(status)));
  } else if (WIFSIGNALED(status)) {
    result = caml_alloc(2, 1);
    Store_field(result, 0, Val_int(pid));
    Store_field(result, 1, Val_int(WTERMSIG(status)));
  } else {
    result = caml_alloc(3, 2);
    Store_field(result, 0, Val_int(pid));
    Store_field(result, 1, Val_int(WSTOPSIG(status)));
    Store_field(result, 2, Val_int(status >> 16));
  }
  CAMLreturn(result);
}

CAMLprim value as_const_sigtrap_sysgood(value unit) {
  CAMLparam1(unit);
  CAMLreturn(Val_int(SIGTRAP | 0x80));
}

CAMLprim value as_const_sigtrap(value unit) {
  CAMLparam1(unit);
  CAMLreturn(Val_int(SIGTRAP));
}

CAMLprim value as_const_sigstop(value unit) {
  CAMLparam1(unit);
  CAMLreturn(Val_int(SIGSTOP));
}

CAMLprim value as_const_event_fork(value unit) {
  CAMLparam1(unit);
  CAMLreturn(Val_int(PTRACE_EVENT_FORK));
}

CAMLprim value as_const_event_vfork(value unit) {
  CAMLparam1(unit);
  CAMLreturn(Val_int(PTRACE_EVENT_VFORK));
}

CAMLprim value as_const_event_clone(value unit) {
  CAMLparam1(unit);
  CAMLreturn(Val_int(PTRACE_EVENT_CLONE));
}

CAMLprim value as_const_event_exec(value unit) {
  CAMLparam1(unit);
  CAMLreturn(Val_int(PTRACE_EVENT_EXEC));
}

CAMLprim value as_const_event_exit(value unit) {
  CAMLparam1(unit);
  CAMLreturn(Val_int(PTRACE_EVENT_EXIT));
}