Edit the code to the left, and press Run to recompile!
+Links:
+ + + +let () = + Dream.run ~interface:"0.0.0.0" + @@ Dream.logger + @@ Dream.router [ + Dream.get "/" (fun _ -> Dream.html welcome); + ] + @@ Dream.not_found +|} + +let sandbox_dune_project = {|(lang dune 2.0) +|} + +let sandbox_dune = {|(executable + (name server) + (libraries dream) + (preprocess (pps lwt_ppx))) + +(rule + (targets server.ml) + (deps server.eml.ml) + (action (run dream_eml %{deps} --workspace %{workspace_root}))) +|} + +let sandbox_dockerfile = {|FROM ubuntu:focal-20210416 +RUN apt update && apt install -y openssl libev4 +COPY _build/default/server.exe /server.exe +ENTRYPOINT /server.exe +|} + +let write_file id file content = + Lwt_io.(with_file ~mode:Output (sandbox_root // id // file) (fun channel -> + write channel content)) + +let check_or_create id = + let path = sandbox_root // id in + if%lwt Lwt_unix.file_exists path then + Lwt.return_unit + else + let%lwt () = + match%lwt Lwt_unix.mkdir sandbox_root 0o755 with + | () -> Lwt.return_unit + | exception Unix.(Unix_error (EEXIST, _, _)) -> Lwt.return_unit + in + let%lwt () = Lwt_unix.mkdir path 0o755 in + let%lwt () = write_file id "dune-project" sandbox_dune_project in + let%lwt () = write_file id "dune" sandbox_dune in + let%lwt () = write_file id "server.eml.ml" starter_server_eml_ml in + let%lwt () = write_file id "Dockerfile" sandbox_dockerfile in + Lwt.return_unit + + + +(* Sandbox state transitions. *) + +type container = { + port : int; +} + +type sandbox = { + mutable id : string option; + mutable container : container option; + socket : Dream.websocket; +} + +let sandbox_by_port = + Hashtbl.create 256 + +let sandbox_by_id = + Hashtbl.create 256 + +let min_port = 9000 +let max_port = 9999 + +let next_port = + ref min_port + +(* This can fail if there is a huge number of sandboxes, or very large spikes in + sandbox creation. However, the failure is not catastrophic. *) +let rec allocate_port () = + let port = !next_port in + incr next_port; + let%lwt () = + if !next_port > max_port then begin + next_port := min_port; + Lwt.pause () + end + else + Lwt.return_unit + in + if Hashtbl.mem sandbox_by_port port then + allocate_port () + else + Lwt.return port + +let read sandbox = + match sandbox.id with + | None -> Lwt.return "" + | Some id -> + Lwt_io.(with_file ~mode:Input (sandbox_root // id // "server.eml.ml") read) + +let validate_id id = + String.length id = 12 && Dream.from_base64url id <> None + +let build id = + let command = + Printf.ksprintf Lwt_process.shell + "cd %s && opam exec --color=always -- dune build --root . ./server.exe 2>&1" + (sandbox_root // id) in + Lwt_process.pread command + +let image id = + let command = + Printf.ksprintf Lwt_process.shell + "cd %s && docker build -t sandbox:%s . 2>&1" (sandbox_root // id) id in + Lwt_process.pread command + +let forward ?(add_newline = false) sandbox message = + let message = + if add_newline then message ^ "\n" + else message + in + `Assoc ["kind", `String "log"; "payload", `String message] + |> Yojson.Basic.to_string + |> fun message -> Dream.send message sandbox.socket + +let started sandbox port = + `Assoc ["kind", `String "started"; "payload", `Int port] + |> Yojson.Basic.to_string + |> fun message -> Dream.send message sandbox.socket + +let run sandbox id = + let%lwt port = allocate_port () in + Hashtbl.replace sandbox_by_port port sandbox; + Hashtbl.replace sandbox_by_id id sandbox; + sandbox.container <- Some {port}; + Lwt.async begin fun () -> + Printf.ksprintf Lwt_process.shell + "docker run -p %i:8080 --name s-%s --rm -t sandbox:%s 2>&1" + port id id + |> Lwt_process.pread_lines + |> Lwt_stream.iter_s (forward ~add_newline:true sandbox) + end; + Lwt.return port + +let stop_container sandbox = + match sandbox.id, sandbox.container with + | Some id, Some container -> + Printf.ksprintf Sys.command "docker kill s-%s" id |> ignore; + Hashtbl.remove sandbox_by_port container.port; + Hashtbl.remove sandbox_by_id id; + Lwt.return_unit + | _ -> Lwt.return_unit + +(* TODO Forcibly stop after one second. *) +let stop sandbox = + let%lwt () = stop_container sandbox in + Dream.close_websocket sandbox.socket + + + +(* Main loop for each connected client WebSocket. *) + +(* TODO Mind concurrency issues with client messages coming during transitions. + OTOH this code waits during those transitions anyway, so maybe it is not an + issue. *) +let rec communicate sandbox = + match%lwt Dream.receive sandbox.socket with + | None -> stop sandbox + | Some message -> + let values = + (* TODO Raises. *) + match Yojson.Basic.from_string message with + | `Assoc ["kind", `String kind; "payload", `String payload] -> + Some (kind, payload) + | _ -> + None + in + match values with + | None -> stop sandbox + | Some (kind, payload) -> + match kind, sandbox with + + | "attach", _ -> + let payload = String.sub payload 1 (String.length payload - 1) in + if not (validate_id payload) then stop sandbox + else + let id = payload in + let%lwt () = check_or_create id in + sandbox.id <- Some id; + let%lwt content = read sandbox in + let%lwt () = + `Assoc ["kind", `String "content"; "payload", `String content] + |> Yojson.Basic.to_string + |> fun s -> Dream.send s sandbox.socket + in + communicate sandbox + + | "run", {id = Some id; _} -> + let%lwt () = stop_container sandbox in + let%lwt () = write_file id "server.eml.ml" payload in + let%lwt output = build id in + let%lwt () = forward sandbox output in + let%lwt output = image id in + (* let%lwt () = forward sandbox output in *) + ignore output; + let%lwt port = run sandbox id in + let%lwt () = Lwt_unix.sleep 0.25 in + let%lwt () = started sandbox port in + communicate sandbox + + | _ -> stop sandbox + + + +(* The Web server proper. *) + +let () = + Dream.run ~interface:"0.0.0.0" ~port:80 ~adjust_terminal:false + @@ Dream.logger + @@ Dream.router [ + + (* Generate a fresh valid id for new visitors, and redirect. *) + Dream.get "/" (fun _ -> + Dream.random 9 + |> Dream.to_base64url + |> (^) "/" + |> Dream.redirect); + + (* Apply function communicate to WebSocket connections. *) + Dream.get "/socket" (fun _ -> + Dream.websocket (fun socket -> communicate { + id = None; + container = None; + socket; + })); + + (* For sandbox ids, respond with the sandbox page. *) + Dream.get "/:id" (fun request -> + if not (validate_id (Dream.param "id" request)) then + Dream.empty `Not_Found + else + let%lwt response = + Dream__middleware.Static.default_loader + "static" "playground.html" request in + let response : Dream.response = Obj.magic response in + Dream.with_header "Content-Type" "text/html; charset=utf-8" response + |> Lwt.return); + + ] + @@ Dream.not_found diff --git a/example/z-playground/util/setup.sh b/example/z-playground/util/setup.sh new file mode 100644 index 0000000..94e449c --- /dev/null +++ b/example/z-playground/util/setup.sh @@ -0,0 +1,26 @@ +#!/bin/bash + +sudo apt update +sudo apt upgrade +# sudo init 6 + +# https://www.digitalocean.com/community/tutorials/how-to-install-and-use-docker-on-ubuntu-20-04 +sudo apt install apt-transport-https +curl -fsSL https://download.docker.com/linux/ubuntu/gpg | sudo apt-key add - +sudo add-apt-repository "deb [arch=amd64] https://download.docker.com/linux/ubuntu focal stable" +sudo apt update +sudo apt install docker-ce + +sudo apt install build-essential m4 unzip bubblewrap +wget -O opam https://github.com/ocaml/opam/releases/download/2.0.8/opam-2.0.8-x86_64-linux +sudo mv opam /usr/local/bin/ +sudo chmod a+x /usr/local/bin/opam +opam init --no-setup --bare +opam update +opam switch create 4.12.0 + +sudo apt install libev-dev libssl-dev pkg-config +opam install dream + +sudo apt install npm +npm install diff --git a/example/z-playground/util/sync.sh b/example/z-playground/util/sync.sh new file mode 100644 index 0000000..5c26c25 --- /dev/null +++ b/example/z-playground/util/sync.sh @@ -0,0 +1,9 @@ +#!/bin/bash + +HOST=$1 + +rm -rf sandbox +rsync -rlv . $HOST:playground +rsync -v ../../docs/web/site/iosevka-regular.woff2 $HOST:playground/client/ +# ssh $HOST chmod a-x 'playground/*' 'playground/.*' +# ssh $HOST opam exec -- dune build playground/playground.exe