Commits

Anonymous committed fb0a71d Draft

basic files/repos caching works ok

Comments (0)

Files changed (3)

 
 
     let rm_rf dir =
-      if 0 = run ~show:true [| "rm" ; "-rf" ; dir |]
-      then ()
-      else failwith "can't \"rm -rf\" directory %S" dir
+      let fail msg = failwith "can't \"rm -rf\" directory %S: %s" dir msg in
+      match run ~show:true [| "rm" ; "-rf" ; dir |] with
+      | 0 ->
+          if Sys.file_exists dir
+          then fail "directory still exists"
+          else ()
+      | c ->
+          fail (Printf.sprintf "\"rm -rf\" returned code %i" c)
 
     let path_abs p =
       if Filename.is_relative p

src/post_template.ml

       let cache_dir_repos = get_cache_dir "repos"
 
 
-      let have_in_cache ~cachedir ~rkind =
+      (* todo: assuming there's [cached_name] pointing to file/repo,
+         check file's checksum, revision's presence for repo.
+         returns (bool, cached_name), bool is true if ok.
+       *)
+
+      let check_cache ~rkind ~cachedir =
+          match rkind with
+          | `File { rf_base_name } ->
+              let cached_fname = cachedir </> rf_base_name in
+              ( (   Sys.file_exists cached_fname
+                 && not (Sys.is_directory cached_fname)
+                 (* && checksum is ok *)
+                )
+              , cached_fname
+              )
+          | `Repo { rr_pull = _ } ->
+              ( ( [| |] <> Sys.readdir cachedir
+                  (* && has revision *)
+                )
+              , cachedir
+              )
+
+
+      (* update cache if needed (if requesting tip revision or some
+         branch from the repo).
+         returns true if updated ok or if update is not needed
+         (if it's file or if (todo) the requested revision is already
+         in repo).
+         returns false if the cache is bad/unusable. *)
+      let update_cache ~rkind ~cached_name : bool =
         match rkind with
-        | `File base_name ->
-            let cached_fname = cachedir </> base_name in
-            (   Sys.file_exists cached_fname
-             && not (Sys.is_directory cached_fname)
+        | `File _ -> true  (* checksum must be checked in [check_cache] *)
+        | `Repo { rr_pull } ->
+            Reb_sys.with_chdir cached_name
+              (fun () -> rr_pull ())
+
+
+      (* assures that package is in cache, downloads it otherwise,
+         returns path to use for [s_extract] *)
+      let download_in_cache ~cachedir ~rkind ~dlfunc : string =
+        let () = assure_dir cachedir in
+        let (is_in_cache, cached_name) = check_cache ~rkind ~cachedir in
+        let () = cachedbg "checked cache: is_in_cache = %b, cached_name = %S"
+          is_in_cache cached_name in
+        let need_to_download =
+          if is_in_cache
+          then
+            if update_cache ~rkind ~cached_name
+            then
+              let () = cachedbg "found in cache, updated ok" in
+              false
+            else
+              let () = cachedbg "found in cache, but need to redownload, \
+                                 so cleaning cache" in
+              ( Reb_sys.rm_rf cachedir
+              ; assure_dir cachedir
+              ; true
+              )
+          else
+            true
+        in
+          if need_to_download
+          then
+            let () = cachedbg "downloading package to cache, dest = %S"
+              cachedir in
+            let path = dlfunc ~dl_dest:cachedir in
+            let () = cachedbg "package downloaded to %S"
+              path in
+            let () =
+              if path <> cached_name
+              then failwith "package is expected to be downloaded to %S, but \
+                             downloaded to %S"
+                     cached_name path
+              else ()
+            in
+            let (is_in_cache, cached_name') = check_cache ~rkind ~cachedir in
+            ( if not is_in_cache
+              then failwith "can't find package in cache after downloading"
+              else ()
+            ; assert (cached_name' = path)
+            ; path
             )
-        | `Repo ->
-            [| |] <> Sys.readdir cachedir
+          else
+            cached_name
 
 
       let get_sources_cache pd ~dest ~rkind ~dlfunc ~cachedir =
-
-(*
-*)
-( ignore pd ; ignore dest ; ignore rkind ; ignore dlfunc ; ignore cachedir ; failwith "qwe" )
-
+        let pkg_name = pd.p_pkg_name in
+        let cached_name = download_in_cache ~dlfunc ~cachedir ~rkind in
+        let () = cachedbg "package %S is in cache, path %S"
+          pkg_name cached_name
+        in
+        let () = cachedbg "package %S: extracting from cached %S to %S"
+          pkg_name cached_name dest in
+        let extract_res = pd.p_source.s_extract ~path:cached_name ~dest in
+        let () = cachedbg "package %S: extracted to %S"
+          pkg_name extract_res in
+        extract_res
 
 
       let get_sources_no_cache pd ~dest ~s_download =
                   in
                   let dl_dest =
                     match rkind with
-                    | `Repo -> dest
-                    | `File _base_name ->
+                    | `Repo _ -> dest
+                    | `File _ ->
                         let temp = Filename.temp_dir_name in
                         let () = cachedbg "remote file, downloading to %S"
                           temp
               | `Remote (rkind, _) ->
                   begin
                   match rkind with
-                  | `File _base_name ->
+                  | `File { rf_base_name = _ } ->
                       let () = cachedbg "package %S was remote file, \
                                          cleaning local \
                                          downloaded file %S"
                         pkg_name local_path
                       in
                       Sys.remove local_path
-                  | `Repo ->
+                  | `Repo _ ->
                       if extract_res = local_path
                       then
                         let () = cachedbg "package %S was remote repo, but \
             | `Remote (rkind, dlfunc) ->
                 let cache_dir_opt =
                   (match rkind with
-                   | `File _base_name -> !!cache_dir_files
-                   | `Repo -> !!cache_dir_repos
+                   | `File _ -> !!cache_dir_files
+                   | `Repo _ -> !!cache_dir_repos
                   )
                 in
                   (match cache_dir_opt with

src/pre_template.ml

   | Reqs_dynamic of (unit -> pkg list)
 type action = (unit -> unit)
 type downloadfunc = (dl_dest:string (* directory *) -> string (* exact path *))
+type remote_file_info =
+  { rf_base_name : string
+  }
+type remote_repo_info =
+  { rr_pull : unit -> bool
+      (* executed in cachedir, returns true when pulling was successfu;
+         (or wasn't needed), false if repo is wrong
+       *)
+  }
 type source =
   { s_download :
       [ `No
       | `Local of string
-      | `Remote of [`File of string (* base name *) | `Repo]
+      | `Remote of [ `File of remote_file_info
+                   | `Repo of remote_repo_info
+                   ]
                  * downloadfunc
       ]
   ; s_extract : ( path:string (* exact path *) ->
           then
             `Local repo
           else
-            let remote_repo d = `Remote (`Repo, d) in
-            remote_repo
-            (fun ~dl_dest ->
-               let () = dbg "Source.hg: download: cloning %S (rev %S) \
-                             to %S without workcopy"
-                 repo rev dl_dest
-               in
-               clone ~src:repo ~dest:dl_dest ~workcopy:false
-            )
+            `Remote
+              ( (`Repo
+                   { rr_pull =
+                       (fun () ->
+                          0 = Reb_sys.run ~show:true
+                            [| "hg" ; "pull" |]
+                            (* todo: add rev/branch *)
+                       )
+                   }
+                )
+              ,
+                (fun ~dl_dest ->
+                   let () = dbg "Source.hg: download: cloning %S (rev %S) \
+                                 to %S without workcopy"
+                     repo rev dl_dest
+                   in
+                   clone ~src:repo ~dest:dl_dest ~workcopy:false
+                )
+              )
          )
       ; s_extract =
           (fun ~path ~dest ->
 
     let remote_archive ?hash ~unpack ~uri ~funcname =
       let base_name = last_component_of_uri uri in
-      { s_download = `Remote (`File base_name,
+      { s_download = `Remote (`File { rf_base_name = base_name },
           (fun ~dl_dest ->
              let outfn = dl_dest </> base_name in
              ( download ?hash ~uri ~funcname ~outfn