Skip to content

Delete the useless verify function and start an SSH connection with a pre-condition over the given Smart_git.Endpoint.t #429

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
dinosaure merged 1 commit into from
Jan 7, 2021
Merged

Delete the useless verify function and start an SSH connection with a pre-condition over the given Smart_git.Endpoint.t #429

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 19 additions & 5 deletions src/git-mirage/git_mirage.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,27 +8,41 @@ module Make
struct
let git_path = Mimic.make ~name:"git-path"
let git_capabilities = Mimic.make ~name:"git-capabilities"
let git_scheme = Mimic.make ~name:"git-scheme"
let with_git_path v ctx = Mimic.add git_path v ctx
let fetch ctx = Mimic.add git_capabilities `Rd ctx
let push ctx = Mimic.add git_capabilities `Wr ctx
let gri ctx = Mimic.add git_scheme `Git ctx
let ssh ctx = Mimic.add git_scheme `SSH ctx
let http ctx = Mimic.add git_scheme `HTTP ctx
let https ctx = Mimic.add git_scheme `HTTPS ctx

let with_resolv ctx =
let k stack ipaddr port _path _cap =
Lwt.return_some (stack, ipaddr, port)
let k scheme stack ipaddr port _path _cap =
match scheme with
| `Git | `HTTP -> Lwt.return_some (stack, ipaddr, port)
| _ -> Lwt.return_none
in
Mimic.(
fold TCP.tcp_endpoint
Fun.
[
req TCP.tcp_stack; req TCP.tcp_ipaddr; dft TCP.tcp_port 9418;
req git_path; dft git_capabilities `Rd;
req git_scheme; req TCP.tcp_stack; req TCP.tcp_ipaddr;
dft TCP.tcp_port 9418; req git_path; dft git_capabilities `Rd;
]
~k ctx)

let ctx = with_resolv Mimic.empty

let with_smart_git_endpoint edn ctx =
match Smart_git.Endpoint.of_string edn with
| Ok { Smart_git.Endpoint.path; _ } -> with_git_path path ctx
| Ok { Smart_git.Endpoint.path; scheme = `SSH _; _ } ->
ssh (with_git_path path ctx)
| Ok { Smart_git.Endpoint.path; scheme = `Git; _ } ->
gri (with_git_path path ctx)
| Ok { Smart_git.Endpoint.path; scheme = `HTTP _; _ } ->
http (with_git_path path ctx)
| Ok { Smart_git.Endpoint.path; scheme = `HTTPS _; _ } ->
https (with_git_path path ctx)
| _ -> ctx
end
5 changes: 5 additions & 0 deletions src/git-mirage/git_mirage.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,9 +7,14 @@ module Make
end) : sig
val git_path : string Mimic.value
val git_capabilities : [ `Rd | `Wr ] Mimic.value
val git_scheme : [ `Git | `SSH | `HTTP | `HTTPS ] Mimic.value
val with_git_path : string -> Mimic.ctx -> Mimic.ctx
val fetch : Mimic.ctx -> Mimic.ctx
val push : Mimic.ctx -> Mimic.ctx
val gri : Mimic.ctx -> Mimic.ctx
val ssh : Mimic.ctx -> Mimic.ctx
val http : Mimic.ctx -> Mimic.ctx
val https : Mimic.ctx -> Mimic.ctx
val with_resolv : Mimic.ctx -> Mimic.ctx
val ctx : Mimic.ctx
val with_smart_git_endpoint : string -> Mimic.ctx -> Mimic.ctx
Expand Down
43 changes: 24 additions & 19 deletions src/git-mirage/git_mirage_ssh.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@ module Make
end) (Git : sig
val git_path : string Mimic.value
val git_capabilities : [ `Rd | `Wr ] Mimic.value
val git_scheme : [ `Git | `SSH | `HTTP | `HTTPS ] Mimic.value
end)
(Mclock : Mirage_clock.MCLOCK) =
struct
Expand Down Expand Up @@ -89,39 +90,43 @@ struct
Mimic.add ssh_key v ctx

let with_resolv ctx =
let k (stack, ipaddr, port) ssh_authenticator ssh_user ssh_key git_path
git_capabilities =
Lwt.return_some
{
stack;
ipaddr;
port;
authenticator = ssh_authenticator;
user = ssh_user;
key = ssh_key;
path = git_path;
capabilities = git_capabilities;
}
let k scheme (stack, ipaddr, port) ssh_authenticator ssh_user ssh_key
git_path git_capabilities =
match scheme with
| `SSH ->
Lwt.return_some
{
stack;
ipaddr;
port;
authenticator = ssh_authenticator;
user = ssh_user;
key = ssh_key;
path = git_path;
capabilities = git_capabilities;
}
| _ -> Lwt.return_none
in
let ctx =
Mimic.(
fold ssh_endpoint
Fun.
[
req TCP.tcp_endpoint; opt ssh_authenticator; req ssh_user;
req ssh_key; req Git.git_path; dft Git.git_capabilities `Rd;
req Git.git_scheme; req TCP.tcp_endpoint; opt ssh_authenticator;
req ssh_user; req ssh_key; req Git.git_path;
dft Git.git_capabilities `Rd;
]
~k ctx)
in
let k stack ipaddr port = k (stack, ipaddr, port) in
let k scheme stack ipaddr port = k scheme (stack, ipaddr, port) in
let ctx =
Mimic.(
fold ssh_endpoint
Fun.
[
req TCP.tcp_stack; req TCP.tcp_ipaddr; dft TCP.tcp_port 22;
opt ssh_authenticator; req ssh_user; req ssh_key;
req Git.git_path; dft Git.git_capabilities `Rd;
req Git.git_scheme; req TCP.tcp_stack; req TCP.tcp_ipaddr;
dft TCP.tcp_port 22; opt ssh_authenticator; req ssh_user;
req ssh_key; req Git.git_path; dft Git.git_capabilities `Rd;
]
~k ctx)
in
Expand Down
1 change: 1 addition & 0 deletions src/git-mirage/git_mirage_ssh.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ module Make
end) (Git : sig
val git_path : string Mimic.value
val git_capabilities : [ `Rd | `Wr ] Mimic.value
val git_scheme : [ `Git | `SSH | `HTTP | `HTTPS ] Mimic.value
end)
(Mclock : Mirage_clock.MCLOCK) : sig
type nonrec endpoint = Stack.t endpoint
Expand Down
10 changes: 5 additions & 5 deletions src/git-unix/git_unix.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -717,16 +717,16 @@ module Sync (Git_store : Git.S) (HTTP : Smart_git.HTTP) = struct
Lwt.async fill;
fun () -> Lwt_stream.get stream

let fetch ?(push_stdout = ignore) ?(push_stderr = ignore) ~ctx ?verify edn
store ?version ?capabilities ?deepen want =
let fetch ?(push_stdout = ignore) ?(push_stderr = ignore) ~ctx edn store
?version ?capabilities ?deepen want =
let dotgit = Git_store.dotgit store in
let temp = Fpath.(dotgit / "tmp") in
tmp temp "pack-%s.pack" >>= fun src ->
tmp temp "pack-%s.pack" >>= fun dst ->
tmp temp "pack-%s.idx" >>= fun idx ->
let create_idx_stream () = stream_of_file idx in
let create_pack_stream () = stream_of_file dst in
fetch ~push_stdout ~push_stderr ~ctx ?verify edn store ?version
?capabilities ?deepen want ~src ~dst ~idx ~create_idx_stream
~create_pack_stream temp temp
fetch ~push_stdout ~push_stderr ~ctx edn store ?version ?capabilities
?deepen want ~src ~dst ~idx ~create_idx_stream ~create_pack_stream temp
temp
end
10 changes: 5 additions & 5 deletions src/git/mem.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -473,8 +473,8 @@ module Sync (Git_store : Minimal.S) (HTTP : Smart_git.HTTP) = struct
Lwt.async fill;
fun () -> Lwt_stream.get stream

let fetch ?(push_stdout = ignore) ?(push_stderr = ignore) ~ctx ?verify edn
store ?version ?capabilities ?deepen want =
let fetch ?(push_stdout = ignore) ?(push_stderr = ignore) ~ctx edn store
?version ?capabilities ?deepen want =
let t_idx = Carton.Dec.Idx.Device.device () in
let t_pck = Cstruct_append.device () in
let index = Carton.Dec.Idx.Device.create t_idx in
Expand All @@ -489,7 +489,7 @@ module Sync (Git_store : Minimal.S) (HTTP : Smart_git.HTTP) = struct
let pack = Cstruct_append.project t_pck dst in
stream_of_cstruct pack
in
fetch ~push_stdout ~push_stderr ~ctx ?verify edn store ?version
?capabilities ?deepen want ~src ~dst ~idx:index ~create_idx_stream
~create_pack_stream t_pck t_idx
fetch ~push_stdout ~push_stderr ~ctx edn store ?version ?capabilities
?deepen want ~src ~dst ~idx:index ~create_idx_stream ~create_pack_stream
t_pck t_idx
end
14 changes: 6 additions & 8 deletions src/git/sync.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,6 @@ module type S = sig
?push_stdout:(string -> unit) ->
?push_stderr:(string -> unit) ->
ctx:Mimic.ctx ->
?verify:(Smart_git.Endpoint.t -> Mimic.flow -> (unit, error) result Lwt.t) ->
Smart_git.Endpoint.t ->
store ->
?version:[> `V1 ] ->
Expand All @@ -42,7 +41,6 @@ module type S = sig

val push :
ctx:Mimic.ctx ->
?verify:(Smart_git.Endpoint.t -> Mimic.flow -> (unit, error) result Lwt.t) ->
Smart_git.Endpoint.t ->
store ->
?version:[> `V1 ] ->
Expand Down Expand Up @@ -188,9 +186,9 @@ struct
let ( >>? ) x f =
x >>= function Ok x -> f x | Error err -> Lwt.return_error err

let fetch ?(push_stdout = ignore) ?(push_stderr = ignore) ~ctx ?verify
endpoint t ?version ?capabilities ?deepen want ~src ~dst ~idx
~create_idx_stream ~create_pack_stream t_pck t_idx =
let fetch ?(push_stdout = ignore) ?(push_stderr = ignore) ~ctx endpoint t
?version ?capabilities ?deepen want ~src ~dst ~idx ~create_idx_stream
~create_pack_stream t_pck t_idx =
let want, src_dst_mapping =
match want with
| (`All | `None) as x -> x, fun src -> [ src ]
Expand All @@ -216,7 +214,7 @@ struct
`Some src_refs, src_dst_mapping
in
let ministore = Ministore.inj (t, Hashtbl.create 0x100) in
fetch ~push_stdout ~push_stderr ~ctx ?verify
fetch ~push_stdout ~push_stderr ~ctx
(access, lightly_load t, heavily_load t)
ministore endpoint ?version ?capabilities ?deepen want t_pck t_idx ~src
~dst ~idx
Expand Down Expand Up @@ -289,9 +287,9 @@ struct
unshallow = (fun _ -> assert false);
}

let push ~ctx ?verify endpoint t ?version ?capabilities cmds =
let push ~ctx endpoint t ?version ?capabilities cmds =
let ministore = Ministore.inj (t, Hashtbl.create 0x100) in
push ~ctx ?verify
push ~ctx
(access, lightly_load t, heavily_load t)
ministore endpoint ?version ?capabilities cmds
end
4 changes: 0 additions & 4 deletions src/git/sync.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,6 @@ module type S = sig
?push_stdout:(string -> unit) ->
?push_stderr:(string -> unit) ->
ctx:Mimic.ctx ->
?verify:(Smart_git.Endpoint.t -> Mimic.flow -> (unit, error) result Lwt.t) ->
Smart_git.Endpoint.t ->
store ->
?version:[> `V1 ] ->
Expand All @@ -41,7 +40,6 @@ module type S = sig

val push :
ctx:Mimic.ctx ->
?verify:(Smart_git.Endpoint.t -> Mimic.flow -> (unit, error) result Lwt.t) ->
Smart_git.Endpoint.t ->
store ->
?version:[> `V1 ] ->
Expand Down Expand Up @@ -71,7 +69,6 @@ module Make
?push_stdout:(string -> unit) ->
?push_stderr:(string -> unit) ->
ctx:Mimic.ctx ->
?verify:(Smart_git.Endpoint.t -> Mimic.flow -> (unit, 'err) result Lwt.t) ->
Smart_git.Endpoint.t ->
store ->
?version:[> `V1 ] ->
Expand Down Expand Up @@ -99,7 +96,6 @@ module Make

val push :
ctx:Mimic.ctx ->
?verify:(Smart_git.Endpoint.t -> Mimic.flow -> (unit, 'err) result Lwt.t) ->
Smart_git.Endpoint.t ->
store ->
?version:[> `V1 ] ->
Expand Down
68 changes: 28 additions & 40 deletions src/not-so-smart/smart_git.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -312,35 +312,28 @@ struct
module Fetch = Nss.Fetch.Make (Scheduler) (Lwt) (Flow) (Uid) (Ref)
module Push = Nss.Push.Make (Scheduler) (Lwt) (Flow) (Uid) (Ref)

let fetch_v1 ?(uses_git_transport = false)
?(verify = fun _ -> Lwt.return_ok ()) ~push_stdout ~push_stderr
let fetch_v1 ?(uses_git_transport = false) ~push_stdout ~push_stderr
~capabilities path ~ctx ?deepen ?want host store access fetch_cfg pack =
let open Lwt.Infix in
Log.debug (fun m -> m "Try to resolve %a." Domain_name.pp host);
Mimic.resolve ctx >>= function
| Error _ as err ->
pack None;
Lwt.return err
| Ok flow -> (
verify flow >>= function
| Error err ->
Mimic.close flow >>= fun () ->
| Ok flow ->
Lwt.try_bind
(fun () ->
Fetch.fetch_v1 ~uses_git_transport ~push_stdout ~push_stderr
~capabilities ?deepen ?want ~host path (Flow.make flow) store
access fetch_cfg (fun (payload, off, len) ->
let v = String.sub payload off len in
pack (Some (v, 0, len))))
(fun refs ->
pack None;
Lwt.return_error err
| Ok () ->
Lwt.try_bind
(fun () ->
Fetch.fetch_v1 ~uses_git_transport ~push_stdout ~push_stderr
~capabilities ?deepen ?want ~host path (Flow.make flow) store
access fetch_cfg (fun (payload, off, len) ->
let v = String.sub payload off len in
pack (Some (v, 0, len))))
(fun refs ->
pack None;
Mimic.close flow >>= fun () -> Lwt.return_ok refs)
(fun exn ->
pack None;
Mimic.close flow >>= fun () -> Lwt.fail exn))
Mimic.close flow >>= fun () -> Lwt.return_ok refs)
(fun exn ->
pack None;
Mimic.close flow >>= fun () -> Lwt.fail exn)

module Flow_http = struct
type +'a fiber = 'a Lwt.t
Expand Down Expand Up @@ -410,9 +403,9 @@ struct
]

let fetch ?(push_stdout = ignore) ?(push_stderr = ignore) ~ctx
?(verify = fun _ _ -> Lwt.return_ok ()) (access, light_load, heavy_load)
store edn ?(version = `V1) ?(capabilities = default_capabilities) ?deepen
want t_pck t_idx ~src ~dst ~idx =
(access, light_load, heavy_load) store edn ?(version = `V1)
?(capabilities = default_capabilities) ?deepen want t_pck t_idx ~src ~dst
~idx =
let open Rresult in
let open Lwt.Infix in
let host = edn.Endpoint.host in
Expand All @@ -437,8 +430,8 @@ struct
let run () =
Lwt.both
(fetch_v1 ~push_stdout ~push_stderr ~uses_git_transport
~verify:(verify edn) ~capabilities path ~ctx ?deepen ~want host
store access fetch_cfg pusher)
~capabilities path ~ctx ?deepen ~want host store access
fetch_cfg pusher)
(run ~light_load ~heavy_load stream t_pck t_idx ~src ~dst ~idx)
>>= fun (refs, idx) ->
match refs, idx with
Expand Down Expand Up @@ -574,20 +567,16 @@ struct
Lwt.async fiber;
stream

let push ?prelude ~ctx ?(verify = fun _ -> Lwt.return_ok ()) ~capabilities
path cmds endpoint store access push_cfg pack =
let push ?prelude ~ctx ~capabilities path cmds endpoint store access push_cfg
pack =
let open Lwt.Infix in
Mimic.resolve ctx >>? fun flow ->
verify flow >>= function
| Error _ as err -> Mimic.close flow >>= fun () -> Lwt.return err
| Ok () ->
Push.push ?prelude ~capabilities cmds ~host:endpoint path
(Flow.make flow) store access push_cfg pack
>>= fun () ->
Mimic.close flow >>= fun () -> Lwt.return_ok ()

let push ~ctx ?(verify = fun _ _ -> Lwt.return_ok ())
(access, light_load, heavy_load) store edn ?(version = `V1)
Push.push ?prelude ~capabilities cmds ~host:endpoint path (Flow.make flow)
store access push_cfg pack
>>= fun () ->
Mimic.close flow >>= fun () -> Lwt.return_ok ()

let push ~ctx (access, light_load, heavy_load) store edn ?(version = `V1)
?(capabilities = default_capabilities) cmds =
let open Rresult in
match version, edn.Endpoint.scheme with
Expand All @@ -597,8 +586,7 @@ struct
let path = edn.path in
let push_cfg = Nss.Push.configuration () in
let run () =
push ~prelude ~ctx ~verify:(verify edn) ~capabilities path cmds host
store access push_cfg
push ~prelude ~ctx ~capabilities path cmds host store access push_cfg
(pack ~light_load ~heavy_load)
in
Lwt.catch run (function
Expand Down
2 changes: 0 additions & 2 deletions src/not-so-smart/smart_git.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,6 @@ module Make
?push_stdout:(string -> unit) ->
?push_stderr:(string -> unit) ->
ctx:Mimic.ctx ->
?verify:(Endpoint.t -> Mimic.flow -> (unit, 'err) result Lwt.t) ->
(Uid.t, _, Uid.t * int ref * int64, 'g, Scheduler.t) Sigs.access
* Uid.t Carton_lwt.Thin.light_load
* Uid.t Carton_lwt.Thin.heavy_load ->
Expand All @@ -99,7 +98,6 @@ module Make

val push :
ctx:Mimic.ctx ->
?verify:(Endpoint.t -> Mimic.flow -> (unit, 'err) result Lwt.t) ->
(Uid.t, Ref.t, Uid.t Pck.t, 'g, Scheduler.t) Sigs.access
* Uid.t Carton_lwt.Thin.light_load
* Uid.t Carton_lwt.Thin.heavy_load ->
Expand Down
Loading