Introduce 'peers' subcommand, refactor in pull

git-svn-id: file:///srv/svn/repo/kosuzu/trunk@31 eb64cd80-c68d-6f47-b6a3-0ada418499da

cli/dune

@@ -1,5 +1,6 @@
 (executable
  (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))

cli/peers.ml

@@ -0,0 +1,37 @@
+let print_peers_of_peer p =
+	let open Logarion.Header_pack in
+	match Msgpck.to_list p.peers with [] -> ()
+	| ps -> print_endline @@
+		List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps
+
+type filter_t = { authors: Logarion.Person.Set.t; topics: Logarion.String_set.t }
+
+let print_peer () peer =
+	let open Logarion.Peers in
+	Printf.printf "%s" peer.path;
+	List.iter (Printf.printf "\t%s\n") peer.locations
+
+let remove_repo id =
+	let repopath = Filename.concat Logarion.Peers.text_dir id in
+	match Sys.is_directory repopath with
+	| false -> Printf.eprintf "No repository %s in %s" id Logarion.Peers.text_dir
+	| true ->
+		let cmd = Printf.sprintf "rm -r %s" repopath in
+		Printf.printf "Run: %s ? (y/N) %!" cmd;
+		match input_char stdin with
+		|'y'-> if Sys.command cmd = 0 then print_endline "Removed" else prerr_endline "Failed"
+		| _ -> ()
+
+let peers = function
+	| Some id -> remove_repo id
+	| None ->
+		Printf.printf "Peers in %s\n" Logarion.Peers.text_dir;
+		Logarion.Peers.fold print_peer ()
+
+open Cmdliner
+let term =
+	let remove = Arg.(value & opt (some string) None & info ["remove"]
+		~docv:"repository ID" ~doc:"remove repository texts & from future pulling") in
+	Term.(const peers $ remove),
+		Term.info "peers" ~doc:"list current peers" ~man:[ `S "DESCRIPTION";
+			`P "Lists current peers and associated information"]

cli/pull.ml

@@ -86,15 +86,15 @@ let per_text url dir filter print i id time title authors topics = match id with
 			|| Person.Set.exists (fun t -> List.mem (Person.to_string t) authors) filter.authors)
 		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;
 	true
 	with Invalid_argument _ -> false
 
 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
 	| Ok body ->
@@ -127,7 +127,11 @@ let pull_list auths topics =
 	Curl.global_init Curl.CURLINIT_GLOBALALL;
 	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 ()
 
 let pull url auths topics = match url with

cli/txt.ml

@@ -15,6 +15,7 @@ let () = match Term.eval_choice default_cmd [
 	Last.term;
 	Listing.term;
 	New.term;
+	Peers.term;
 	Publish.term;
 	Pull.term;
 	Read.term;

lib/peers.ml

@@ -1,16 +1,22 @@
 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 read_pack init path =
-			let pack_path = Filename.(concat text_dir @@ concat path "index.pck") in
+			let fullpath = Filename.concat text_dir path in
-			match Sys.file_exists pack_path with false -> () | true ->
+			if Sys.is_directory fullpath then begin
-				match Header_pack.of_string (File_store.to_string pack_path) with
+			let pack_path = Filename.concat fullpath "index.pck" in
-				| Error s -> Printf.eprintf "%s %s\n" s pack_path
+			match Sys.file_exists pack_path with
-				| Ok p -> ignore @@ List.fold_left fn init Header_pack.(p.info.locations)
+			| 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 =
 	let colon_idx = String.index_from url 0 ':' in