mirror of
https://github.com/linuxkit/linuxkit.git
synced 2025-07-23 02:51:55 +00:00
sdk: add fdd exec
to map socketpair shares to local fds
To enable this: ``` $ fdd init & $ fdd share /tmp/foo $ fdd exec -m /tmp/foo:1:2 -- echo hello world! $ fdd exec -m /tmp/foo:0 -- cat hello world! ``` Signed-off-by: Thomas Gazagnaire <thomas@gazagnaire.org>
This commit is contained in:
parent
b4feb71f78
commit
5525937c10
@ -1,6 +1,6 @@
|
||||
FROM ocaml/opam:alpine as base
|
||||
RUN sudo apk add m4
|
||||
RUN opam install jbuilder lwt fd-send-recv logs fmt cmdliner
|
||||
RUN opam install jbuilder lwt fd-send-recv logs fmt cmdliner astring
|
||||
ADD . /src
|
||||
RUN opam pin add fdd /src
|
||||
RUN sudo mkdir -p /out/bin
|
||||
|
22
projects/miragesdk/src/fdd/exec.ml
Normal file
22
projects/miragesdk/src/fdd/exec.ml
Normal file
@ -0,0 +1,22 @@
|
||||
open Lwt.Infix
|
||||
open Common
|
||||
|
||||
let src = Logs.Src.create "fdd/exec"
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
let get_fd share = connect share >>= recv_fd
|
||||
|
||||
let fd_of_int (i:int) =
|
||||
let fd : Unix.file_descr = Obj.magic i in
|
||||
Lwt_unix.of_unix_file_descr fd
|
||||
|
||||
let dup (share, fds) =
|
||||
Log.info (fun l ->
|
||||
l "mapping %s to fds: %a" share Fmt.(list ~sep:(unit " ") int) fds);
|
||||
get_fd share >|= fun fd ->
|
||||
List.iter (fun n -> Lwt_unix.dup2 fd (fd_of_int n)) fds;
|
||||
Unix.close (Lwt_unix.unix_file_descr fd)
|
||||
|
||||
let f dups cmd =
|
||||
Lwt_list.iter_p dup dups >>= fun () ->
|
||||
Unix.execvp (List.hd cmd) (Array.of_list cmd)
|
1
projects/miragesdk/src/fdd/exec.mli
Normal file
1
projects/miragesdk/src/fdd/exec.mli
Normal file
@ -0,0 +1 @@
|
||||
val f: (string * int list) list -> string list -> unit Lwt.t
|
@ -1,3 +1,4 @@
|
||||
open Astring
|
||||
open Cmdliner
|
||||
|
||||
let socket =
|
||||
@ -42,6 +43,38 @@ let share =
|
||||
Term.(const f $ socket $ share $ setup_log),
|
||||
Term.info "share" ~doc:"Share a new socketpair on a given unix domain socket."
|
||||
|
||||
let exec =
|
||||
let dup =
|
||||
let parse str = match String.cuts ~sep:":" str with
|
||||
| [] | [_] ->
|
||||
Error (`Msg ("A valid share map should have the form \
|
||||
<path>:<fd-number>[:fd-number]*"))
|
||||
| s :: fds -> Ok (s, List.map int_of_string fds)
|
||||
in
|
||||
let pp ppf (name, fds) =
|
||||
Fmt.pf ppf "%s:%a" name Fmt.(list ~sep:(unit ":") int) fds
|
||||
in
|
||||
Arg.conv (parse, pp)
|
||||
in
|
||||
let dups =
|
||||
let doc =
|
||||
Arg.info ~docv:"MAP" ~doc:
|
||||
"Maps of socketpairs/local fds in the form \
|
||||
<path>:<fd-number>[:fd-number]*,..."
|
||||
["m";"map"]
|
||||
in
|
||||
Arg.(value & opt (list dup) [] doc)
|
||||
in
|
||||
let cmd =
|
||||
let doc = Arg.info ~docv:"COMMAND" ~doc:"The command to execute" [] in
|
||||
Arg.(non_empty & pos_all string [] doc)
|
||||
in
|
||||
let f dups cmd () = run (Exec.f dups cmd) in
|
||||
Term.(const f $ dups $ cmd $ setup_log),
|
||||
Term.info "exec"
|
||||
~doc:"Execute a command with a side of the socketpair pre-opened on the \
|
||||
specified files descriptors."
|
||||
|
||||
let default =
|
||||
let usage () =
|
||||
Fmt.pr "usage: fdd [--version]\n\
|
||||
@ -64,6 +97,7 @@ let cmds = [
|
||||
init;
|
||||
share;
|
||||
test;
|
||||
exec;
|
||||
]
|
||||
|
||||
let () = match Term.eval_choice default cmds with
|
||||
|
@ -4,4 +4,4 @@
|
||||
(package fdd)
|
||||
(flags (:standard -cclib -static))
|
||||
(libraries (unix lwt.unix lwt.preemptive fd-send-recv logs fmt cmdliner
|
||||
fmt.cli logs.fmt fmt.tty logs.cli))))
|
||||
fmt.cli logs.fmt fmt.tty logs.cli astring))))
|
||||
|
@ -1,8 +1,34 @@
|
||||
open Lwt.Infix
|
||||
open Common
|
||||
|
||||
let src = Logs.Src.create "fdd/share"
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
let sleep ?(sleep_t=0.01) () =
|
||||
let sleep_t = min sleep_t 1. in
|
||||
Lwt_unix.yield () >>= fun () ->
|
||||
Lwt_unix.sleep sleep_t
|
||||
|
||||
let retry ?(timeout=5. *. 60.) ?(sleep_t=0.) fn =
|
||||
let sleep_t = max sleep_t 0.001 in
|
||||
let time = Unix.gettimeofday in
|
||||
let t = time () in
|
||||
let str i = Fmt.strf "%d, %.3fs" i (time () -. t) in
|
||||
let rec aux i =
|
||||
if time () -. t > timeout then fn ()
|
||||
else
|
||||
Lwt.catch fn (fun ex ->
|
||||
Log.debug (fun f -> f "retry ex: %a" Fmt.exn ex);
|
||||
let sleep_t = sleep_t *. (1. +. float i ** 2.) in
|
||||
sleep ~sleep_t () >>= fun () ->
|
||||
Log.debug (fun f -> f "Test.retry %s" (str i));
|
||||
aux (i+1)
|
||||
)
|
||||
in
|
||||
aux 0
|
||||
|
||||
let f ~socket ~share =
|
||||
connect socket >>= fun fd ->
|
||||
retry (fun () -> connect socket) >>= fun fd ->
|
||||
let oc = Lwt_io.of_fd ~mode:Lwt_io.Output fd in
|
||||
Lwt_io.write_line oc share >>= fun () ->
|
||||
Lwt_io.close oc
|
||||
|
Loading…
Reference in New Issue
Block a user