/**************************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. */ /* */ /* All rights reserved. This file is distributed under the terms of */ /* the GNU Lesser General Public License version 2.1, with the */ /* special exception on linking described in the file LICENSE. */ /* */ /**************************************************************************/ #define CAML_INTERNALS /* Interface with the byte-code debugger */ #ifdef _WIN32 #include #endif /* _WIN32 */ #include #include #include "caml/alloc.h" #include "caml/codefrag.h" #include "caml/config.h" #include "caml/debugger.h" #include "caml/misc.h" #include "caml/memory.h" #include "caml/osdeps.h" #include "caml/skiplist.h" #include "caml/sys.h" int caml_debugger_in_use = 0; uintnat caml_event_count; int caml_debugger_fork_mode = 1; /* parent by default */ #if !defined(HAS_SOCKETS) || defined(NATIVE_CODE) void caml_debugger_init(void) { } opcode_t caml_debugger_saved_instruction(code_t pc) { /* Raise a fatal error in the should-not-happen case where this function * would be called without a socket, so that the execution does not branch * to opcode 0 */ caml_fatal_error("cannot execute debugger instructions" " without a debugger connection socket\n"); return 0; } void caml_debugger(enum event_kind event, value param) { } CAMLexport void caml_debugger_cleanup_fork(void) { } #else #ifndef _WIN32 #include #endif #include #include #include #ifndef _WIN32 #include #include #include #include #include #include #else #define ATOM ATOM_WS #include #include #undef ATOM /* Code duplication with otherlibs/unix/socketaddr.h is inevitable * because pulling winsock2.h creates many naming conflicts. */ #ifdef HAS_AFUNIX_H #include #else struct sockaddr_un { ADDRESS_FAMILY sun_family; char sun_path[108]; }; #endif /* HAS_AFUNIX_H */ #include #endif /* _WIN32 */ #include "caml/fail.h" #include "caml/fix_code.h" #include "caml/instruct.h" #include "caml/intext.h" #include "caml/io.h" #include "caml/mlvalues.h" #include "caml/fiber.h" #include "caml/sys.h" static value marshal_flags; static int sock_domain; /* Socket domain for the debugger */ static struct sockaddr_storage sock_addr; /* Socket address for the debugger */ static int sock_addr_len; /* Length of sock_addr */ static int dbg_socket = -1; /* The socket connected to the debugger */ static struct channel * dbg_in; /* Input channel on the socket */ static struct channel * dbg_out;/* Output channel on the socket */ static char *dbg_addr = NULL; static struct skiplist event_points_table = SKIPLIST_STATIC_INITIALIZER; static void open_connection(void) { char buf[1024]; #ifdef _WIN32 /* Set socket to synchronous mode (= non-overlapped) so that file descriptor-oriented functions (read()/write() etc.) can be used */ SOCKET sock = WSASocket(sock_domain, SOCK_STREAM, 0, NULL, 0, 0 /* not WSA_FLAG_OVERLAPPED */); if (sock == INVALID_SOCKET || connect(sock, (struct sockaddr *)&sock_addr, sock_addr_len) != 0) caml_fatal_error("cannot connect to debugger at %s\n" "WSA error code: %d", (dbg_addr ? dbg_addr : "(none)"), WSAGetLastError()); dbg_socket = _open_osfhandle(sock, 0); if (dbg_socket == -1) #else #if defined(SOCK_CLOEXEC) dbg_socket = socket(sock_domain, SOCK_STREAM | SOCK_CLOEXEC, 0); #else dbg_socket = socket(sock_domain, SOCK_STREAM, 0); #endif if (dbg_socket == -1 || connect(dbg_socket, (struct sockaddr *)&sock_addr, sock_addr_len) == -1) #endif caml_fatal_error("cannot connect to debugger at %s\n" "error: %s", (dbg_addr ? dbg_addr : "(none)"), caml_strerror(errno, buf, sizeof(buf))); dbg_in = caml_open_descriptor_in(dbg_socket); dbg_out = caml_open_descriptor_out(dbg_socket); if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */ #ifdef _WIN32 caml_putword(dbg_out, _getpid()); #else caml_putword(dbg_out, getpid()); #endif caml_flush(dbg_out); } static void close_connection(void) { caml_close_channel(dbg_in); caml_close_channel(dbg_out); dbg_socket = -1; /* was closed by caml_close_channel */ } #ifdef _WIN32 static void winsock_startup(void) { WSADATA wsaData; int err = WSAStartup(MAKEWORD(2, 0), &wsaData); if (err) caml_fatal_error("WSAStartup failed"); } static void winsock_cleanup(void) { WSACleanup(); } /* from Filename.is_implicit */ static bool filename_is_implicit(const char *path) { size_t len = strlen(path); return (len < 1 || path[0] != '/') && (len < 1 || path[0] != '\\') && (len < 2 || path[1] != ':') && strncmp(path, "./", 2) != 0 && strncmp(path, ".\\", 2) != 0 && strncmp(path, "../", 3) != 0 && strncmp(path, "..\\", 3) != 0; } #else /* from Filename.is_implicit */ static bool filename_is_implicit(const char *path) { size_t len = strlen(path); return (len < 1 || path[0] != '/') && strncmp(path, "./", 2) != 0 && strncmp(path, "../", 3) != 0; } #endif static bool is_likely_ipv6(const char *address, const char *port) { return (port - address >= 4) && address[0] == '[' && port[-1] == ']'; } void caml_debugger_init(void) { char * address; char_os * a; char * port; value flags; flags = caml_alloc(2, Tag_cons); Store_field(flags, 0, Val_int(1)); /* Marshal.Closures */ Store_field(flags, 1, Val_emptylist); marshal_flags = flags; caml_register_generational_global_root(&marshal_flags); a = caml_secure_getenv(T("CAML_DEBUG_SOCKET")); address = a ? caml_stat_strdup_of_os(a) : NULL; if (address == NULL) return; if (dbg_addr != NULL) caml_stat_free(dbg_addr); /* #8676: erase the CAML_DEBUG_SOCKET variable so that processes created by the program being debugged do not try to connect with the debugger. */ #if defined(_WIN32) _wputenv(L"CAML_DEBUG_SOCKET="); #elif defined(HAS_SETENV_UNSETENV) unsetenv("CAML_DEBUG_SOCKET"); #endif #ifdef _WIN32 winsock_startup(); (void)atexit(winsock_cleanup); #endif if (*address == 0) caml_fatal_error("cannot connect to debugger: empty address"); /* Parse the address */ port = strrchr(address, ':'); if (port == NULL /* "./foo" is explicitly a path and not a network address */ || !filename_is_implicit(address)) { /* Unix domain */ struct sockaddr_un *s_unix = (struct sockaddr_un *)&sock_addr; sock_domain = PF_UNIX; s_unix->sun_family = AF_UNIX; size_t a_len = strlen(address); if (a_len >= sizeof(s_unix->sun_path)) { caml_fatal_error ( "debug socket path length exceeds maximum permitted length" ); } strncpy(s_unix->sun_path, address, sizeof(s_unix->sun_path) - 1); s_unix->sun_path[sizeof(s_unix->sun_path) - 1] = '\0'; sock_addr_len = offsetof(struct sockaddr_un, sun_path) + a_len; dbg_addr = address; } else { /* Internet domain */ struct addrinfo hints; struct addrinfo *host; memset(&hints, 0, sizeof(hints)); hints.ai_family = AF_UNSPEC; hints.ai_socktype = SOCK_STREAM; #ifdef AI_NUMERICSERV hints.ai_flags = AI_NUMERICSERV; #else for (int i = 1; port[i]; i++) if (port[i] < '0' || '9' < port[i]) caml_fatal_error("the port number should be an integer"); #endif if (is_likely_ipv6(address, port)) { *address++ = 0; port[-1] = 0; } *port++ = 0; if (*address == 0 || *port == 0) caml_fatal_error("empty host or empty port"); int ret = getaddrinfo(address, port, &hints, &host); if (ret != 0) { char buffer[512]; const char *err; #ifdef _WIN32 DWORD error = WSAGetLastError(); if (FormatMessageA( FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, error, 0, buffer, sizeof(buffer), NULL)) caml_fatal_error("cannot connect to debugger at %s port %s\nerror: %lu", address, port, error); err = buffer; #else err = ret != EAI_SYSTEM ? gai_strerror(ret) : caml_strerror(errno, buffer, sizeof(buffer)); #endif caml_fatal_error("cannot connect to debugger at %s port %s\nerror: %s", address, port, err); } if (host == NULL) caml_fatal_error("unknown debugging host %s port %s", address, port); sock_domain = host->ai_family; memcpy(&sock_addr, host->ai_addr, host->ai_addrlen); sock_addr_len = host->ai_addrlen; dbg_addr = address; freeaddrinfo(host); } open_connection(); caml_debugger_in_use = 1; /* Bigger than default caml_trap_sp_off (1) */ Caml_state->trap_barrier_off = 2; Caml_state->trap_barrier_block = -1; } static value getval(struct channel *chan) { value res; if (caml_really_getblock(chan, (char *) &res, sizeof(res)) < sizeof(res)) caml_raise_end_of_file(); /* Bad, but consistent with caml_getword */ return res; } static void putval(struct channel *chan, value val) { caml_really_putblock(chan, (char *) &val, sizeof(val)); } static void safe_output_value(struct channel *chan, value val) { struct longjmp_buffer raise_buf; volatile value raise_exn_bucket; struct caml_exception_context exception_ctx = {&raise_buf, CAML_LOCAL_ROOTS, &raise_exn_bucket}; struct caml_exception_context* saved_external_raise; /* Catch exceptions raised by [caml_output_val] */ saved_external_raise = Caml_state->external_raise; if (sigsetjmp(raise_buf.buf, 0) == 0) { Caml_state->external_raise = &exception_ctx; caml_output_val(chan, val, marshal_flags); } else { /* Send wrong magic number, will cause [caml_input_value] to fail */ caml_really_putblock(chan, "\000\000\000\000", 4); } Caml_state->external_raise = saved_external_raise; } static void save_instruction(code_t pc) { uintnat saved; if (caml_skiplist_find(&event_points_table, (uintnat) pc, &saved)) { /* Already saved. Nothing to do. */ return; } caml_skiplist_insert(&event_points_table, (uintnat) pc, *pc); } static void set_instruction(code_t pc, opcode_t opcode) { save_instruction(pc); caml_set_instruction(pc, opcode); } static void restore_instruction(code_t pc) { CAMLunused_start int found; CAMLunused_end uintnat saved; found = caml_skiplist_find(&event_points_table, (uintnat) pc, &saved); CAMLassert(found); *pc = saved; caml_skiplist_remove(&event_points_table, (uintnat) pc); } static code_t pc_from_pos(int frag, intnat pos) { struct code_fragment *cf = caml_find_code_fragment_by_num(frag); CAMLassert(cf != NULL); return (code_t) (cf->code_start + pos); } opcode_t caml_debugger_saved_instruction(code_t pc) { CAMLunused_start int found; CAMLunused_end uintnat saved; found = caml_skiplist_find(&event_points_table, (uintnat) pc, &saved); CAMLassert(found); return saved; } void caml_debugger_code_unloaded(int index) { struct code_fragment *cf; char * pc; if (!caml_debugger_in_use) return; caml_putch(dbg_out, REP_CODE_UNLOADED); caml_putword(dbg_out, index); cf = caml_find_code_fragment_by_num(index); CAMLassert(cf != NULL); FOREACH_SKIPLIST_ELEMENT(elt, &event_points_table, { pc = (char *) elt->key; if (pc >= cf->code_start && pc < cf->code_end) { caml_skiplist_remove(&event_points_table, (uintnat) pc); } }) } /* Return number of blocks between this one and bottom of stack. */ static intnat frame_block_number (struct stack_info *block) { intnat n = 0; while (block->handler->parent != NULL){ ++ n; block = block->handler->parent; } return n; } /* Find the [n+1]th block counting from bottom of stack. */ static struct stack_info *frame_block_address (intnat n) { struct stack_info *block = Caml_state->current_stack; intnat i = frame_block_number (Caml_state->current_stack); if (n < 0 || n > i) return NULL; for (; i > n; i--){ block = block->handler->parent; CAMLassert (block != NULL); } return block; } /* Return the id of the [n+1]th block counting from bottom of stack, or -1 if there is no such block. */ static inline int64_t frame_block_id (intnat n) { struct stack_info *addr = frame_block_address (n); return addr == NULL ? -1 : addr->id; } #define Pc(sp) ((code_t)((sp)[0])) #define Env(sp) ((sp)[1]) #define Extra_args(sp) (Long_val(((sp)[2]))) #define Locals(sp) ((sp) + 3) void caml_debugger(enum event_kind event, value param) { value *frame, *newframe; intnat i, pos; value val; struct stack_info *frame_block, *new_frame_block; int frag; struct code_fragment *cf; if (dbg_socket == -1) return; /* Not connected to a debugger. */ /* Reset current frame */ frame_block = Caml_state->current_stack; frame = frame_block->sp + 1; /* Report the event to the debugger */ switch(event) { case PROGRAM_START: /* Nothing to report */ CAMLassert (param == Val_unit); goto command_loop; case EVENT_COUNT: CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_EVENT); break; case BREAKPOINT: CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_BREAKPOINT); break; case PROGRAM_EXIT: CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_EXITED); break; case TRAP_BARRIER: CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_TRAP); break; case UNCAUGHT_EXC: CAMLassert (param == Val_unit); caml_putch(dbg_out, REP_UNCAUGHT_EXC); break; case DEBUG_INFO_ADDED: caml_putch(dbg_out, REP_CODE_DEBUG_INFO); caml_output_val(dbg_out, /* debug_info */ param, Val_emptylist); break; case CODE_LOADED: caml_putch(dbg_out, REP_CODE_LOADED); caml_putword(dbg_out, /* index */ Long_val(param)); break; case CODE_UNLOADED: caml_putch(dbg_out, REP_CODE_UNLOADED); caml_putword(dbg_out, /* index */ Long_val(param)); break; } caml_putword(dbg_out, caml_event_count); if (event == EVENT_COUNT || event == BREAKPOINT) { caml_putword(dbg_out, frame_block_number (frame_block)); caml_putword(dbg_out, Stack_high(frame_block) - frame); cf = caml_find_code_fragment_by_pc((char*) Pc(frame)); CAMLassert(cf != NULL); caml_putword(dbg_out, cf->fragnum); caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start); } else { /* No PC and no stack frame associated with other events */ caml_putword(dbg_out, -1); caml_putword(dbg_out, -1); caml_putword(dbg_out, 0); caml_putword(dbg_out, 0); } caml_flush(dbg_out); command_loop: /* Read and execute the commands sent by the debugger */ while(1) { switch(caml_getch(dbg_in)) { case REQ_SET_EVENT: frag = caml_getword(dbg_in); pos = caml_getword(dbg_in); set_instruction(pc_from_pos(frag, pos), EVENT); break; case REQ_SET_BREAKPOINT: frag = caml_getword(dbg_in); pos = caml_getword(dbg_in); set_instruction(pc_from_pos(frag, pos), BREAK); break; case REQ_RESET_INSTR: frag = caml_getword(dbg_in); pos = caml_getword(dbg_in); restore_instruction(pc_from_pos(frag, pos)); break; case REQ_CHECKPOINT: #ifndef _WIN32 caml_release_domain_lock (); /* Don't fork while holding locks. */ i = fork(); caml_acquire_domain_lock (); if (i == 0) { close_connection(); /* Close parent connection. */ open_connection(); /* Open new connection with debugger */ } else { caml_putword(dbg_out, i); caml_flush(dbg_out); } #else caml_fatal_error("REQ_CHECKPOINT command"); #endif break; case REQ_GO: caml_event_count = caml_getword(dbg_in); return; case REQ_STOP: exit(0); break; case REQ_WAIT: #ifndef _WIN32 wait(NULL); #else caml_fatal_error("REQ_WAIT command"); #endif break; case REQ_INITIAL_FRAME: frame_block = Caml_state->current_stack; frame = frame_block->sp + 1; fallthrough; case REQ_GET_FRAME: caml_putword(dbg_out, frame_block_number (frame_block)); caml_putword(dbg_out, Stack_high(frame_block) - frame); if (frame < Stack_high(frame_block) && (cf = caml_find_code_fragment_by_pc((char*) Pc(frame))) != NULL) { caml_putword(dbg_out, cf->fragnum); caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start); } else { caml_putword(dbg_out, 0); caml_putword(dbg_out, 0); } caml_flush(dbg_out); break; case REQ_SET_FRAME: i = caml_getword(dbg_in); frame_block = frame_block_address (i); i = caml_getword(dbg_in); frame = Stack_high(frame_block) - i; break; case REQ_UP_FRAME: i = caml_getword(dbg_in); newframe = frame + Extra_args(frame) + i + 3; if (newframe >= Stack_high (frame_block)){ new_frame_block = frame_block->handler->parent; if (new_frame_block == NULL){ newframe = NULL; }else{ newframe = new_frame_block->sp + 2; } }else{ new_frame_block = frame_block; } if (newframe != NULL){ cf = caml_find_code_fragment_by_pc((char *) Pc(newframe)); }else{ cf = NULL; } if (cf == NULL) { caml_putword(dbg_out, -1); caml_putword(dbg_out, -1); } else { frame = newframe; frame_block = new_frame_block; caml_putword(dbg_out, frame_block_number (frame_block)); caml_putword(dbg_out, Stack_high(frame_block) - frame); caml_putword(dbg_out, cf->fragnum); caml_putword(dbg_out, (char*) Pc(frame) - cf->code_start); } caml_flush(dbg_out); break; case REQ_SET_TRAP_BARRIER: i = caml_getword(dbg_in); Caml_state->trap_barrier_block = frame_block_id(i); i = caml_getword(dbg_in); Caml_state->trap_barrier_off = -i; break; case REQ_GET_LOCAL: i = caml_getword(dbg_in); putval(dbg_out, Locals(frame)[i]); caml_flush(dbg_out); break; case REQ_GET_ENVIRONMENT: i = caml_getword(dbg_in); putval(dbg_out, Field(Env(frame), i)); caml_flush(dbg_out); break; case REQ_GET_GLOBAL: i = caml_getword(dbg_in); putval(dbg_out, Field(caml_global_data, i)); caml_flush(dbg_out); break; case REQ_GET_ACCU: putval(dbg_out, *Caml_state->current_stack->sp); caml_flush(dbg_out); break; case REQ_GET_HEADER: val = getval(dbg_in); caml_putword(dbg_out, Hd_val(val)); caml_flush(dbg_out); break; case REQ_GET_FIELD: val = getval(dbg_in); i = caml_getword(dbg_in); if (Tag_val(val) != Double_array_tag) { caml_putch(dbg_out, 0); putval(dbg_out, Field(val, i)); } else { double d = Double_flat_field(val, i); caml_putch(dbg_out, 1); caml_really_putblock(dbg_out, (char *) &d, 8); } caml_flush(dbg_out); break; case REQ_MARSHAL_OBJ: val = getval(dbg_in); safe_output_value(dbg_out, val); caml_flush(dbg_out); break; case REQ_GET_CLOSURE_CODE: val = getval(dbg_in); cf = caml_find_code_fragment_by_pc((char*) Code_val(val)); CAMLassert(cf != NULL); caml_putword(dbg_out, cf->fragnum); caml_putword(dbg_out, (char*) Code_val(val) - cf->code_start); caml_flush(dbg_out); break; case REQ_SET_FORK_MODE: caml_debugger_fork_mode = caml_getword(dbg_in); break; } } } CAMLexport void caml_debugger_cleanup_fork(void) { /* We could remove all of the event points, but closing the connection * means that they'll just be skipped anyway. */ close_connection(); caml_debugger_in_use = 0; } #endif