diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..e69de29 diff --git a/colorize.fake.ml b/colorize.fake.ml deleted file mode 100644 index 3110ef4..0000000 --- a/colorize.fake.ml +++ /dev/null @@ -1,28 +0,0 @@ -open Js_of_ocaml -open Js_of_ocaml_tyxml - -let text ~a_class:cl s = Tyxml_js.Html.(span ~a:[ a_class [ cl ] ] [ txt s ]) - -let ocaml = text - -let highlight from_ to_ e = - match Js.Opt.to_option e##.textContent with - | None -> assert false - | Some x -> - let x = Js.to_string x in - let (`Pos from_) = from_ in - let to_ = - match to_ with - | `Pos n -> n - | `Last -> String.length x - 1 - in - e##.innerHTML := Js.string ""; - let span kind s = - if s <> "" - then - let span = Tyxml_js.Html.(span ~a:[ a_class [ kind ] ] [ txt s ]) in - Dom.appendChild e (Tyxml_js.To_dom.of_element span) - in - span "normal" (String.sub x 0 from_); - span "errorloc" (String.sub x from_ (to_ - from_)); - span "normal" (String.sub x to_ (String.length x - to_)) diff --git a/colorize.higlo.ml b/colorize.ml similarity index 100% rename from colorize.higlo.ml rename to colorize.ml diff --git a/cors_proxy.ml b/cors_proxy.ml new file mode 100644 index 0000000..ebc6a9a --- /dev/null +++ b/cors_proxy.ml @@ -0,0 +1,215 @@ +module Format = Stdlib.Format +module Arg = Stdlib.Arg +open Lwt.Infix +open Httpaf + +module Server = struct + include Httpaf_lwt_unix.Server + + let error_handler ?request:_ error start_response = + let response_body = start_response Headers.empty in + (match error with + | `Exn exn -> + Body.write_string response_body (Base.Exn.to_string exn); + Body.write_string response_body "\n" + | #Status.standard as error -> + Body.write_string response_body + (Status.default_reason_phrase error)); + Body.close_writer response_body +end + +let proxy_host = "gitea.departmentofinter.net" + +let file_response_headers = + [ + ("accept-ranges", "bytes"); + ("access-control-allow-origin", "*"); + ( "access-control-allow-headers", + "Origin, X-Requested-With, Content-Type, Accept, Range" ); + ("cache-control", "no-cache, no-store, must-revalidate"); + ("etag", "W/\"6861266-5562-2024-02-11T19:05:04.733Z\""); + ("content-type", "text/html; charset=UTF-8"); + ("connection", "close"); + ] + +let proxy_handler reqd : unit = + match Reqd.request reqd with + | Request.{ meth; headers; target; _ } -> + Lwt.async (fun () -> + let filename = Fmt.str "./%s" target in + if Sys.file_exists filename && Sys.is_regular_file filename + then ( + let file = + Lwt_io.open_file ~flags:[ O_RDONLY ] ~mode:Lwt_io.input + filename + in + let headers = Headers.of_list file_response_headers in + Lwt_io.file_length filename >>= fun file_len -> + let headers = + Headers.add_list headers + [ ("content-length", Int64.to_string file_len) ] + in + Format.printf ">>> Response with File:\nHeaders:\n%s\n %!" + (Headers.to_string headers); + let response = Response.create ~headers `OK in + let response_body = + Reqd.respond_with_streaming reqd response + in + file >>= fun file -> + let rec reader () = + if + Int64.compare + (Int64.sub file_len (Lwt_io.position file)) + Int64.zero + > 0 + then ( + Lwt_io.read file >>= fun s -> + Format.printf ".%i\n%!" (String.length s); + Body.write_string response_body s; + + reader ()) + else Lwt.return_unit >>= fun () -> Lwt.return_unit + in + + reader () >>= fun () -> + Body.close_writer response_body; + Lwt_io.close file >>= fun () -> + Format.printf "done%!"; + Lwt.return_unit) + else + let uri = Fmt.str "https://%s%s" proxy_host target in + let proxy_finished, proxy_notify_finished = Lwt.wait () in + let proxy_response_handler _ + (proxy_response_body_acc : Buffer.t) + proxy_response_body = + Format.printf ">>> proxy_response_body chunk: %i\n%!" + (String.length proxy_response_body); + Buffer.add_string proxy_response_body_acc + proxy_response_body; + Lwt.return proxy_response_body_acc + in + let request_headers = + Headers.replace headers "Host" proxy_host + in + let request_headers = + Headers.replace request_headers "origin" + (Fmt.str "https://%s" proxy_host) + in + let request_headers = + Headers.replace request_headers "content-type" + "application/x-git-upload-pack-request" + in + + let proxy_request_headers = + Headers.of_list + [ + ("Accept-Language", "en-US, *;q=0.9"); + ("Accept", "application/x-git-upload-pack-result"); + ( "Content-Type", + "application/x-git-receive-upload-request" ); + ("Accept-Encoding", "deflate, gzip, br, zstd"); + ("User-Agent", "git/2.43.0"); + ( "Authorization", + "Basic \ + Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=" + ); + ("Host", "gitea.departmentofinter.net"); + ( "Content-Length", + Option.fold ~some:Fun.id ~none:"0" + (Headers.get headers "content-length") ); + ] + in + + let request_body = Reqd.request_body reqd in + let request_body_buffer = + Bigstringaf.create + (Option.fold ~some:int_of_string ~none:4096 + (Headers.get headers "content-length")) + in + let response_body_buffer = Buffer.create 0 in + let rec on_read buffer ~off ~len = + Bigstringaf.blit buffer ~src_off:off request_body_buffer + ~dst_off:off ~len; + Body.schedule_read request_body ~on_eof ~on_read + and on_eof () = Body.close_reader request_body in + Body.schedule_read request_body ~on_eof ~on_read; + Format.printf + ">>> Proxy Request: Target:%s Headers:\n%s\n%!" target + (String.trim (Headers.to_string request_headers)); + Format.printf ">>> Proxy Request Body length: %i\n%!" + (Bigstringaf.length request_body_buffer); + Http_lwt_client.request + ?config:(Some (`HTTP_1_1 Httpaf.Config.default)) + ~meth + ~headers:(Headers.to_list request_headers) + ?body:(Some (Bigstringaf.to_string request_body_buffer)) + ~follow_redirect:false uri proxy_response_handler + response_body_buffer + >>= function + | Ok + ( { version; status; reason; headers }, + proxy_response_body_acc ) -> + Format.printf + ">>> Response Ok: Code: %i Reason: %s Headers:\n\ + %s\n\ + %!" + (H2.Status.to_code status) + reason + (String.trim (H2.Headers.to_string headers)); + let headers = + Headers.of_list (H2.Headers.to_list headers) + in + let status = + Status.of_code (H2.Status.to_code status) + in + let response = + let content_type = + match Headers.get headers "content-type" with + | None -> "application/octet-stream" + | Some x -> x + in + Response.create ~reason ~version + ~headers: + (Headers.replace headers "content-type" + content_type) + status + in + let response_body = + Reqd.respond_with_streaming reqd response + in + Body.write_string response_body ~off:0 + ~len:(Buffer.length proxy_response_body_acc) + (Buffer.contents proxy_response_body_acc); + Body.close_writer response_body; + Lwt.wakeup_later proxy_notify_finished (); + Lwt.return_unit + | Error (`Msg msg) -> + Format.printf "Request failed with %s%!" msg; + Lwt.return_unit >>= fun () -> proxy_finished) +(* | _ -> + let headers = Headers.of_list [ ("connection", "close") ] in + Reqd.respond_with_string reqd + (Response.create ~headers `Method_not_allowed) + "" *) + +let request_handler (_ : Unix.sockaddr) = proxy_handler +let error_handler (_ : Unix.sockaddr) = Server.error_handler + +let main port = + let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in + Lwt.async (fun () -> + Lwt_io.establish_server_with_client_socket listen_address + (Server.create_connection_handler ~request_handler + ~error_handler) + >|= fun _server -> + Stdio.printf + "Listening on localhost:%i and proxying requests via \ + https://%s.\n\ + %!" + port proxy_host); + let forever, _ = Lwt.wait () in + Lwt_main.run forever + +let () = + let port = ref 8080 in + main !port diff --git a/cors_proxy.sh b/cors_proxy.sh new file mode 100755 index 0000000..fecb652 --- /dev/null +++ b/cors_proxy.sh @@ -0,0 +1,17 @@ +#!/bin/bash +#if [ ! -f /tmp/key.pem ]; then +# echo Creating key +# openssl req -newkey rsa:2048 -new -nodes -x509 -days 3650 -keyout /tmp/key.pem -out /tmp/cert.pem -batch +#fi + +npx http-server --cors -S -P https://gitea.departmentofinter.net --log-ip -c-1 -C /tmp/cert.pem -K /tmp/key.pem + +# HTTP/1.1 204 No Content +# accept-ranges: bytes +# access-control-allow-origin: * +# access-control-allow-headers: Origin, X-Requested-With, Content-Type, Accept, Range +# Date: Tue, 13 Feb 2024 00:42:59 GMT +# Connection: keep-alive +# Keep-Alive: timeout=5 + +#mitmproxy --map-local="|localhost:8080/|$(pwd)" --map-remote="|localhost:8080/console|https://gitea.departmentofinter.#net/console" -H="|Access-Control-Allow-Origin|*" -H "|Access-Control-Allow-Credentials|true" -H "|Access-Control-Allow#-Methods|GET, POST, OPTIONS" -H "|Access-Control-Allow-Headers|*" -H "|Access-Control-Max-Age|86400" -H="|Authorizatio#n|Basic cqc:d9c2b491e70e31a760ce70bc431036c91325f683" diff --git a/dune b/dune index d296456..daa6fc9 100644 --- a/dune +++ b/dune @@ -1,40 +1,43 @@ +(env + (dev (flags (:standard -warn-error -A)))) + (executables - (names toplevel) + (names cors_proxy) + (libraries httpaf httpaf-lwt-unix base stdio fmt http-lwt-client) + (modules cors_proxy) +) + +(library (name store) (libraries - js_of_ocaml-compiler - js_of_ocaml-tyxml - js_of_ocaml-toplevel - lwt - js_of_ocaml-lwt + digestif.ocaml + checkseum.ocaml + irmin.mem + git + irmin-git + cohttp-lwt-jsoo + mimic + js_of_ocaml) + (modules store) + (preprocess + (pps js_of_ocaml-ppx))) + +(executables + (names oplevel) + (libraries + store + js_of_ocaml-compiler js_of_ocaml-tyxml js_of_ocaml-toplevel + lwt js_of_ocaml-lwt ;; not used directly graphics js_of_ocaml.deriving - react - reactiveData - str - dynlink - (select - ocp_indent.ml - from - (ocp-indent.lib -> ocp_indent.ok.ml) - (-> ocp_indent.fake.ml)) - (select - colorize.ml - from - (higlo -> colorize.higlo.ml) - (!higlo -> colorize.fake.ml)) - (select - graphics_support.ml - from - (js_of_ocaml-lwt.graphics -> graphics_support.enabled.ml) - (-> graphics_support.disabled.ml)) - (select - ppx_support.ml - from - (js_of_ocaml-ppx -> ppx_support.enabled.ml) - (-> ppx_support.disabled.ml))) + react reactiveData + str dynlink + ocp-indent.lib + higlo + js_of_ocaml-lwt.graphics + js_of_ocaml-ppx) (flags - (:standard -rectypes)) + (:standard -rectypes -warn-error -A)) (link_flags (:standard -linkall)) (modes byte js) @@ -42,7 +45,7 @@ (link_flags (:standard)) (build_runtime_flags (:standard - +toplevel.js + ;; +oplevel.js +dynlink.js --file %{dep:examples.ml} @@ -52,10 +55,10 @@ %{dep:test_dynlink.js})) (flags (:standard - --toplevel + --toplevel (:include effects_flags.sexp)))) (modules - (:standard \ test_dynlink examples effects_flags)) + oplevel toplevel ppx_support graphics_support colorize ocp_indent indent b64) (preprocess (pps js_of_ocaml-ppx))) @@ -84,11 +87,9 @@ -o %{targets} stdlib - graphics str dynlink - js_of_ocaml-compiler.runtime - js_of_ocaml-lwt.graphics + js_of_ocaml.graphics js_of_ocaml-ppx.as-lib js_of_ocaml.deriving lwt @@ -120,7 +121,7 @@ (run ./effects_flags.exe txt)))) (rule - (targets toplevel.js) + (targets oplevel.js) (action (run %{bin:js_of_ocaml} @@ -141,10 +142,10 @@ --toplevel --disable shortvar - %{dep:toplevel.bc} + %{dep:oplevel.bc} -o %{targets}))) (alias (name default) - (deps toplevel.js toplevel.bc.js index.html)) + (deps oplevel.js oplevel.bc.js index.html)) diff --git a/graphics_support.disabled.ml b/graphics_support.disabled.ml deleted file mode 100644 index c12db60..0000000 --- a/graphics_support.disabled.ml +++ /dev/null @@ -1 +0,0 @@ -let init _ = () diff --git a/graphics_support.enabled.ml b/graphics_support.ml similarity index 100% rename from graphics_support.enabled.ml rename to graphics_support.ml diff --git a/index.html b/index.html index 09fa9b7..d4a3053 100644 --- a/index.html +++ b/index.html @@ -153,14 +153,14 @@ var fields = hash.split(/&/); var prefix = ""; var version = ""; - var main = "toplevel.bc.js"; + var main = "oplevel.bc.js"; for(var f in fields){ var data = fields[f].split(/=/); if(data[0] == "version"){ version = data[1].replace(/%20|%2B/g,"+"); } else if (data[0] == "separate"){ - main = "toplevel.bc.js"; + main = "oplevel.bc.js"; } } function load_script(url){ @@ -185,45 +185,9 @@
It makes OCaml programs that run on Web browsers. It is - easy to install as it works with an existing installation of OCaml, - with no need to recompile any library. It comes with bindings for a - large part of the browser APIs.
-This web-based OCaml toplevel is compiled using Js_of_ocaml.
-| Enter/Return | -Submit code | -
| Ctrl + Enter | -Newline | -
| Up / Down | -Browse history | -
| Ctrl + l | -Clear display | -
| Ctrl + k | -Reset toplevel | -
| Tab | -Indent code | -
diff --git a/notes.org b/notes.org
new file mode 100644
index 0000000..ae9dfef
--- /dev/null
+++ b/notes.org
@@ -0,0 +1,544 @@
+* Test run with git where it was authorizied
+
+Listening on localhost:8080 and proxying requests via https://gitea.departmentofinter.net.
+>>> Proxy Request:
+n Target:/console/rootstore.git/info/refs?service=git-receive-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 0
+
+
+>>> Proxy Request Body length: 4096
+>>> proxy_response_body chunk: 294
+>>> Response Ok:
+ Code: 200
+ Reason: OK
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=9B1dfE3ibHWnhqKjxmgNjhDWKxs6MTcwNzg4NTQ0Mzc0ODQ5MDMwMQ; Path=/; Expires=Thu, 15 Feb 2024 04:37:23 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=d0e6d2fab0abe4d6; Path=/; HttpOnly; SameSite=Lax
+Pragma: no-cache
+Expires: Fri, 01 Jan 1980 00:00:00 GMT
+Date: Wed, 14 Feb 2024 04:37:24 GMT
+Content-Type: application/x-git-receive-pack-advertisement
+Content-Length: 294
+Cache-Control: no-cache, max-age=0, must-revalidate
+
+
+ >>> Proxy Request:
+ Target:/console/rootstore.git/git-receive-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 464
+
+
+>>> Proxy Request Body length: 464
+>>> proxy_response_body chunk: 116
+>>> Response Ok:
+ Code: 200
+ Reason: OK
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=ojkPfPuEmoUZzTWaBmEdDVhIk246MTcwNzg4NTQ0NTE1Mzc0NDc4OQ; Path=/; Expires=Thu, 15 Feb 2024 04:37:25 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=84bbdd580c4b7420; Path=/; HttpOnly; SameSite=Lax
+Date: Wed, 14 Feb 2024 04:37:25 GMT
+Content-Type: application/x-git-receive-pack-result
+Content-Length: 116
+Cache-Control: no-store, no-transform
+
+
+
+* Test run with page
+
+Listening on localhost:8080 and proxying requests via https://gitea.departmentofinter.net.
+>>> Proxy Request:
+ Target:/console/rootstore.git/info/refs?service=git-upload-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 0
+
+
+>>> Proxy Request Body length: 4096
+>>> proxy_response_body chunk: 493
+>>> Response Ok:
+ Code: 200
+ Reason: OK
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=QSgFph8tFKawVujaLiaMUkCX9ss6MTcwNzg4NTU5OTM3NDQ0MTEzOA; Path=/; Expires=Thu, 15 Feb 2024 04:39:59 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=8523da01c899aa94; Path=/; HttpOnly; SameSite=Lax
+Pragma: no-cache
+Expires: Fri, 01 Jan 1980 00:00:00 GMT
+Date: Wed, 14 Feb 2024 04:39:59 GMT
+Content-Type: application/x-git-upload-pack-advertisement
+Content-Length: 493
+Cache-Control: no-cache, max-age=0, must-revalidate
+
+
+ >>> Proxy Request:
+ Target:/console/rootstore.git/git-upload-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 138
+
+
+>>> Proxy Request Body length: 138
+>>> Response Ok:
+ Code: 401
+ Reason: Unauthorized
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=luUPjvQAbFIg7suxGKPyMCw-5fo6MTcwNzg4NTYwNDE1NTgyMTQzMg; Path=/; Expires=Thu, 15 Feb 2024 04:40:04 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=0ce470d76f806db3; Path=/; HttpOnly; SameSite=Lax
+Date: Wed, 14 Feb 2024 04:40:04 GMT
+Content-Length: 0
+Cache-Control: no-store, no-transform
+
+
+ >>> Proxy Request:
+ Target:/console/rootstore.git/git-upload-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 138
+
+
+>>> Proxy Request Body length: 138
+>>> Response Ok:
+ Code: 401
+ Reason: Unauthorized
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=3YQlQofulzTt1HGj63HWwi_ZUiE6MTcwNzg4NTYwNTE5NzQ3NDE5OA; Path=/; Expires=Thu, 15 Feb 2024 04:40:05 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=9e96683a834cc04e; Path=/; HttpOnly; SameSite=Lax
+Date: Wed, 14 Feb 2024 04:40:05 GMT
+Content-Length: 0
+Cache-Control: no-store, no-transform
+
+
+ >>> Proxy Request:
+ Target:/console/rootstore.git/git-upload-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 138
+
+
+>>> Proxy Request Body length: 138
+>>> Response Ok:
+ Code: 401
+ Reason: Unauthorized
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=diinSAVNEPgvhLYFkvoHo04NZt46MTcwNzg4NTYwNjAxNTEyMzg1NA; Path=/; Expires=Thu, 15 Feb 2024 04:40:06 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=f1eff7cbc8df2543; Path=/; HttpOnly; SameSite=Lax
+Date: Wed, 14 Feb 2024 04:40:06 GMT
+Content-Length: 0
+Cache-Control: no-store, no-transform
+
+
+ >>> Proxy Request:
+ Target:/console/rootstore.git/git-upload-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 138
+
+
+>>> Proxy Request Body length: 138
+>>> Response Ok:
+ Code: 401
+ Reason: Unauthorized
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=PL2iwGpSxbMejEJrRoUw2bp1A1o6MTcwNzg4NTYwNzAzNjA2NzkzOQ; Path=/; Expires=Thu, 15 Feb 2024 04:40:07 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=0312f66d875208a7; Path=/; HttpOnly; SameSite=Lax
+Date: Wed, 14 Feb 2024 04:40:07 GMT
+Content-Length: 0
+Cache-Control: no-store, no-transform
+
+
+ >>> Proxy Request:
+ Target:/console/rootstore.git/git-upload-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 138
+
+
+>>> Proxy Request Body length: 138
+>>> Response Ok:
+ Code: 401
+ Reason: Unauthorized
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=CdyLzLuA0n8vZ7X9VIfg9GeInuY6MTcwNzg4NTYwODI1NDAxODY5NA; Path=/; Expires=Thu, 15 Feb 2024 04:40:08 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=a8c14093c2142f60; Path=/; HttpOnly; SameSite=Lax
+Date: Wed, 14 Feb 2024 04:40:08 GMT
+Content-Length: 0
+Cache-Control: no-store, no-transform
+
+
+ >>> Proxy Request:
+ Target:/console/rootstore.git/git-upload-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 138
+
+
+>>> Proxy Request Body length: 138
+>>> Response Ok:
+ Code: 401
+ Reason: Unauthorized
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=1dyw84Yclz2g2lVJ11gH2mmiXdU6MTcwNzg4NTYwOTgwMDAzNDUzMw; Path=/; Expires=Thu, 15 Feb 2024 04:40:09 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=4737119a3ab3e3bb; Path=/; HttpOnly; SameSite=Lax
+Date: Wed, 14 Feb 2024 04:40:09 GMT
+Content-Length: 0
+Cache-Control: no-store, no-transform
+
+
+ >>> Proxy Request:
+ Target:/console/rootstore.git/git-upload-pack
+Headers:
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-receive-pack-result
+Content-Type: application/x-git-receive-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Host: gitea.departmentofinter.net
+Content-Length: 138
+
+
+>>> Proxy Request Body length: 138
+>>> Response Ok:
+ Code: 401
+ Reason: Unauthorized
+ Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: macaron_flash=; Path=/; Max-Age=0; HttpOnly; SameSite=Lax
+Set-Cookie: _csrf=ywmqqfjlqF7k5H5Oc1UCNYIXW-k6MTcwNzg4NTYxMTYzOTE0NTIyMg; Path=/; Expires=Thu, 15 Feb 2024 04:40:11 GMT; HttpOnly; SameSite=Lax
+Set-Cookie: i_like_gitea=7a5d324cd756e03d; Path=/; HttpOnly; SameSite=Lax
+Date: Wed, 14 Feb 2024 04:40:11 GMT
+Content-Length: 0
+Cache-Control: no-store, no-transform
+
+
+
+* git clone with auth and header passthrough:
+$ git clone http://cqc:d9c2b491e70e31a760ce70bc431036c91325f683@localhost:8080/console/rootstore.git
+
+** proxy output
+
+Listening on localhost:8080 and proxying requests via https://gitea.departmentofinter.net.
+>>> Proxy Request: Target:/console/rootstore.git/info/refs?service=git-upload-pack Headers:
+Git-Protocol: version=2
+Pragma: no-cache
+Accept-Language: en-US, *;q=0.9
+Accept-Encoding: deflate, gzip, br, zstd
+Accept: */*
+User-Agent: git/2.43.0
+Host: gitea.departmentofinter.net
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+>>> Proxy Request Body length: 4096
+>>> proxy_response_body chunk: 188
+>>> Response Ok: Code: 200 Reason: OK Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: _csrf=ZgQc7E7JFWSGDYWav6sgn8MiiUk6MTcwNzkzODY1NjM3Nzk0NDU0MQ; Path=/; Max-Age=86400; HttpOnly; Secure; SameSite=Lax
+Set-Cookie: i_like_gitea=a62763108ab0c487; Path=/; HttpOnly; Secure; SameSite=Lax
+Pragma: no-cache
+Expires: Fri, 01 Jan 1980 00:00:00 GMT
+Date: Wed, 14 Feb 2024 19:24:16 GMT
+Content-Type: application/x-git-upload-pack-advertisement
+Content-Length: 188
+Cache-Control: no-cache, max-age=0, must-revalidate
+>>> Proxy Request: Target:/console/rootstore.git/git-upload-pack Headers:
+Content-Length: 175
+Git-Protocol: version=2
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-upload-pack-result
+Content-Type: application/x-git-upload-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Host: gitea.departmentofinter.net
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+>>> Proxy Request Body length: 175
+>>> proxy_response_body chunk: 213
+>>> Response Ok: Code: 200 Reason: OK Headers:
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: _csrf=7eT7vE683qPwLD-J7frOHX7L5W46MTcwNzkzODY1NzM1MDY3OTkzMw; Path=/; Max-Age=86400; HttpOnly; Secure; SameSite=Lax
+Set-Cookie: i_like_gitea=b6bc4d03cd65fa36; Path=/; HttpOnly; Secure; SameSite=Lax
+Date: Wed, 14 Feb 2024 19:24:17 GMT
+Content-Type: application/x-git-upload-pack-result
+Content-Length: 213
+Cache-Control: max-age=0, private, must-revalidate, no-transform
+>>> Proxy Request: Target:/console/rootstore.git/git-upload-pack Headers:
+Content-Length: 252
+Git-Protocol: version=2
+Accept-Language: en-US, *;q=0.9
+Accept: application/x-git-upload-pack-result
+Content-Type: application/x-git-upload-pack-request
+Accept-Encoding: deflate, gzip, br, zstd
+User-Agent: git/2.43.0
+Host: gitea.departmentofinter.net
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+>>> Proxy Request Body length: 252
+>>> proxy_response_body chunk: 2190
+>>> Response Ok: Code: 200 Reason: OK Headers:
+Transfer-Encoding: chunked
+Connection: close
+X-Frame-Options: SAMEORIGIN
+Set-Cookie: _csrf=7zYyIH5ErnK__EuiA2LfWYhl1Ck6MTcwNzkzODY1ODQ5ODM1NTM5NQ; Path=/; Max-Age=86400; HttpOnly; Secure; SameSite=Lax
+Set-Cookie: i_like_gitea=85c4349ce30af2db; Path=/; HttpOnly; Secure; SameSite=Lax
+Date: Wed, 14 Feb 2024 19:24:18 GMT
+Content-Type: application/x-git-upload-pack-result
+Cache-Control: max-age=0, private, must-revalidate, no-transform
+* page
+** proxy output
+Listening on localhost:8080 and proxying requests via https://gitea.departmentofinter.net.
+>>> Response with File:
+Headers:
+accept-ranges: bytes
+access-control-allow-origin: *
+access-control-allow-headers: Origin, X-Requested-With, Content-Type, Accept, Range
+cache-control: no-cache, no-store, must-revalidate
+etag: W/"6861266-5562-2024-02-11T19:05:04.733Z"
+content-type: text/html; charset=UTF-8
+connection: close
+content-length: 5562
+
+
+ .5562
+done>>> Proxy Request: Target:/_build/default/exported-unit.cmis.js Headers:
+Sec-Fetch-Site: same-origin
+Sec-Fetch-Mode: no-cors
+Sec-Fetch-Dest: script
+Cookie: i_like_gitea=4330f9e9bd8bd263; sessionid-VE347=a4WRuzgo5sDNscftfkoCXA9DVXUsuczK; CSRF-Token-VE347=t9zNXpugSSaH5byHNURnDXgxgLKMSSG6; CSRF-Token-VE347TS=UrWFFVX6Hn2iMc7yPKN6iMRXstxvZLjy; sessionid-VE347TS=x65FJhzkSk5xnz4SsGfZiRhqAvccsjiY; redirect_to=%2Fconsole%2Frootstore.git; _csrf=YmG2q0xEtZeOhjqW--KKWkXxkBI6MTcwNzkzODYwMTU5Mzg5NTAxNQ
+Referer: http://localhost:8080/_build/default/index.html
+Connection: keep-alive
+DNT: 1
+Accept-Encoding: gzip, deflate, br
+Accept-Language: en-US,en;q=0.5
+Accept: */*
+User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:122.0) Gecko/20100101 Firefox/122.0
+Host: gitea.departmentofinter.net
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+>>> Proxy Request Body length: 4096
+>>> Response with File:
+Headers:
+accept-ranges: bytes
+access-control-allow-origin: *
+access-control-allow-headers: Origin, X-Requested-With, Content-Type, Accept, Range
+cache-control: no-cache, no-store, must-revalidate
+etag: W/"6861266-5562-2024-02-11T19:05:04.733Z"
+content-type: text/html; charset=UTF-8
+connection: close
+content-length: 76224847
+
+
+ >>> proxy_response_body chunk: 11
+>>> Response Ok: Code: 404 Reason: Not Found Headers:
+X-Frame-Options: SAMEORIGIN
+X-Content-Type-Options: nosniff
+Date: Wed, 14 Feb 2024 19:25:27 GMT
+Content-Type: text/plain;charset=utf-8
+Content-Length: 11
+Cache-Control: max-age=0, private, must-revalidate, no-transform
+.76224847
+done>>> Proxy Request: Target:/console/rootstore.git/info/refs?service=git-upload-pack Headers:
+Sec-Fetch-Site: same-origin
+Sec-Fetch-Mode: cors
+Sec-Fetch-Dest: empty
+Cookie: i_like_gitea=4330f9e9bd8bd263; sessionid-VE347=a4WRuzgo5sDNscftfkoCXA9DVXUsuczK; CSRF-Token-VE347=t9zNXpugSSaH5byHNURnDXgxgLKMSSG6; CSRF-Token-VE347TS=UrWFFVX6Hn2iMc7yPKN6iMRXstxvZLjy; sessionid-VE347TS=x65FJhzkSk5xnz4SsGfZiRhqAvccsjiY; redirect_to=%2Fconsole%2Frootstore.git; _csrf=YmG2q0xEtZeOhjqW--KKWkXxkBI6MTcwNzkzODYwMTU5Mzg5NTAxNQ
+Referer: http://localhost:8080/_build/default/index.html
+Connection: keep-alive
+DNT: 1
+git-protocol: version=1
+content-type: application/x-git-upload-pack-request, application/x-git-upload-pack-request
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Accept-Encoding: gzip, deflate, br
+Accept-Language: en-US,en;q=0.5
+Accept: application/x-git-upload-pack-result
+User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:122.0) Gecko/20100101 Firefox/122.0
+Host: gitea.departmentofinter.net
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+>>> Proxy Request Body length: 4096
+>>> proxy_response_body chunk: 507
+>>> Response Ok: Code: 200 Reason: OK Headers:
+X-Frame-Options: SAMEORIGIN
+Pragma: no-cache
+Expires: Fri, 01 Jan 1980 00:00:00 GMT
+Date: Wed, 14 Feb 2024 19:25:37 GMT
+Content-Type: application/x-git-upload-pack-advertisement
+Content-Length: 507
+Cache-Control: no-cache, max-age=0, must-revalidate
+>>> Proxy Request: Target:/console/rootstore.git/git-upload-pack Headers:
+Sec-Fetch-Site: same-origin
+Sec-Fetch-Mode: cors
+Sec-Fetch-Dest: empty
+Cookie: i_like_gitea=4330f9e9bd8bd263; sessionid-VE347=a4WRuzgo5sDNscftfkoCXA9DVXUsuczK; CSRF-Token-VE347=t9zNXpugSSaH5byHNURnDXgxgLKMSSG6; CSRF-Token-VE347TS=UrWFFVX6Hn2iMc7yPKN6iMRXstxvZLjy; sessionid-VE347TS=x65FJhzkSk5xnz4SsGfZiRhqAvccsjiY; redirect_to=%2Fconsole%2Frootstore.git; _csrf=YmG2q0xEtZeOhjqW--KKWkXxkBI6MTcwNzkzODYwMTU5Mzg5NTAxNQ
+Referer: http://localhost:8080/_build/default/index.html
+Connection: keep-alive
+DNT: 1
+origin: https://gitea.departmentofinter.net
+Content-Length: 138
+git-protocol: version=1
+content-type: application/x-git-upload-pack-request, application/x-git-upload-pack-request
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Accept-Encoding: gzip, deflate, br
+Accept-Language: en-US,en;q=0.5
+Accept: application/x-git-upload-pack-result
+User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:122.0) Gecko/20100101 Firefox/122.0
+Host: gitea.departmentofinter.net
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+>>> Proxy Request Body length: 138
+>>> Response Ok: Code: 401 Reason: Unauthorized Headers:
+X-Frame-Options: SAMEORIGIN
+Date: Wed, 14 Feb 2024 19:25:41 GMT
+Content-Length: 0
+Cache-Control: max-age=0, private, must-revalidate, no-transform
+>>> Proxy Request: Target:/console/rootstore.git/git-upload-pack Headers:
+Sec-Fetch-Site: same-origin
+Sec-Fetch-Mode: cors
+Sec-Fetch-Dest: empty
+Cookie: i_like_gitea=4330f9e9bd8bd263; sessionid-VE347=a4WRuzgo5sDNscftfkoCXA9DVXUsuczK; CSRF-Token-VE347=t9zNXpugSSaH5byHNURnDXgxgLKMSSG6; CSRF-Token-VE347TS=UrWFFVX6Hn2iMc7yPKN6iMRXstxvZLjy; sessionid-VE347TS=x65FJhzkSk5xnz4SsGfZiRhqAvccsjiY; redirect_to=%2Fconsole%2Frootstore.git; _csrf=YmG2q0xEtZeOhjqW--KKWkXxkBI6MTcwNzkzODYwMTU5Mzg5NTAxNQ
+Referer: http://localhost:8080/_build/default/index.html
+Connection: keep-alive
+DNT: 1
+origin: https://gitea.departmentofinter.net
+Content-Length: 138
+git-protocol: version=1
+content-type: application/x-git-upload-pack-request, application/x-git-upload-pack-request
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Accept-Encoding: gzip, deflate, br
+Accept-Language: en-US,en;q=0.5
+Accept: application/x-git-upload-pack-result
+User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:122.0) Gecko/20100101 Firefox/122.0
+Host: gitea.departmentofinter.net
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+>>> Proxy Request Body length: 138
+>>> Response Ok: Code: 401 Reason: Unauthorized Headers:
+X-Frame-Options: SAMEORIGIN
+Date: Wed, 14 Feb 2024 19:25:43 GMT
+Content-Length: 0
+Cache-Control: max-age=0, private, must-revalidate, no-transform
+>>> Proxy Request: Target:/console/rootstore.git/git-upload-pack Headers:
+Sec-Fetch-Site: same-origin
+Sec-Fetch-Mode: cors
+Sec-Fetch-Dest: empty
+Cookie: i_like_gitea=4330f9e9bd8bd263; sessionid-VE347=a4WRuzgo5sDNscftfkoCXA9DVXUsuczK; CSRF-Token-VE347=t9zNXpugSSaH5byHNURnDXgxgLKMSSG6; CSRF-Token-VE347TS=UrWFFVX6Hn2iMc7yPKN6iMRXstxvZLjy; sessionid-VE347TS=x65FJhzkSk5xnz4SsGfZiRhqAvccsjiY; redirect_to=%2Fconsole%2Frootstore.git; _csrf=YmG2q0xEtZeOhjqW--KKWkXxkBI6MTcwNzkzODYwMTU5Mzg5NTAxNQ
+Referer: http://localhost:8080/_build/default/index.html
+Connection: keep-alive
+DNT: 1
+origin: https://gitea.departmentofinter.net
+Content-Length: 138
+git-protocol: version=1
+content-type: application/x-git-upload-pack-request, application/x-git-upload-pack-request
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Accept-Encoding: gzip, deflate, br
+Accept-Language: en-US,en;q=0.5
+Accept: application/x-git-upload-pack-result
+User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:122.0) Gecko/20100101 Firefox/122.0
+Host: gitea.departmentofinter.net
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+>>> Proxy Request Body length: 138
+>>> Response Ok: Code: 401 Reason: Unauthorized Headers:
+X-Frame-Options: SAMEORIGIN
+Date: Wed, 14 Feb 2024 19:25:44 GMT
+Content-Length: 0
+Cache-Control: max-age=0, private, must-revalidate, no-transform
+>>> Proxy Request: Target:/console/rootstore.git/git-upload-pack Headers:
+Sec-Fetch-Site: same-origin
+Sec-Fetch-Mode: cors
+Sec-Fetch-Dest: empty
+Cookie: i_like_gitea=4330f9e9bd8bd263; sessionid-VE347=a4WRuzgo5sDNscftfkoCXA9DVXUsuczK; CSRF-Token-VE347=t9zNXpugSSaH5byHNURnDXgxgLKMSSG6; CSRF-Token-VE347TS=UrWFFVX6Hn2iMc7yPKN6iMRXstxvZLjy; sessionid-VE347TS=x65FJhzkSk5xnz4SsGfZiRhqAvccsjiY; redirect_to=%2Fconsole%2Frootstore.git; _csrf=YmG2q0xEtZeOhjqW--KKWkXxkBI6MTcwNzkzODYwMTU5Mzg5NTAxNQ
+Referer: http://localhost:8080/_build/default/index.html
+Connection: keep-alive
+DNT: 1
+origin: https://gitea.departmentofinter.net
+Content-Length: 138
+git-protocol: version=1
+content-type: application/x-git-upload-pack-request, application/x-git-upload-pack-request
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+Accept-Encoding: gzip, deflate, br
+Accept-Language: en-US,en;q=0.5
+Accept: application/x-git-upload-pack-result
+User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:122.0) Gecko/20100101 Firefox/122.0
+Host: gitea.departmentofinter.net
+Authorization: Basic Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=
+>>> Proxy Request Body length: 138
+ C-c C-c
+[cqc@fynn oplevel]$
diff --git a/ocp_indent.fake.ml b/ocp_indent.fake.ml
deleted file mode 100644
index e598dbd..0000000
--- a/ocp_indent.fake.ml
+++ /dev/null
@@ -1,3 +0,0 @@
-let indent s _in_lines = s
-
-(* ocp-indent not available *)
diff --git a/ocp_indent.ok.ml b/ocp_indent.ml
similarity index 100%
rename from ocp_indent.ok.ml
rename to ocp_indent.ml
diff --git a/oplevel.ml b/oplevel.ml
new file mode 100644
index 0000000..1c5e86b
--- /dev/null
+++ b/oplevel.ml
@@ -0,0 +1,68 @@
+open Js_of_ocaml
+open Js_of_ocaml_tyxml
+open Lwt
+open Store
+
+let by_id s = Dom_html.getElementById s
+
+let by_id_coerce s f =
+ Js.Opt.get
+ (f (Dom_html.getElementById s))
+ (fun () -> raise Not_found)
+
+let do_by_id s f =
+ try f (Dom_html.getElementById s) with Not_found -> ()
+
+let resize ~container ~textbox () =
+ Lwt.pause () >>= fun () ->
+ textbox##.style##.height := Js.string "auto";
+ textbox##.style##.height
+ := Js.string (Printf.sprintf "%dpx" (max 18 textbox##.scrollHeight));
+ container##.scrollTop := container##.scrollHeight;
+ Lwt.return ()
+
+let setup_storeview ~container ~textbox ~(storeview : Store.t Lwt.t) :
+ unit =
+ let storeview_container = by_id "toplevel-storeview" in
+ Lwt.async (fun _ ->
+ storeview >>= fun storeview ->
+ Firebug.console##log "setup_storeview";
+
+ Store.S.Tree.list storeview [] >>= fun all ->
+ ignore
+ (List.fold_left
+ (fun acc tok ->
+ match tok with
+ | step, _tree ->
+ let a =
+ Tyxml_js.Html.(
+ a
+ ~a:
+ [
+ a_class [ "list-group-item" ];
+ a_onclick (fun _ ->
+ textbox##.value :=
+ (Js.string acc)##trim;
+ Lwt.async (fun () ->
+ resize ~container ~textbox ()
+ >>= fun () ->
+ textbox##focus;
+ Lwt.return_unit);
+ true);
+ ]
+ [ txt step ])
+ in
+ Dom.appendChild storeview_container
+ (Tyxml_js.To_dom.of_a a);
+ "")
+ "" all);
+ Lwt.return_unit)
+
+let _ =
+ Dom_html.window##.onload
+ := Dom_html.handler (fun _ ->
+ Toplevel.run
+ (setup_storeview ~storeview:(Store.test_pull ()))
+ ();
+
+ Js._false)
diff --git a/ppx_support.disabled.ml b/ppx_support.disabled.ml
deleted file mode 100644
index 485f5bc..0000000
--- a/ppx_support.disabled.ml
+++ /dev/null
@@ -1 +0,0 @@
-let init () = ()
diff --git a/ppx_support.enabled.ml b/ppx_support.ml
similarity index 100%
rename from ppx_support.enabled.ml
rename to ppx_support.ml
diff --git a/store.ml b/store.ml
new file mode 100644
index 0000000..8d4f8e1
--- /dev/null
+++ b/store.ml
@@ -0,0 +1,382 @@
+open Js_of_ocaml
+open Lwt.Infix
+module F = Fmt
+module Cohttp_backend = Cohttp_lwt_jsoo
+
+module Git_af = struct
+ open Lwt.Infix
+
+ type error = |
+
+ let git_af_scheme : [ `HTTP | `HTTPS ] Mimic.value =
+ Mimic.make ~name:"git-af-scheme"
+
+ let git_af_port : int Mimic.value = Mimic.make ~name:"git-af-port"
+
+ let git_af_hostname : string Mimic.value =
+ Mimic.make ~name:"git-af-hostname"
+
+ let pp_error : error Fmt.t = fun _ppf -> function _ -> .
+
+ let with_redirects ?(max = 10) ~f uri =
+ if max < 10 then invalid_arg "with_redirects";
+ let tbl = Hashtbl.create 0x10 in
+ let rec go max uri =
+ f uri >>= fun (resp, body) ->
+ let status_code =
+ Cohttp.(Response.status resp |> Code.code_of_status)
+ in
+ if Cohttp.Code.is_redirection status_code then
+ match
+ Cohttp.(Response.headers resp |> Header.get_location)
+ with
+ | Some uri' when Hashtbl.mem tbl uri' || max = 0 ->
+ Lwt.return (resp, body)
+ | Some uri' ->
+ Hashtbl.add tbl uri' ();
+ Cohttp_lwt.Body.drain_body body >>= fun () ->
+ go (pred max) uri'
+ | None -> Lwt.return (resp, body)
+ else Lwt.return (resp, body)
+ in
+ go max uri
+
+ let get ~ctx:_ ?(headers = []) uri =
+ Firebug.console##log (Js.string "Git_Cohttp_console.get()\n");
+ let headers = Cohttp.Header.of_list headers in
+ let f uri = Cohttp_backend.Client.get ~headers uri in
+ with_redirects ~f uri >>= fun (_resp, body) ->
+ Cohttp_lwt.Body.to_string body >>= fun body ->
+ Lwt.return_ok ((), body)
+
+ let post ~ctx:_ ?(headers = []) uri body =
+ let headers = Cohttp.Header.of_list headers in
+ let body = Cohttp_lwt.Body.of_string body in
+ let f uri =
+ Cohttp_backend.Client.post ~headers ~chunked:false ~body uri
+ in
+ with_redirects ~f uri >>= fun (_resp, body) ->
+ Cohttp_lwt.Body.to_string body >>= fun body ->
+ Lwt.return_ok ((), body)
+end
+
+module Git_console_http = struct
+ open Lwt.Infix
+
+ let context ctx =
+ (* HTTP *)
+ let edn = Mimic.make ~name:"af-http-endpoint" in
+ let k1 git_af_scheme git_af_hostname git_af_port =
+ match git_af_scheme with
+ | `HTTP -> Lwt.return_some (git_af_hostname, git_af_port)
+ | _ -> Lwt.return_none
+ in
+ let ctx =
+ Mimic.fold edn
+ Mimic.Fun.
+ [
+ req Git_af.git_af_scheme;
+ req Git_af.git_af_hostname;
+ dft Git_af.git_af_port 80;
+ ]
+ ~k:k1 ctx
+ in
+
+ (* HTTPS *)
+ let edn = Mimic.make ~name:"af-https-endpoint" in
+ let k1 git_af_scheme git_af_hostname git_af_port =
+ match git_af_scheme with
+ | `HTTPS -> Lwt.return_some (git_af_hostname, git_af_port)
+ | _ -> Lwt.return_none
+ in
+
+ let ctx =
+ Mimic.fold edn
+ Mimic.Fun.
+ [
+ req Git_af.git_af_scheme;
+ req Git_af.git_af_hostname;
+ dft Git_af.git_af_port 443;
+ ]
+ ~k:k1 ctx
+ in
+
+ ctx
+
+ module HTTP = struct
+ type state =
+ | Handshake
+ | Get of {
+ advertised_refs : string;
+ uri : Uri.t;
+ headers : (string * string) list;
+ ctx : Mimic.ctx;
+ }
+ | Post of {
+ mutable output : string;
+ uri : Uri.t;
+ headers : (string * string) list;
+ ctx : Mimic.ctx;
+ }
+ | Error
+
+ type flow = { endpoint : Uri.t; mutable state : state }
+ type error = [ `Msg of string ]
+ type write_error = [ `Closed | `Msg of string ]
+
+ let pp_error ppf (`Msg err) = Fmt.string ppf err
+
+ let pp_write_error ppf = function
+ | `Closed -> Fmt.string ppf "Connection closed by peer"
+ | `Msg err -> Fmt.string ppf err
+
+ let write t cs =
+ match t.state with
+ | Handshake | Get _ ->
+ Lwt.return_error (`Msg "Handshake has not been done")
+ | Error -> Lwt.return_error (`Msg "Handshake got an error")
+ | Post ({ output; _ } as v) ->
+ let output = output ^ Cstruct.to_string cs in
+ v.output <- output;
+ Lwt.return_ok ()
+
+ let writev t css =
+ let rec go = function
+ | [] -> Lwt.return_ok ()
+ | x :: r -> (
+ write t x >>= function
+ | Ok () -> go r
+ | Error _ as err -> Lwt.return err)
+ in
+ go css
+
+ let read t =
+ match t.state with
+ | Handshake ->
+ Lwt.return_error (`Msg "Handshake has not been done")
+ | Error -> Lwt.return_error (`Msg "Handshake got an error")
+ | Get { advertised_refs; uri; headers; ctx } ->
+ t.state <- Post { output = ""; uri; headers; ctx };
+ Lwt.return_ok (`Data (Cstruct.of_string advertised_refs))
+ | Post { output; uri; headers; ctx } -> (
+ Git_af.post ~ctx ~headers uri output >>= function
+ | Ok (_resp, contents) ->
+ Lwt.return_ok (`Data (Cstruct.of_string contents))
+ | Error err ->
+ Lwt.return_error
+ (`Msg (Fmt.str "%a" Git_af.pp_error err)))
+
+ let close _ = Lwt.return_unit
+
+ type endpoint = Uri.t
+
+ let connect endpoint =
+ Firebug.console##log
+ (Js.string "Git_Console_http.HTTP.connect()\n");
+ Lwt.return_ok { endpoint; state = Handshake }
+ end
+
+ let http_endpoint, http_protocol =
+ Mimic.register ~name:"http" (module HTTP)
+
+ let connect (ctx : Mimic.ctx) =
+ Firebug.console##log (Js.string "Git_Console_http.connect()\n");
+ let module T = (val Mimic.repr http_protocol) in
+ let edn = Mimic.make ~name:"http-endpoint" in
+ let k0 uri = Lwt.return_some uri in
+ let k1 git_transmission git_scheme =
+ match (git_transmission, git_scheme) with
+ | `HTTP (uri, _), (`HTTP | `HTTPS) -> Lwt.return_some uri
+ | _ -> Lwt.return_none
+ in
+ let k2 git_scheme git_uri git_http_headers =
+ match git_scheme with
+ | `Git | `SSH | `Scheme _ -> Lwt.return_none
+ | `HTTP | `HTTPS ->
+ let headers =
+ ("content-type", "application/x-git-upload-pack-request")
+ :: git_http_headers
+ in
+ let handshake ~uri0 ~uri1 = function
+ | T.T flow -> (
+ Firebug.console##log
+ (Js.string
+ (F.str
+ "Git_Console_http.connect.k2.handshake \
+ uri0='%s' uri1='%s'\n"
+ (Uri.to_string uri0) (Uri.to_string uri1)));
+ let ctx = context Mimic.empty in
+ Git_af.get ~ctx ~headers uri0 >>= function
+ | Ok (_resp, advertised_refs) ->
+ flow.state <-
+ HTTP.Get
+ { advertised_refs; uri = uri1; headers; ctx };
+ Lwt.return_unit
+ | Error _ ->
+ flow.state <- Error;
+ Lwt.return_unit)
+ | _ -> Lwt.return_unit
+ in
+ let git_transmission = `HTTP (git_uri, handshake) in
+ Lwt.return_some git_transmission
+ in
+ let ctx =
+ Mimic.fold http_endpoint Mimic.Fun.[ req edn ] ~k:k0 ctx
+ in
+ let ctx =
+ Mimic.fold edn
+ Mimic.Fun.
+ [ req Smart_git.git_transmission; req Smart_git.git_scheme ]
+ ~k:k1 ctx
+ in
+ let ctx =
+ Mimic.fold Smart_git.git_transmission
+ Mimic.Fun.
+ [
+ req Smart_git.git_scheme;
+ req Smart_git.git_uri;
+ dft Smart_git.git_http_headers List.[];
+ ]
+ ~k:k2 ctx
+ in
+ Lwt.return ctx
+end
+
+module Config = struct
+ open Irmin.Backend.Conf
+
+ let spec = Spec.v "console_js_git"
+
+ module Key = struct
+ let reference : Git.Reference.t Irmin.Type.t =
+ let of_string str =
+ Git.Reference.of_string str |> Result.get_ok
+ in
+ let to_string r = Git.Reference.to_string r in
+ Irmin.Type.(map string) of_string to_string
+
+ let head =
+ key ~spec ~doc:"The main branch of the Git repository." "head"
+ Irmin.Type.(option reference)
+ None
+
+ let bare =
+ key ~spec ~doc:"Do not expand the filesystem on the disk."
+ "bare" Irmin.Type.bool false
+
+ let level =
+ key ~spec ~doc:"The Zlib compression level." "level"
+ Irmin.Type.(option int)
+ None
+
+ let buffers =
+ key ~spec ~doc:"The number of 4K pre-allocated buffers."
+ "buffers"
+ Irmin.Type.(option int)
+ None
+ end
+
+ let init ?head ?level ?buffers _root =
+ let module C = Irmin.Backend.Conf in
+ let config = C.empty spec in
+
+ let config = C.add config Key.head head in
+ let config = C.add config Key.level level in
+ let config = C.add config Key.buffers buffers in
+ C.verify config
+end
+
+module S = struct
+ module Schema =
+ Irmin_git.Schema.Make (Git.Mem.Store) (Irmin.Contents.String)
+ (Irmin_git.Branch.Make (Irmin.Branch.String))
+
+ module Sync' = struct
+ module GitMemSync = Git.Mem.Sync (Git.Mem.Store)
+ include GitMemSync
+ (* This is where the fetch and push are broken *)
+ end
+
+ module SMaker = Irmin_git.Maker (Git.Mem.Store) (Sync')
+ module SMade = SMaker.Make (Schema)
+ include SMade
+
+ type endpoint = Mimic.ctx * Smart_git.Endpoint.t
+
+ let remote ?(ctx = Mimic.empty) ?headers uri =
+ E
+ (Firebug.console##log
+ (Js.string (F.str "Nav.S.remote(uri=%s)\n" uri));
+ let ( ! ) f a b = f b a in
+ match Smart_git.Endpoint.of_string uri with
+ | Ok edn ->
+ let edn =
+ Option.fold ~none:edn
+ ~some:(!Smart_git.Endpoint.with_headers_if_http edn)
+ headers
+ in
+ Firebug.console##log
+ (Js.string "Nav.S.remote() = (ctx, edn) \n");
+ (ctx, edn)
+ | Error (`Msg err) -> Fmt.invalid_arg "remote: %s" err)
+
+ module Backend = struct
+ include Backend
+ module R = Remote
+
+ module Remote = struct
+ include R
+
+ type endpoint = Mimic.ctx * Smart_git.Endpoint.t
+
+ let ctx e = fst e
+ let edn e = snd e
+
+ let fetch t ?depth endpoint branch =
+ Firebug.console##log
+ (Js.string "S.Backend.Remote.wrapped_fetch()\n");
+ R.fetch t ?depth endpoint branch
+ end
+ end
+end
+
+module Sync = Irmin.Sync.Make (S)
+
+type t = S.tree
+type tree = t
+type step = S.step
+type path = step list
+
+let init () = S.Repo.v (Irmin_mem.config ()) >>= S.main >>= S.tree
+
+let test_populate () : t Lwt.t =
+ let add p s t = S.Tree.add t p s in
+ add [ "hello" ] "world" (S.Tree.empty ())
+ >>= add [ "hello"; "daddy" ] "ily"
+ >>= add [ "beep"; "beep" ] "motherfucker"
+
+let test_pull () : t Lwt.t =
+ (* test_populate ()*)
+ Firebug.console##log (Js.string "Nav.test_pull()\n");
+ S.Repo.v (Config.init "") >>= fun repo ->
+ Firebug.console##log (Js.string "Nav.test_pull(2)\n");
+ S.of_branch repo "current" >>= fun t ->
+ Firebug.console##log (Js.string "Nav.test_pull(3)\n");
+ Git_console_http.connect Mimic.empty >>= fun ctx ->
+ Firebug.console##log (Js.string "Nav.test_pull(4)\n");
+ let upstream =
+ S.remote ~ctx
+ ~headers:
+ [
+ ( "Authorization",
+ "Basic \
+ Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM="
+ );
+ ]
+ "http://localhost:8080/console/rootstore.git"
+ in
+ Firebug.console##log (Js.string "Nav.test_pull(5)\n");
+ Sync.pull_exn t upstream `Set >>= fun _ ->
+ Firebug.console##log (Js.string "Nav.test_pull(6)\n");
+ S.tree t
+(* irmin/src/irmin/sync.ml: calls S.Remote.Backend.fetch *)
diff --git a/toplevel.ml b/toplevel.ml
index 0999f2e..d5c1e37 100644
--- a/toplevel.ml
+++ b/toplevel.ml
@@ -23,27 +23,30 @@ open Js_of_ocaml_lwt
open Js_of_ocaml_tyxml
open Js_of_ocaml_toplevel
open Lwt
+open Store
let compiler_name = "OCaml"
-
let by_id s = Dom_html.getElementById s
let by_id_coerce s f =
- Js.Opt.get (f (Dom_html.getElementById s)) (fun () -> raise Not_found)
+ Js.Opt.get
+ (f (Dom_html.getElementById s))
+ (fun () -> raise Not_found)
-let do_by_id s f = try f (Dom_html.getElementById s) with Not_found -> ()
+let do_by_id s f =
+ try f (Dom_html.getElementById s) with Not_found -> ()
(* load file using a synchronous XMLHttpRequest *)
let load_resource_aux filename url =
- Js_of_ocaml_lwt.XmlHttpRequest.perform_raw ~response_type:XmlHttpRequest.ArrayBuffer url
+ Js_of_ocaml_lwt.XmlHttpRequest.perform_raw
+ ~response_type:XmlHttpRequest.ArrayBuffer url
>|= fun frame ->
- if frame.Js_of_ocaml_lwt.XmlHttpRequest.code = 200
- then
- Js.Opt.case
- frame.Js_of_ocaml_lwt.XmlHttpRequest.content
+ if frame.Js_of_ocaml_lwt.XmlHttpRequest.code = 200 then
+ Js.Opt.case frame.Js_of_ocaml_lwt.XmlHttpRequest.content
(fun () -> Printf.eprintf "Could not load %s\n" filename)
(fun b ->
- Sys_js.update_file ~name:filename ~content:(Typed_array.String.of_arrayBuffer b))
+ Sys_js.update_file ~name:filename
+ ~content:(Typed_array.String.of_arrayBuffer b))
else ()
let load_resource scheme ~prefix ~path:suffix =
@@ -57,7 +60,8 @@ let setup_pseudo_fs ~load_cmis_from_server =
Sys_js.mount ~path:"/http/" (load_resource "http://");
Sys_js.mount ~path:"/https/" (load_resource "https://");
Sys_js.mount ~path:"/ftp/" (load_resource "ftp://");
- if load_cmis_from_server then Sys_js.mount ~path:"/home/" (load_resource "filesys/")
+ if load_cmis_from_server then
+ Sys_js.mount ~path:"/home/" (load_resource "filesys/")
let exec' s =
let res : bool = JsooTop.use Format.std_formatter s in
@@ -69,10 +73,10 @@ module Version = struct
let split_char ~sep p =
let len = String.length p in
let rec split beg cur =
- if cur >= len
- then if cur - beg > 0 then [ String.sub p beg (cur - beg) ] else []
- else if sep p.[cur]
- then String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
+ if cur >= len then
+ if cur - beg > 0 then [ String.sub p beg (cur - beg) ] else []
+ else if sep p.[cur] then
+ String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
else split beg (cur + 1)
in
split 0 0
@@ -80,68 +84,67 @@ module Version = struct
let split v =
match
split_char
- ~sep:(function
- | '+' | '-' | '~' -> true
- | _ -> false)
+ ~sep:(function '+' | '-' | '~' -> true | _ -> false)
v
with
| [] -> assert false
| x :: _ ->
- List.map
- int_of_string
- (split_char
- ~sep:(function
- | '.' -> true
- | _ -> false)
- x)
+ List.map int_of_string
+ (split_char ~sep:(function '.' -> true | _ -> false) x)
let current : t = split Sys.ocaml_version
-
let compint (a : int) b = compare a b
let rec compare v v' =
- match v, v' with
+ match (v, v') with
| [ x ], [ y ] -> compint x y
| [], [] -> 0
| [], y :: _ -> compint 0 y
| x :: _, [] -> compint x 0
| x :: xs, y :: ys -> (
- match compint x y with
- | 0 -> compare xs ys
- | n -> n)
+ match compint x y with 0 -> compare xs ys | n -> n)
end
let setup_toplevel () =
Clflags.debug := true;
JsooTop.initialize ();
Sys.interactive := false;
- if Version.compare Version.current [ 4; 07 ] >= 0 then exec' "open Stdlib";
+ if Version.compare Version.current [ 4; 07 ] >= 0 then
+ exec' "open Stdlib";
exec'
"module Lwt_main = struct\n\
\ let run t = match Lwt.state t with\n\
\ | Lwt.Return x -> x\n\
\ | Lwt.Fail e -> raise e\n\
- \ | Lwt.Sleep -> failwith \"Lwt_main.run: thread didn't return\"\n\
+ \ | Lwt.Sleep -> failwith \"Lwt_main.run: thread didn't \
+ return\"\n\
\ end";
- let header1 = Printf.sprintf " %s version %%s" compiler_name in
- let header2 =
- Printf.sprintf " Compiled with Js_of_ocaml version %s" Sys_js.js_of_ocaml_version
+ let header1 =
+ Printf.sprintf " %s version %%s" compiler_name
in
- exec' (Printf.sprintf "Format.printf \"%s@.\" Sys.ocaml_version;;" header1);
+ let header2 =
+ Printf.sprintf " Compiled with Js_of_ocaml version %s"
+ Sys_js.js_of_ocaml_version
+ in
+ exec'
+ (Printf.sprintf "Format.printf \"%s@.\" Sys.ocaml_version;;"
+ header1);
exec' (Printf.sprintf "Format.printf \"%s@.\";;" header2);
exec' "#enable \"pretty\";;";
exec' "#disable \"shortvar\";;";
Ppx_support.init ();
- Toploop.add_directive
- "load_js"
- (Toploop.Directive_string (fun name -> Js.Unsafe.global##load_script_ name))
- { section = "js_of_ocaml-toplevel-example"; doc = "Load the given javascript file" };
+ Toploop.add_directive "load_js"
+ (Toploop.Directive_string
+ (fun name -> Js.Unsafe.global##load_script_ name))
+ {
+ section = "js_of_ocaml-toplevel-example";
+ doc = "Load the given javascript file";
+ };
Sys.interactive := true;
()
let resize ~container ~textbox () =
- Lwt.pause ()
- >>= fun () ->
+ Lwt.pause () >>= fun () ->
textbox##.style##.height := Js.string "auto";
textbox##.style##.height
:= Js.string (Printf.sprintf "%dpx" (max 18 textbox##.scrollHeight));
@@ -150,11 +153,15 @@ let resize ~container ~textbox () =
let setup_printers () =
exec'
- "let _print_error fmt e = Format.pp_print_string fmt (Js_of_ocaml.Js_error.to_string \
- e)";
- Topdirs.dir_install_printer Format.std_formatter Longident.(Lident "_print_error");
- exec' "let _print_unit fmt (_ : 'a) : 'a = Format.pp_print_string fmt \"()\"";
- Topdirs.dir_install_printer Format.std_formatter Longident.(Lident "_print_unit")
+ "let _print_error fmt e = Format.pp_print_string fmt \
+ (Js_of_ocaml.Js_error.to_string e)";
+ Topdirs.dir_install_printer Format.std_formatter
+ Longident.(Lident "_print_error");
+ exec'
+ "let _print_unit fmt (_ : 'a) : 'a = Format.pp_print_string fmt \
+ \"()\"";
+ Topdirs.dir_install_printer Format.std_formatter
+ Longident.(Lident "_print_unit")
let setup_examples ~container ~textbox =
let r = Regexp.regexp "^\\(\\*+(.*)\\*+\\)$" in
@@ -186,22 +193,22 @@ let setup_examples ~container ~textbox =
Tyxml_js.Html.(
a
~a:
- [ a_class [ "list-group-item" ]
- ; a_onclick (fun _ ->
+ [
+ a_class [ "list-group-item" ];
+ a_onclick (fun _ ->
textbox##.value := (Js.string acc)##trim;
Lwt.async (fun () ->
resize ~container ~textbox ()
>>= fun () ->
textbox##focus;
Lwt.return_unit);
- true)
+ true);
]
[ txt name ])
in
Dom.appendChild example_container (Tyxml_js.To_dom.of_a a);
"")
- ""
- !all
+ "" !all
in
()
@@ -213,7 +220,8 @@ let parse_hash () =
let rec iter_on_sharp ~f x =
Js.Opt.iter (Dom_html.CoerceTo.element x) (fun e ->
- if Js.to_bool (e##.classList##contains (Js.string "sharp")) then f e);
+ if Js.to_bool (e##.classList##contains (Js.string "sharp")) then
+ f e);
match Js.Opt.to_option x##.nextSibling with
| None -> ()
| Some n -> iter_on_sharp ~f n
@@ -225,44 +233,59 @@ let setup_share_button ~output =
Dom_html.handler (fun _ ->
(* get all ocaml code *)
let code = ref [] in
- Js.Opt.iter
- output##.firstChild
+ Js.Opt.iter output##.firstChild
(iter_on_sharp ~f:(fun e ->
code :=
- Js.Opt.case e##.textContent (fun () -> "") Js.to_string :: !code));
- let code_encoded = B64.encode (String.concat "" (List.rev !code)) in
+ Js.Opt.case e##.textContent
+ (fun () -> "")
+ Js.to_string
+ :: !code));
+ let code_encoded =
+ B64.encode (String.concat "" (List.rev !code))
+ in
let url, is_file =
match Url.Current.get () with
- | Some (Url.Http url) -> Url.Http { url with Url.hu_fragment = "" }, false
- | Some (Url.Https url) -> Url.Https { url with Url.hu_fragment = "" }, false
- | Some (Url.File url) -> Url.File { url with Url.fu_fragment = "" }, true
+ | Some (Url.Http url) ->
+ (Url.Http { url with Url.hu_fragment = "" }, false)
+ | Some (Url.Https url) ->
+ (Url.Https { url with Url.hu_fragment = "" }, false)
+ | Some (Url.File url) ->
+ (Url.File { url with Url.fu_fragment = "" }, true)
| _ -> assert false
in
let frag =
let frags = parse_hash () in
- let frags = List.remove_assoc "code" frags @ [ "code", code_encoded ] in
+ let frags =
+ List.remove_assoc "code" frags
+ @ [ ("code", code_encoded) ]
+ in
Url.encode_arguments frags
in
let uri = Url.string_of_url url ^ "#" ^ frag in
let append_url str =
let dom =
Tyxml_js.Html.(
- p [ txt "Share this url : "; a ~a:[ a_href str ] [ txt str ] ])
+ p
+ [
+ txt "Share this url : ";
+ a ~a:[ a_href str ] [ txt str ];
+ ])
in
Dom.appendChild output (Tyxml_js.To_dom.of_element dom)
in
Lwt.async (fun () ->
Lwt.catch
(fun () ->
- if is_file
- then failwith "Cannot shorten url with file scheme"
+ if is_file then
+ failwith "Cannot shorten url with file scheme"
else
let uri =
Printf.sprintf
"http://is.gd/create.php?format=json&url=%s"
(Url.urlencode uri)
in
- Lwt.bind (Js_of_ocaml_lwt.Jsonp.call uri) (fun o ->
+ Lwt.bind (Js_of_ocaml_lwt.Jsonp.call uri)
+ (fun o ->
let str = Js.to_string o##.shorturl in
append_url str;
Lwt.return_unit))
@@ -277,8 +300,7 @@ let setup_share_button ~output =
let setup_js_preview () =
let ph = by_id "last-js" in
let runcode : string -> 'a = Js.Unsafe.global##.toplevelEval in
- Js.Unsafe.global##.toplevelEval
- := fun bc ->
+ Js.Unsafe.global##.toplevelEval := fun bc ->
ph##.innerHTML := Js.string bc;
runcode bc
@@ -288,24 +310,29 @@ let highlight_location loc =
let x = ref 0 in
let output = by_id "output" in
let first =
- Js.Opt.get (output##.childNodes##item !current_position) (fun _ -> assert false)
+ Js.Opt.get
+ (output##.childNodes##item !current_position)
+ (fun _ -> assert false)
in
iter_on_sharp first ~f:(fun e ->
incr x;
- let _file1, line1, col1 = Location.get_pos_info loc.Location.loc_start in
- let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in
- if !x >= line1 && !x <= line2
- then
+ let _file1, line1, col1 =
+ Location.get_pos_info loc.Location.loc_start
+ in
+ let _file2, line2, col2 =
+ Location.get_pos_info loc.Location.loc_end
+ in
+ if !x >= line1 && !x <= line2 then
let from_ = if !x = line1 then `Pos col1 else `Pos 0 in
let to_ = if !x = line2 then `Pos col2 else `Last in
Colorize.highlight from_ to_ e)
let append colorize output cl s =
- Dom.appendChild output (Tyxml_js.To_dom.of_element (colorize ~a_class:cl s))
+ Dom.appendChild output
+ (Tyxml_js.To_dom.of_element (colorize ~a_class:cl s))
module History = struct
let data = ref [| "" |]
-
let idx = ref 0
let get_storage () =
@@ -341,41 +368,48 @@ module History = struct
let current text = !data.(!idx) <- text
let previous textbox =
- if !idx > 0
- then (
+ if !idx > 0 then (
decr idx;
textbox##.value := Js.string !data.(!idx))
let next textbox =
- if !idx < Array.length !data - 1
- then (
+ if !idx < Array.length !data - 1 then (
incr idx;
textbox##.value := Js.string !data.(!idx))
end
-let run _ =
+let run setup_storeview () =
+ Firebug.console##log "run";
+
let container = by_id "toplevel-container" in
let output = by_id "output" in
- let textbox : 'a Js.t = by_id_coerce "userinput" Dom_html.CoerceTo.textarea in
+ let textbox : 'a Js.t =
+ by_id_coerce "userinput" Dom_html.CoerceTo.textarea
+ in
let sharp_chan = open_out "/dev/null0" in
let sharp_ppf = Format.formatter_of_out_channel sharp_chan in
let caml_chan = open_out "/dev/null1" in
let caml_ppf = Format.formatter_of_out_channel caml_chan in
+ Firebug.console##log "run(Store.test_pull)";
let execute () =
let content = Js.to_string textbox##.value##trim in
let content' =
let len = String.length content in
- if try content <> "" && content.[len - 1] <> ';' && content.[len - 2] <> ';'
- with _ -> true
+ if
+ try
+ content <> ""
+ && content.[len - 1] <> ';'
+ && content.[len - 2] <> ';'
+ with _ -> true
then content ^ ";;"
else content
in
current_position := output##.childNodes##.length;
textbox##.value := Js.string "";
History.push content;
- JsooTop.execute true ~pp_code:sharp_ppf ~highlight_location caml_ppf content';
- resize ~container ~textbox ()
- >>= fun () ->
+ JsooTop.execute true ~pp_code:sharp_ppf ~highlight_location
+ caml_ppf content';
+ resize ~container ~textbox () >>= fun () ->
container##.scrollTop := container##.scrollHeight;
textbox##focus;
Lwt.return_unit
@@ -441,32 +475,40 @@ let run _ =
| _ -> Js._true);
(Lwt.async_exception_hook :=
fun exc ->
- Format.eprintf "exc during Lwt.async: %s@." (Printexc.to_string exc);
+ Format.eprintf "exc during Lwt.async: %s@."
+ (Printexc.to_string exc);
match exc with
| Js_error.Exn e ->
let e = Js_error.to_error e in
Firebug.console##log e##.stack
| _ -> ());
Lwt.async (fun () ->
- resize ~container ~textbox ()
- >>= fun () ->
+ resize ~container ~textbox () >>= fun () ->
textbox##focus;
Lwt.return_unit);
- Graphics_support.init (by_id_coerce "test-canvas" Dom_html.CoerceTo.canvas);
- Sys_js.set_channel_flusher caml_chan (append Colorize.ocaml output "caml");
- Sys_js.set_channel_flusher sharp_chan (append Colorize.ocaml output "sharp");
- Sys_js.set_channel_flusher stdout (append Colorize.text output "stdout");
- Sys_js.set_channel_flusher stderr (append Colorize.text output "stderr");
+ Graphics_support.init
+ (by_id_coerce "test-canvas" Dom_html.CoerceTo.canvas);
+ Sys_js.set_channel_flusher caml_chan
+ (append Colorize.ocaml output "caml");
+ Sys_js.set_channel_flusher sharp_chan
+ (append Colorize.ocaml output "sharp");
+ Sys_js.set_channel_flusher stdout
+ (append Colorize.text output "stdout");
+ Sys_js.set_channel_flusher stderr
+ (append Colorize.text output "stderr");
let readline () =
Js.Opt.case
- (Dom_html.window##prompt (Js.string "The toplevel expects inputs:") (Js.string ""))
+ (Dom_html.window##prompt
+ (Js.string "The toplevel expects inputs:")
+ (Js.string ""))
(fun () -> "")
(fun s -> Js.to_string s ^ "\n")
in
Sys_js.set_channel_filler stdin readline;
setup_share_button ~output;
- setup_examples ~container ~textbox;
+ (* setup_examples ~container ~textbox; *)
setup_pseudo_fs ~load_cmis_from_server:false;
+ setup_storeview ~container ~textbox;
setup_toplevel ();
setup_js_preview ();
setup_printers ();
@@ -480,13 +522,6 @@ let run _ =
with
| Not_found -> ()
| exc ->
- Firebug.console##log_3
- (Js.string "exception")
+ Firebug.console##log_3 (Js.string "exception")
(Js.string (Printexc.to_string exc))
exc
-
-let _ =
- Dom_html.window##.onload :=
- Dom_html.handler (fun _ ->
- run ();
- Js._false)
diff --git a/toplevel.mli b/toplevel.mli
new file mode 100644
index 0000000..f3eefe1
--- /dev/null
+++ b/toplevel.mli
@@ -0,0 +1,11 @@
+open Js_of_ocaml
+open Store
+
+val run :
+ (container:
+ (* storeview:S.tree Lwt.t ->*)
+ Js_of_ocaml.Dom_html.element Js_of_ocaml.Js.t ->
+ textbox:Js_of_ocaml.Dom_html.textAreaElement Js_of_ocaml.Js.t ->
+ unit) ->
+ unit ->
+ unit