diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..3ab60ff --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,6 @@ +profile = ocamlformat +break-cases = fit +margin = 77 +parse-docstrings = true +wrap-comments = true +line-endings = lf \ No newline at end of file diff --git a/.vscode/c_cpp_properties.json b/.vscode/c_cpp_properties.json new file mode 100644 index 0000000..b11b91f --- /dev/null +++ b/.vscode/c_cpp_properties.json @@ -0,0 +1,17 @@ +{ + "configurations": [ + { + "name": "Linux", + "includePath": [ + "${workspaceFolder}/**", + "/home/jsh77/.opam/default/lib/ocaml" + ], + "defines": [], + "compilerPath": "/usr/bin/gcc", + "cStandard": "gnu17", + "cppStandard": "gnu++14", + "intelliSenseMode": "linux-gcc-x64" + } + ], + "version": 4 +} \ No newline at end of file diff --git a/tools/clone/Makefile b/tools/clone/Makefile index e69de29..cde5299 100644 --- a/tools/clone/Makefile +++ b/tools/clone/Makefile @@ -0,0 +1,10 @@ +all: clone_shim + +clone_shim: clone_shim.ml clone3_stub.o + ocamlc -custom -o clone_shim clone_shim.ml clone3_stub.o + +clone3_stub.o: clone3_stub.c + ocamlc -c clone3_stub.c + +clean: + rm clone_shim.cmi clone_shim.cmo clone3_stub.o diff --git a/tools/clone/clone3_stub.c b/tools/clone/clone3_stub.c new file mode 100644 index 0000000..b258170 --- /dev/null +++ b/tools/clone/clone3_stub.c @@ -0,0 +1,219 @@ +#define CAML_NAME_SPACE +#include +#include +#include + +#include +#include +#include +#include + +#ifndef CLONE_NEWCGROUP /* Added in Linux 4.6 */ +#define CLONE_NEWCGROUP 0x02000000 +#endif + +#ifndef CLONE_CLEAR_SIGHAND /* Added in Linux 5.5 */ +#define CLONE_CLEAR_SIGHAND 0x100000000ULL +#endif + +#ifndef CLONE_NEWTIME /* Added in Linux 5.6 */ +#define CLONE_NEWTIME 0x00000080 +#endif + +/* +type clone_flag = + | CLONE_CHILD_CLEARTID + | CLONE_CHILD_SETTID + | CLONE_CLEAR_SIGHAND + | CLONE_FILES + | CLONE_FS + | CLONE_IO + | CLONE_NEWCGROUP + | CLONE_NEWIPC + | CLONE_NEWNET + | CLONE_NEWNS + | CLONE_NEWPID + | CLONE_NEWUSER + | CLONE_NEWUTS + | CLONE_PARENT + | CLONE_PARENT_SETTID + | CLONE_PIDFD + | CLONE_PTRACE + | CLONE_SETTLS + | CLONE_SIGHAND + | CLONE_SYSVSEM + | CLONE_THREAD + | CLONE_UNTRACED + | CLONE_VFORK + | CLONE_VM + | CLONE_NEWTIME +*/ + +unsigned long long caml_clone_flag(value val) +{ + switch (Long_val(val)) + { + case 0: + return CLONE_CHILD_CLEARTID; + case 1: + return CLONE_CHILD_SETTID; + case 2: + return CLONE_CLEAR_SIGHAND; + case 3: + return CLONE_FILES; + case 4: + return CLONE_FS; + case 5: + return CLONE_IO; + case 6: + return CLONE_NEWCGROUP; + case 7: + return CLONE_NEWIPC; + case 8: + return CLONE_NEWNET; + case 9: + return CLONE_NEWNS; + case 10: + return CLONE_NEWPID; + case 11: + return CLONE_NEWUSER; + case 12: + return CLONE_NEWUTS; + case 13: + return CLONE_PARENT; + case 14: + return CLONE_PARENT_SETTID; + case 15: + return CLONE_PIDFD; + case 16: + return CLONE_PTRACE; + case 17: + return CLONE_SETTLS; + case 18: + return CLONE_SIGHAND; + case 19: + return CLONE_SYSVSEM; + case 20: + return CLONE_THREAD; + case 21: + return CLONE_UNTRACED; + case 22: + return CLONE_VFORK; + case 23: + return CLONE_VM; + case 24: + return CLONE_NEWTIME; + } + + return 0; +} + +/* +type clone_args = + { flags: int (** Flags for the clone call *) + ; pidfd: pid_t ref option (** Pointer to where to store the pidfd *) + ; child_tid: pid_t ref option + (** Where to place the child thread ID in the child's memory *) + ; parent_tid: pid_t ref option + (** Where to place the child thread ID in the parent's memory *) + ; exit_signal: int + (** Signal to deliver to parent on child's termination *) + ; stack: bytes ref option + (** Stack for the child if the parent and child share memory *) + ; tls: int ref option (** Location of new thread local storage *) + ; set_tid: pid_t list option + (** Optional list of specific pids for one or more of the namespaces *) + } +*/ + +value caml_clone3(value caml_cl_args, value fn) +{ + CAMLparam2(caml_cl_args, fn); + + // extract arguments + unsigned long long flags = 0; + + value tail = Field(caml_cl_args, 0); + while (!Is_none(tail)) + { + flags |= caml_clone_flag(Field(tail, 0)); + tail = Field(tail, 1); + } + + int pidfd; // output + pid_t child_tid; // output + pid_t parent_tid; // output + int exit_signal; // input + void *stack; // input + size_t stack_size; // input + void *tls; // input + pid_t *set_tid; // input + size_t set_tid_size; // input + int cgroup; // input + + exit_signal = Int_val(Field(caml_cl_args, 4)); + + value stack_val = Field(caml_cl_args, 5); + if (Is_some(stack_val)) + { + stack = Bytes_val(Some_val(stack_val)); + stack_size = caml_string_length(Some_val(stack_val)); + } + else + { + stack = NULL; + stack_size = 0; + } + // TODO: set_tid + + struct clone_args cl_args = { + .flags = (uint64_t)flags, + .pidfd = (uint64_t)&pidfd, + .child_tid = (uint64_t)&child_tid, + .parent_tid = (uint64_t)&parent_tid, + .exit_signal = (uint64_t)exit_signal, + .stack = (uint64_t)stack, + .stack_size = (uint64_t)stack_size, + .tls = (uint64_t)0, + // .set_tid = set_tid, + // .set_tid_size = set_tid_size, + // .cgroup = cgroup, + }; + + // clone + pid_t clone_result = syscall(SYS_clone3, &cl_args, sizeof(struct clone_args)); + if (clone_result == 0) + { + // run the callback + // value v = caml_callback(fn, Val_none); + // if (Is_exception_result(v)) + // { + // exit(1); + // } + // else + // { + // exit(0); + // } + + char *newargv[] = {"/bin/sh", NULL}; + char *newenviron[] = {NULL}; + + execve(newargv[0], newargv, newenviron); + perror("execve"); + return 1; + } + else if (clone_result < 0) + { + // handle error + perror("clone"); + exit(-1); + } + + // write back results to caml refs + if (Is_some(Field(caml_cl_args, 1))) + { + Store_field(caml_cl_args, 1, Val_int(pidfd)); + } + + CAMLreturn(Val_int(clone_result)); +} diff --git a/tools/clone/clone_shim b/tools/clone/clone_shim new file mode 100755 index 0000000..3b7a0c2 Binary files /dev/null and b/tools/clone/clone_shim differ diff --git a/tools/clone/clone_shim.c b/tools/clone/clone_shim.c deleted file mode 100644 index ef55e0f..0000000 --- a/tools/clone/clone_shim.c +++ /dev/null @@ -1,2 +0,0 @@ -#include -#include \ No newline at end of file diff --git a/tools/clone/clone_shim.ml b/tools/clone/clone_shim.ml index b1aa50a..6283dfe 100644 --- a/tools/clone/clone_shim.ml +++ b/tools/clone/clone_shim.ml @@ -1,82 +1,124 @@ let usage_msg = "clone [options] [program [arguments]]" let ipc = ref false + let mount = ref false + let network = ref false + let pid = ref false + let uts = ref false + let user = ref false + let cgroup = ref false + let time = ref false let verbose = ref false let program_args = ref [] -let anon_fun arg = - program_args := arg::!program_args -let speclist = [ - ("-i", Arg.Set ipc, "Clone into a new IPC namespace"); - ("-m", Arg.Set mount, "Clone into a new mount namespace"); - ("-n", Arg.Set network, "Clone into a new network namespace"); - ("-p", Arg.Set pid, "Clone into a new PID namespace"); - ("-u", Arg.Set uts, "Clone into a new UTS (Unix Time Sharing) namespace"); - ("-U", Arg.Set user, "Clone into a new user namespace"); - ("-C", Arg.Set cgroup, "Clone into a new IPC namespace"); - ("-T", Arg.Set time, "Clone into a new time namespace"); +let anon_fun arg = program_args := arg :: !program_args - ("-v", Arg.Set verbose, "Verbose logging") -] +let speclist = + [ ("-i", Arg.Set ipc, "Clone into a new IPC namespace") + ; ("-m", Arg.Set mount, "Clone into a new mount namespace") + ; ("-n", Arg.Set network, "Clone into a new network namespace") + ; ("-p", Arg.Set pid, "Clone into a new PID namespace") + ; ("-u", Arg.Set uts, "Clone into a new UTS (Unix Time Sharing) namespace") + ; ("-U", Arg.Set user, "Clone into a new user namespace") + ; ("-C", Arg.Set cgroup, "Clone into a new IPC namespace") + ; ("-T", Arg.Set time, "Clone into a new time namespace") + ; ("-v", Arg.Set verbose, "Verbose logging") ] let veprintf = if !verbose then Printf.eprintf else Printf.eprintf type pid_t = int -type clone_args = { - (** Flags for the clone call *) - flags: int; +type clone_flag = + | CLONE_CHILD_CLEARTID + | CLONE_CHILD_SETTID + | CLONE_CLEAR_SIGHAND + | CLONE_FILES + | CLONE_FS + | CLONE_IO + | CLONE_NEWCGROUP + | CLONE_NEWIPC + | CLONE_NEWNET + | CLONE_NEWNS + | CLONE_NEWPID + | CLONE_NEWUSER + | CLONE_NEWUTS + | CLONE_PARENT + | CLONE_PARENT_SETTID + | CLONE_PIDFD + | CLONE_PTRACE + | CLONE_SETTLS + | CLONE_SIGHAND + | CLONE_SYSVSEM + | CLONE_THREAD + | CLONE_UNTRACED + | CLONE_VFORK + | CLONE_VM + | CLONE_NEWTIME - (** Pointer to where to store the pidfd *) - pidfd: pid_t ref option; +type clone_args = + { flags: clone_flag list (** Flags for the clone call *) + ; pidfd: pid_t ref option (** Pointer to where to store the pidfd *) + ; child_tid: pid_t ref option + (** Where to place the child thread ID in the child's memory *) + ; parent_tid: pid_t ref option + (** Where to place the child thread ID in the parent's memory *) + ; exit_signal: int + (** Signal to deliver to parent on child's termination *) + ; stack: bytes ref option + (** Stack for the child if the parent and child share memory *) + ; tls: int ref option (** Location of new thread local storage *) + ; set_tid: pid_t list option + (** Optional list of specific pids for one or more of the namespaces *) + } - (** Where to place the child thread ID in the child's memory *) - child_tid: pid_t ref option; +external clone3 : clone_args -> (unit -> unit) -> unit = "caml_clone3" - (** Where to place the child thread ID in the parent's memory *) - parent_tid: pid_t ref option; - - (** Signal to deliver to parent on child's termination *) - exit_signal: int; - - (** Stack for the child if the parent and child share memory *) - stack: bytes ref; - - (* stack_size: included in stack *) - - (** Location of new thread local storage *) - tls: int ref; - - (** Optional list of specific pids for one or more of the namespaces *) - set_tid: pid_t list option; - - (* set_tid_size: included in set_tid *) -} - -external clone3: unit -> unit = "test" +let hello_world_caml unit = Printf.eprintf "hello world from ocaml\n" let () = - Arg.parse speclist anon_fun usage_msg; - - if !ipc then begin - veprintf "cloning into a new IPC namespace\n"; - end; - - if !mount then veprintf "cloning into a new mount namespace\n"; - if !network then veprintf "cloning into a new network namespace\n"; - if !pid then veprintf "cloning into a new PID namespace\n"; - if !uts then veprintf "cloning into a new UTS namespace\n"; - if !user then veprintf "cloning into a new user namespace\n"; - if !cgroup then veprintf "cloning into a new cgroup namespace\n"; - if !time then veprintf "cloning into a new time namespace\n"; - - clone3 (); + let flags = ref [] in + Arg.parse speclist anon_fun usage_msg ; + if !ipc then ( + veprintf "cloning into a new IPC namespace\n" ; + flags := CLONE_NEWIPC :: !flags ) ; + if !mount then ( + veprintf "cloning into a new mount namespace\n" ; + flags := CLONE_NEWNS :: !flags ) ; + if !network then ( + veprintf "cloning into a new network namespace\n" ; + flags := CLONE_NEWNET :: !flags ) ; + if !pid then ( + veprintf "cloning into a new PID namespace\n" ; + flags := CLONE_NEWPID :: !flags ) ; + if !uts then ( + veprintf "cloning into a new UTS namespace\n" ; + flags := CLONE_NEWUTS :: !flags ) ; + if !user then ( + veprintf "cloning into a new user namespace\n" ; + flags := CLONE_NEWUSER :: !flags ) ; + if !cgroup then ( + veprintf "cloning into a new cgroup namespace\n" ; + flags := CLONE_NEWCGROUP :: !flags ) ; + if !time then ( + veprintf "cloning into a new time namespace\n" ; + flags := CLONE_NEWTIME :: !flags ) ; + clone3 + { flags= !flags + ; pidfd= None + ; child_tid= None + ; parent_tid= None + ; exit_signal= 0 + ; stack= None + ; tls= None + ; set_tid= None } + hello_world_caml ; + veprintf "exiting now\n"