Smart HTTP support

.merlin

@@ -1,4 +1,4 @@
 PKG cstruct dolog ocamlgraph re zip uri lwt mstruct cmdliner mirage-types
-PKG nocrypto hex
+PKG nocrypto hex cohttp.lwt
 B _build/**
 S lib/

CHANGES.md

@@ -1,4 +1,7 @@
 ## 1.4.4
+* Best-effort creation of files when expanding the index into the filesystem:
+  Skip the invalid filenames and continue. Users are expected to sanitize
+  their filenames if they want to use a non-bare repository (#11)
 * Overwrite changed file when expanding the index into the filesystem (#4)
 * Do not recompute the hash of blob files when expanding the index into the
   filesystem. This help fixing a speed issue with non-bare repo with lots of

_oasis

@@ -29,15 +29,15 @@ Library git
                      lwt, hex
 
 Library "git-unix"
-  Build$:           flag(unix)
+  Build$:            flag(unix)
   Path:              lib/unix/
   FindlibParent:     git
   Findlibname:       unix
   Modules:           Git_unix
-  BuildDepends:      git, lwt.unix, conduit.lwt-unix, uri.services
+  BuildDepends:      git, cohttp.lwt, lwt.unix, conduit.lwt-unix, uri.services
 
 Library "git-mirage"
-  Build$:           flag(mirage)
+  Build$:            flag(mirage)
   Path:              lib/mirage/
   FindlibParent:     git
   Findlibname:       mirage

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: e523e8688c7da528848c072b66cdd8f7)
+# DO NOT EDIT (digest: e20b5ffb1f25bd996a030452be571ff3)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -50,6 +50,7 @@ true: annot, bin_annot
 <lib/*.ml{,i,y}>: pkg_zip
 # Library git-unix
 "lib/unix/git-unix.cmxs": use_git-unix
+<lib/unix/*.ml{,i,y}>: pkg_cohttp.lwt
 <lib/unix/*.ml{,i,y}>: pkg_conduit.lwt-unix
 <lib/unix/*.ml{,i,y}>: pkg_dolog
 <lib/unix/*.ml{,i,y}>: pkg_hex
@@ -77,6 +78,7 @@ true: annot, bin_annot
 <lib/mirage/*.ml{,i,y}>: use_git
 # Executable ogit
 <bin/ogit.{native,byte}>: pkg_cmdliner
+<bin/ogit.{native,byte}>: pkg_cohttp.lwt
 <bin/ogit.{native,byte}>: pkg_conduit.lwt-unix
 <bin/ogit.{native,byte}>: pkg_dolog
 <bin/ogit.{native,byte}>: pkg_hex
@@ -91,6 +93,7 @@ true: annot, bin_annot
 <bin/ogit.{native,byte}>: use_git
 <bin/ogit.{native,byte}>: use_git-unix
 <bin/*.ml{,i,y}>: pkg_cmdliner
+<bin/*.ml{,i,y}>: pkg_cohttp.lwt
 <bin/*.ml{,i,y}>: pkg_conduit.lwt-unix
 <bin/*.ml{,i,y}>: pkg_dolog
 <bin/*.ml{,i,y}>: pkg_hex
@@ -106,6 +109,7 @@ true: annot, bin_annot
 <bin/*.ml{,i,y}>: use_git-unix
 # Executable test_git
 <lib_test/test.{native,byte}>: pkg_alcotest
+<lib_test/test.{native,byte}>: pkg_cohttp.lwt
 <lib_test/test.{native,byte}>: pkg_conduit.lwt-unix
 <lib_test/test.{native,byte}>: pkg_dolog
 <lib_test/test.{native,byte}>: pkg_hex
@@ -125,6 +129,7 @@ true: annot, bin_annot
 <lib_test/test.{native,byte}>: use_git-mirage
 <lib_test/test.{native,byte}>: use_git-unix
 <lib_test/*.ml{,i,y}>: pkg_alcotest
+<lib_test/*.ml{,i,y}>: pkg_cohttp.lwt
 <lib_test/*.ml{,i,y}>: pkg_conduit.lwt-unix
 <lib_test/*.ml{,i,y}>: pkg_dolog
 <lib_test/*.ml{,i,y}>: pkg_hex

lib/META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 3c1beaeb2c5ef2d099fded34938c9432)
+# DO NOT EDIT (digest: d56eca42c04f2ba009b85e2caa624ca2)
 version = "1.4.3"
 description = "A low-level interface to Git in pure OCaml"
 requires = "mstruct dolog ocamlgraph zip nocrypto uri lwt hex"
@@ -11,7 +11,7 @@ exists_if = "git.cma"
 package "unix" (
  version = "1.4.3"
  description = "A low-level interface to Git in pure OCaml"
- requires = "git lwt.unix conduit.lwt-unix uri.services"
+ requires = "git cohttp.lwt lwt.unix conduit.lwt-unix uri.services"
  archive(byte) = "git-unix.cma"
  archive(byte, plugin) = "git-unix.cma"
  archive(native) = "git-unix.cmxa"

lib/gri.ml

@@ -45,11 +45,3 @@ let to_string uri =
       | Some h -> h in
     Printf.sprintf "%s%s:%s" userinfo host (Uri.path uri)
   | _ -> Uri.to_string uri
-
-type mode = [ `Git | `SSH | `HTTP ]
-
-let mode t =
-  match Uri.scheme t with
-  | Some "git"     -> `Git
-  | Some "git+ssh" -> `SSH
-  | _              -> `HTTP

lib/gri.mli

@@ -37,9 +37,3 @@ val to_uri: t -> Uri.t
 
 val of_uri: Uri.t -> t
 (** Cast from [Uri.t]. *)
-
-type mode = [ `Git | `SSH | `HTTP ]
-(** The three transmission protocols. *)
-
-val mode: t -> mode
-(** Return the protocol mode. *)

lib/mirage/git_mirage.ml

@@ -116,9 +116,12 @@ module FS (FS: FS) = struct
     let read_file t file =
       Log.debug "read_file %s" file;
       FS.stat t file >>| fun s ->
-      FS.read t file 0 (Int64.to_int s.FS.size) >>| fun bs ->
-      let s = Cstruct.copyv bs in
-      return (Cstruct.of_string s)
+      is_directory t file >>= function
+      | false ->
+        FS.read t file 0 (Int64.to_int s.FS.size) >>| fun bs ->
+        let s = Cstruct.copyv bs in
+        return (Cstruct.of_string s)
+      | true -> fail (Failure (Printf.sprintf "%s is a directory" file))
 
     let write_file t file b =
       Log.debug "write_file %s" file;