JakeHillion/ocaml-cgroups2
Archived
1
0
Fork 0
Code Issues Pull Requests 1 Projects Releases Wiki Activity

wip: ocaml clone shim

Browse Source
This commit is contained in:
Jake Hillion 2022-01-15 00:14:50 +00:00
parent 41ac04b83b
commit 96d82d9fcb
7 changed files with 350 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.ocamlformat Normal file
View File

@ -0,0 +1,6 @@
profile = ocamlformat
break-cases = fit
margin = 77
parse-docstrings = true
wrap-comments = true
line-endings = lf

17
.vscode/c_cpp_properties.json vendored Normal file
View File

@ -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
}

10
tools/clone/Makefile
View File

@ -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

219
tools/clone/clone3_stub.c Normal file
View File

@ -0,0 +1,219 @@
#define CAML_NAME_SPACE
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/callback.h>
#include <unistd.h>
#include <stdio.h>
#include <linux/sched.h>
#include <sys/syscall.h>
#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));
}

BIN
tools/clone/clone_shim Executable file
View File

Binary file not shown.

2
tools/clone/clone_shim.c
View File

@ -1,2 +0,0 @@
#include <linux/sched.h>
#include <caml/mlvalues.h>

140
tools/clone/clone_shim.ml
View File

@ -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;
(** Pointer to where to store the pidfd *)
pidfd: pid_t ref option;
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
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 *)
child_tid: pid_t ref option;
; parent_tid: pid_t ref option
(** Where to place the child thread ID in the parent's memory *)
parent_tid: pid_t ref option;
; exit_signal: int
(** Signal to deliver to parent on child's termination *)
exit_signal: int;
; stack: bytes ref option
(** 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;
; 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 *)
set_tid: pid_t list option;
(* set_tid_size: included in set_tid *)
}
external clone3: unit -> unit = "test"
external clone3 : clone_args -> (unit -> unit) -> unit = "caml_clone3"
let hello_world_caml unit = Printf.eprintf "hello world from ocaml\n"
let () =
let flags = ref [] in
Arg.parse speclist anon_fun usage_msg ;
if !ipc then begin
if !ipc then (
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 ();
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"