Changeset 31 in code for trunk

Timestamp:

Nov 18, 2022, 1:41:55 PM (2 years ago)

Author:

fox

Message:

Introduce 'peers' subcommand, refactor in pull

Location:

trunk

Files:

• cli/dune (modified) (1 diff)
• cli/peers.ml (added)
• cli/pull.ml (modified) (3 diffs)
• cli/txt.ml (modified) (1 diff)
• lib/peers.ml (modified) (1 diff)

trunk/cli/dune

@@ -2 +2 @@
  (name txt)
  (public_name txt)
- (modules txt authors convert conversion edit file index last listing new topics html atom gemini publish pull read recent)
+ (modules txt authors convert conversion edit file index last listing
+        new topics html atom gemini peers publish pull read recent)
  (libraries text_parse.converter text_parse.parsers logarion msgpck curl str cmdliner))

trunk/cli/pull.ml

@@ -87 +87 @@
                 then pull_text url dir id
 
+(*TODO: integrate in lib*)
 let validate_id_length s = String.length s <= 32
-
 let validate_id_chars s = try
         String.iter (function 'a'..'z'|'A'..'Z'|'0'..'9'-> () | _ -> raise (Invalid_argument "")) s;
@@ -95 +95 @@
 
 let pull_index url authors_opt topics_opt =
-        let index_url = url ^ "/index.pck" in
+        let index_url = Filename.concat url "index.pck" in
         match curl_pull index_url with
         | Error s -> prerr_endline s; false
@@ -128 +128 @@
         let pull got_one peer_url = if got_one then got_one else
                 (pull_index peer_url auths topics) in
-        Logarion.Peers.fold pull false;
+        let fold_locations init peer =
+                ignore @@ List.fold_left pull init peer.Logarion.Peers.locations;
+                false
+        in
+        ignore @@ Logarion.Peers.fold fold_locations false;
         Curl.global_cleanup ()
 

trunk/cli/txt.ml

@@ -16 +16 @@
         Listing.term;
         New.term;
+        Peers.term;
         Publish.term;
         Pull.term;

trunk/lib/peers.ml

@@ -1 +1 @@
 let text_dir = Filename.concat (File_store.txtdir ()) "peers"
 
+type t = { path: string; locations: string list }
+
 let fold fn init = match Sys.readdir text_dir with
-        | exception (Sys_error msg) -> prerr_endline msg
+        | exception (Sys_error msg) -> prerr_endline msg; init
         | dirs ->
-                let read_pack path =
-                        let pack_path = Filename.(concat text_dir @@ concat path "index.pck") in
-                        match Sys.file_exists pack_path with false -> () | true ->
-                                match Header_pack.of_string (File_store.to_string pack_path) with
-                                | Error s -> Printf.eprintf "%s %s\n" s pack_path
-                                | Ok p -> ignore @@ List.fold_left fn init Header_pack.(p.info.locations)
+                let read_pack init path =
+                        let fullpath = Filename.concat text_dir path in
+                        if Sys.is_directory fullpath then begin
+                        let pack_path = Filename.concat fullpath "index.pck" in
+                        match Sys.file_exists pack_path with
+                        | false -> Printf.eprintf "Missing index.pck for %s\n" path; init
+                        | true -> match Header_pack.of_string (File_store.to_string pack_path) with
+                                | Error s -> Printf.eprintf "%s %s\n" s pack_path; init
+                                | Ok p -> fn init { path; locations = Header_pack.(p.info.locations) }
+                        end else init
                 in
-                Array.iter read_pack dirs
+                Array.fold_left read_pack init dirs
 
 let scheme url =