Allow the user to start a git connection without a DNS resolver

Author: dinosaure

src/git-mirage/dune

@@ -2,8 +2,8 @@
  (name git_mirage_tcp)
  (modules git_mirage_tcp)
  (public_name git-mirage.tcp)
- (libraries mimic result fmt lwt mirage-flow ipaddr mirage-protocols
-   mirage-stack))
+ (libraries git.nss.git mimic result fmt lwt mirage-flow ipaddr
+   mirage-protocols mirage-stack))
 
 (library
  (name git_mirage_ssh)

src/git-mirage/git_mirage.ml

@@ -35,14 +35,21 @@ struct
   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; 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
+    let edn = Smart_git.Endpoint.of_string edn in
+    let ctx0 =
+      match edn with
+      | 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
+    in
+    match edn with
+    | Ok { Smart_git.Endpoint.host = `Addr (Ipaddr.V4 v); _ } ->
+        Mimic.add TCP.tcp_ipaddr v ctx0
+    | _ -> ctx0
 end

src/git-mirage/git_mirage_tcp.ml

@@ -37,17 +37,9 @@ module Make (Stack : Mirage_stack.V4) = struct
 
   let tcp_ipaddr = Mimic.make ~name:"tcp-ipaddr"
   let tcp_port = Mimic.make ~name:"tcp-port"
-  let tcp_stack = Mimic.make ~name:"tcp-stack"
+  let tcp_stack : Stack.t Mimic.value = Mimic.make ~name:"tcp-stack"
   let with_port v ctx = Mimic.add tcp_port v ctx
   let with_ipaddr v ctx = Mimic.add tcp_ipaddr v ctx
   let with_stack v ctx = Mimic.add tcp_stack v ctx
-
-  let with_resolv ctx =
-    let k stack ipaddr port = Lwt.return_some (stack, ipaddr, port) in
-    Mimic.(
-      fold tcp_endpoint
-        Fun.[ req tcp_stack; req tcp_ipaddr; req tcp_port ]
-        ~k ctx)
-
-  let ctx = with_resolv Mimic.empty
+  let ctx = Mimic.empty
 end

src/git-mirage/git_mirage_tcp.mli

@@ -10,6 +10,5 @@ module Make (Stack : Mirage_stack.V4) : sig
   val with_port : int -> Mimic.ctx -> Mimic.ctx
   val with_ipaddr : Ipaddr.V4.t -> Mimic.ctx -> Mimic.ctx
   val with_stack : Stack.t -> Mimic.ctx -> Mimic.ctx
-  val with_resolv : Mimic.ctx -> Mimic.ctx
   val ctx : Mimic.ctx
 end

src/not-so-smart/smart_git.ml

@@ -126,14 +126,13 @@ module Endpoint = struct
     in
     let parse_uri x =
       let uri = Uri.of_string x in
+      let path = Uri.path uri in
       let host str =
         Domain_name.of_string str
         >>= Domain_name.host
         >>| (fun x -> `Domain x)
         <|> (Ipaddr.of_string str >>| fun x -> `Addr x)
       in
-      let path = Astring.String.drop ~max:1 ~sat:(( = ) '/') (Uri.path uri) in
-      (* XXX(dinosaure): [uri] prepend the path by a '/'. *)
       match Uri.scheme uri, Uri.host uri with
       | Some "git", Some str ->
           host str >>= fun host -> R.ok { scheme = `Git; path; host }
@@ -344,6 +343,11 @@ struct
     let open Lwt.Infix in
     Mimic.resolve ctx >>= function
     | Error _ as err ->
+        let pp_host ppf = function
+          | `Domain v -> Domain_name.pp ppf v
+          | `Addr v -> Ipaddr.pp ppf v
+        in
+        Log.err (fun m -> m "%a not found" pp_host host);
         pack None;
         Lwt.return err
     | Ok flow ->