Move text-parse in submodule

- Inform about pubdir value and txt.conf

.gitignore

@@ -6,4 +6,5 @@
 *~
 *.o
 *.native
-_build
+_build
+*.htm

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "text-parse-ml"]
+	path = text-parse
+	url = https://git.disroot.org/orbifx/text-parse-ml.git

Makefile

@@ -10,9 +10,16 @@ clean:
 tgz:
 	dune subst
 	dune build
-	cp _build/default/cli/txt.exe txt
-	strip txt
-	tar czvf "logarion-$(shell date -r _build/default/cli/cli.exe "+%y-%m-%d")-$(shell uname -s)-$(shell uname -m)-$(shell git rev-parse --short HEAD).tar.gz" txt readme
-	rm txt
+	cp _build/default/cli/txt.exe txt.exe
+	strip txt.exe
+	tar czvf "logarion-$(shell uname -s)-$(shell uname -m)-$(shell date -r _build/default/cli/txt.exe "+%y%m%d")-$(shell git rev-parse --short HEAD).tgz" txt.exe readme.txt
+	rm txt.exe
+
+htm:
+	rm -f {3sqd84,hvhhwf,ka4wtj,h1a9tg}.htm
+	txt convert readme.txt -t htm
+	txt convert txt/3sqd84.txt -t htm
+	txt convert txt/hvhhwf.txt -t htm
+	txt convert txt/h1a9tg.txt -t htm
 
 .PHONY: cli

cli/atom.ml

@@ -50,7 +50,7 @@ let base_url kv protocol = try
 	let locs = Logarion.Store.KV.find "Locations" kv in
 	let _i = Str.(search_forward (regexp (protocol ^ "://[^;]*")) locs 0) in
 	Str.(matched_string locs)
-	with Not_found -> Printf.eprintf "Missing location for %s" protocol; ""
+	with Not_found -> Printf.eprintf "Missing location for %s, add it to txt.conf\n" protocol; ""
 
 let indices alternate_type c =
 	let file name = Logarion.File_store.file (Filename.concat c.Conversion.dir name) in
@@ -61,7 +61,7 @@ let indices alternate_type c =
 	in
 	let base_url = base_url c.kv protocol_regexp in
 	let self = Filename.concat base_url fname in
-	file fname @@
+	file fname @@ (*TODO: alternate & self per url*)
 	  {|<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom" xml:base="|} ^ base_url ^ {|"><title>|}
 	  ^ title ^ {|</title><link rel="alternate" type="|} ^ alternate_type ^ {|" href="|}
 	  ^ base_url ^ {|/" /><link rel="self" type="application/atom+xml" href="|}

cli/conversion.ml

@@ -1,9 +1,60 @@
 open Logarion
+
+module Rel = struct
+
+module Rel_set = Set.Make(String)
+module Id_map = Map.Make(String)
+
+type t = { last_rel: string; ref_set: String_set.t; rep_set: String_set.t }
+type map_t = t Id_map.t
+
+let empty = { last_rel = ""; ref_set = Rel_set.empty; rep_set = Rel_set.empty }
+let empty_map = Id_map.empty
+
+let acc_ref date source target = Id_map.update target (function
+	| None -> Some { last_rel = date;
+		ref_set = Rel_set.singleton source;
+		rep_set = Rel_set.empty }
+	| Some rel -> Some { rel with
+		last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel;
+		ref_set = Rel_set.add source rel.ref_set })
+
+let acc_rep date source target = Id_map.update target (function
+	| None -> Some { last_rel = date;
+		rep_set = Rel_set.singleton source;
+		ref_set = Rel_set.empty }
+	| Some rel -> Some { rel with
+		last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel;
+		rep_set = Rel_set.add source rel.rep_set })
+
+let acc_txt rels (text, _paths) =
+	let acc_ref = acc_ref (Date.listing text.Text.date) text.Text.id in
+	let acc_rep = acc_rep (Date.listing text.Text.date) text.Text.id in
+	let rels = String_set.fold acc_ref (Text.set "references" text) rels in
+	let rels = String_set.fold acc_rep (Text.set "in-reply-to" text) rels in
+	rels
+
+let acc_pck rels peer =
+	let path = try List.hd peer.Peers.pack.Header_pack.info.locations with Failure _->"" in
+	try Header_pack.fold
+		(fun rels id t _title _authors _topics refs_ls reps_ls ->
+			let acc_ref = acc_ref (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in
+			let acc_rep = acc_rep (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in
+			let rels = String_set.fold acc_ref (String_set.of_list refs_ls) rels in
+			let rels = String_set.fold acc_rep (String_set.of_list reps_ls) rels in
+			rels)
+		rels peer.Peers.pack
+	with e -> prerr_endline "acc_pck"; raise e
+end
+
+
 type t = {
-	id: string; dir: string;
+	id: string;
+	dir: string;
 	kv: string Store.KV.t;
 	topic_roots: string list;
 	topics: (String_set.t * String_set.t) Topic_set.Map.t;
+	relations: Rel.map_t;
 	texts: Text.t list
 }
 
@@ -12,3 +63,12 @@ type fn_t = {
 	page: (t -> Logarion.Text.t -> string) option;
 	indices: (t -> unit) option;
 }
+
+let empty () = {
+	id = ""; dir = "";
+	kv = Store.KV.empty;
+	topic_roots = [];
+	topics = Topic_set.Map.empty;
+	relations = Rel.Id_map.empty;
+	texts = []
+}

cli/convert.ml

@@ -1,19 +1,19 @@
 open Logarion
 
-let is_older source dest = try
-	Unix.((stat dest).st_mtime < (stat source).st_mtime) with _-> true
+(*TODO: move to converters (style, feed checks)*)
+let is_older s d = try Unix.((stat d).st_mtime < (stat s).st_mtime) with _-> true
 
 let convert cs r (text, files) = match Text.str "Content-Type" text with
 	| "" | "text/plain" ->
 		let source = List.hd files in
 		let dest = Filename.concat r.Conversion.dir (Text.short_id text) in
-		List.fold_left
-			(fun a f ->
-				match f.Conversion.page with None -> false || a
-				| Some page ->
-					let dest = dest ^ f.Conversion.ext in
-					(if is_older source dest then (File_store.file dest (page r text); true) else false)
-					|| a)
+		List.fold_left (fun a f ->
+			match f.Conversion.page with None -> false || a
+			| Some page ->
+				let dest = dest ^ f.Conversion.ext in
+				(if is_older source dest || Conversion.Rel.Id_map.mem text.Text.id r.relations
+				 then (File_store.file dest (page r text); true) else false)
+				|| a)
 			false cs
 	| x -> Printf.eprintf "Can't convert Content-Type: %s file: %s" x text.Text.title; false
 
@@ -26,47 +26,60 @@ let converters types kv =
 	let t = if List.(mem "all" n || mem "gmi-atom" n) then (Atom.converter "text/gemini")::t else t in
 	t
 
-let directory converters noindex dir id kv =
-	let empty = Topic_set.Map.empty in
-	let repo = Conversion.{ id; dir; kv; topic_roots = []; topics = empty; texts = [] } in
-	let fn (ts,ls,acc) ((elt,_) as r) =
-		(Topic_set.to_map ts (Text.set "topics" elt)), elt::ls,
+let directory converters noindex repo =
+	let order = File_store.oldest in
+	let repo =
+		let open Conversion in
+		let rels = File_store.fold ~dir:repo.dir ~order Rel.acc_txt Rel.empty_map in
+		let relations = Peers.fold Rel.acc_pck rels in
+		{ repo with relations } in
+	let acc (ts,ls,acc) ((elt,_) as r) = Topic_set.to_map ts (Text.set "topics" elt), elt::ls,
 		if convert converters repo r then acc+1 else acc in
-	let topics, texts, count = File_store.(fold ~dir ~order:newest fn (empty,[],0)) in
-	let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" kv)
+	let topics, texts, count =
+		File_store.fold ~dir:repo.Conversion.dir ~order acc (Topic_set.Map.empty, [], 0) in
+	let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" repo.kv)
 		with Not_found -> Topic_set.roots topics in
-	let repo = Conversion.{ repo with topic_roots; topics; texts } in
-	if not noindex then List.iter (fun c -> match c.Conversion.indices with None -> () | Some f -> f repo) converters;
+	let repo = Conversion.{ repo with topic_roots; topics; texts = List.rev texts } in
+	if not noindex then
+		List.iter (fun c -> match c.Conversion.indices with None -> () | Some f -> f repo) converters;
 	Printf.printf "Converted: %d Indexed: %d\n" count (List.length texts)
 
-let at_path types noindex path =
-	match path with "" -> prerr_endline "unspecified text file or directory"
-	| dir when Sys.file_exists dir && Sys.is_directory dir ->
-		let fname = Filename.concat dir "index.pck" in
-		(match Header_pack.of_string @@ File_store.to_string fname with
-		| Error s -> prerr_endline s
+let load_kv dir =
+	let kv = File_store.of_kv_file () in
+	let idx = Filename.concat dir "index.pck" in
+	if not (Sys.file_exists idx) then kv else
+		match Header_pack.of_string @@ File_store.to_string (idx) with
+		| Error s -> prerr_endline s; kv
 		| Ok { info; peers; _ } ->
-			let kv = let f = Filename.concat dir ".convert.conf" in (* TODO: better place to store convert conf? *)
-				if Sys.file_exists f then File_store.of_kv_file f else Store.KV.empty in
+			let kv = if Store.KV.mem "Id" kv then kv else Store.KV.add "Id" info.Header_pack.id kv in
 			let kv = if Store.KV.mem "Title" kv then kv else Store.KV.add "Title" info.Header_pack.title kv in
-			let kv = Store.KV.add "Locations" (String.concat ";\n" info.Header_pack.locations) kv in
+			let kv = if Store.KV.mem "Locations" kv then kv else Store.KV.add "Locations" (String.concat ";\n" info.Header_pack.locations) kv in
 			let kv = Store.KV.add "Peers" (String.concat ";\n" Header_pack.(to_str_list peers)) kv in
-			let cs = converters types kv in
-			directory cs noindex dir info.Header_pack.id kv)
+			kv
+
+let at_path types noindex path = match path with
+	| "" -> prerr_endline "unspecified text file or directory"
 	| path when Sys.file_exists path ->
-		let repo = Conversion.{
-			id = ""; dir = ""; kv = Store.KV.empty; topic_roots = [];
-			topics = Topic_set.Map.empty; texts = [] } in
-		let cs = converters types repo.kv in
-		(match File_store.to_text path with
-		| Ok text -> ignore @@ convert cs repo (text, [path])
-		| Error s -> prerr_endline s)
+		if Sys.is_directory path then (
+			let kv = load_kv path in
+			let repo = { (Conversion.empty ()) with dir = path; kv } in
+			directory (converters types kv) noindex repo
+		) else (
+			match File_store.to_text path with
+			| Error s -> prerr_endline s
+			| Ok text ->
+				let dir = "." in
+				let open Conversion in
+				let relations = File_store.(fold ~dir ~order:newest Rel.acc_txt Rel.empty_map) in
+				let repo = { (Conversion.empty ()) with dir; kv = load_kv ""; relations } in
+				ignore @@ convert (converters types repo.kv) repo (text, [path])
+		)
 	| path -> Printf.eprintf "Path doesn't exist: %s" path
 
 open Cmdliner
 let term =
 	let path = Arg.(value & pos 0 string "" & info [] ~docv:"path"
-		~doc:"Text file or directory to convert. Ff directory is provided, it must contain an index.pck (see: txt index)") in
+		~doc:"Text file or directory to convert. If directory is provided, it must contain an index.pck (see: txt index)") in
 	let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"output type"
 		~doc:"Convert to file type") in
 	let noindex = Arg.(value & flag & info ["noindex"]

cli/dune

@@ -1,5 +1,6 @@
 (executable
  (name txt)
  (public_name txt)
- (modules txt authors convert conversion 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/edit.ml

@@ -0,0 +1,16 @@
+open Cmdliner
+let term =
+	let id = Arg.(value & pos 0 string "" & info [] ~docv:"text ID") in
+	let recurse = Arg.(value & flag & info ["R"] ~doc:"recurse, include subdirs") in
+	let reverse = Arg.(value & flag & info ["r"] ~doc:"reverse order") in
+	let time   = Arg.(value & flag & info ["t"] ~doc:"sort by time, newest first") in
+	let number = Arg.(value & opt (some int) None & info ["n"]
+		~docv:"number" ~doc:"number of entries to list") in
+	let authed = Arg.(value & opt (some string) None & info ["authored"]
+		~docv:"comma-separated names" ~doc:"texts by authors") in
+	let topics = Arg.(value & opt (some string) None & info ["topics"]
+		~docv:"comma-separated topics" ~doc:"texts with topics") in
+	Term.(const (Logarion.Archive.apply_sys_util "EDITOR" "nano") $ recurse $ time $ reverse $ number $ authed $ topics $ id),
+	Term.info "edit" ~doc: "edit a text" ~man:[ `S "DESCRIPTION";
+		`P "Launches $EDITOR with text path as parameter. If -R is used, the ID search space
+		includes texts found in subdirectories too" ]

cli/html.ml

@@ -1,9 +1,9 @@
 type templates_t = { header: string option; footer: string option }
-type t = { templates : templates_t }
+type t = { templates : templates_t; style : string }
 
 let ext = ".htm"
 let empty_templates = { header = None; footer = None }
-let default_opts = { templates = empty_templates }
+let default_opts = { templates = empty_templates; style = "" }
 
 let init kv =
 	let open Logarion in
@@ -12,38 +12,44 @@ let init kv =
 		| exception Not_found -> None in
 	let header = to_string "HTM-header" kv in
 	let footer = to_string "HTM-footer" kv in
-	{ templates = { header; footer} }
+	let style = match to_string "HTM-style" kv with
+		| Some s -> Printf.sprintf "<style>%s</style>" s | None -> "" in
+	{ templates = { header; footer}; style }
 
 let wrap conv htm text_title body =
-	let site_title = try Logarion.Store.KV.find "Title" conv.Conversion.kv
-		with Not_found -> "" in
+	let site_title = try Logarion.Store.KV.find "Title" conv.Conversion.kv with Not_found -> "" in
 	let replace x = let open Str in
-		global_replace (regexp "{{archive-title}}") site_title x
+		   global_replace (regexp "{{archive-title}}") site_title x
 		|> global_replace (regexp "{{text-title}}") text_title
 	in
-	let header = match htm.templates.header with 
-	| Some x -> replace x
-	| None -> "<header><a href='.'>" ^ site_title ^
-		"</a><nav><a href='feed.atom' id='feed'>feed</a></nav></header>"
+	let feed = try Logarion.Store.KV.find "HTM-feed" conv.Conversion.kv
+		with Not_found -> if Sys.file_exists (Filename.concat conv.Conversion.dir "feed.atom")
+			then "feed.atom" else "" in
+	let header = match htm.templates.header with
+		| Some x -> replace x
+		| None -> Printf.(sprintf "<header><a href='.'>%s</a>%s</header>" site_title
+				(if feed <> "" then sprintf "<nav><a href='%s' id='feed'>feed</a></nav>" feed else ""))
 	in
 	let footer = match htm.templates.footer with None -> "" | Some x -> replace x in
- 	Printf.sprintf "<!DOCTYPE HTML><html><head><title>%s%s</title>\n\
-	<link rel='stylesheet' href='main.css'>\
-	<link rel='alternate' href='feed.atom' type='application/atom+xml'>\
+	Printf.sprintf "<!DOCTYPE HTML><html><head><title>%s%s</title>\n%s\n%s\
 	<meta charset='utf-8'/><meta name='viewport' content='width=device-width, initial-scale=1.0'>\
 	</head><body>\n%s%s%s</body></html>"
 	text_title (if site_title <> "" then (" • " ^ site_title) else "")
+	htm.style
+	(if feed <> "" then Printf.sprintf "<link rel='alternate' href='%s' type='application/atom+xml'>" feed else "")
 	header body footer
 
-let topic_link root topic = 
+let topic_link root topic =
 	let replaced_space = String.map (function ' '->'+' | x->x) in
 	"<a href='index." ^ root ^ ".htm#" ^ replaced_space topic ^ "'>"
 	^ String.capitalize_ascii topic ^ "</a>"
 
 module HtmlConverter = struct
 	include Converter.Html
-	let angled_uri u a = if String.sub u 0 10 <> "urn:txtid:" then
-		angled_uri u a else angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a
+	let uid_uri u a = Printf.sprintf "%s<a href='%s%s'>&lt;%s&gt;</a>" a u ext u
+	let angled_uri u a =
+		if try String.sub u 0 10 = "urn:txtid:" with Invalid_argument _ -> false
+		then angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a else angled_uri u a
 end
 
 let page htm conversion text =
@@ -54,8 +60,7 @@ let page htm conversion text =
 	let opt_kv key value = if String.length value > 0
 		then "<dt>" ^ key ^ "<dd>" ^ value else "" in
 (*	let author acc auth = sep_append acc Person.(auth.name ^ " ") in*)
-	let authors = (Person.Set.to_string text.authors ^ " ") in
-	let keywords = str_set "keywords" text in
+	let authors = Person.Set.to_string text.authors in
 	let header =
 		let time x = Printf.sprintf {|<time datetime="%s">%s</time>|}
 			(Date.rfc_string x) (Date.pretty_date x) in
@@ -64,14 +69,27 @@ let page htm conversion text =
 				let ts = Topic_set.of_string t in
 				sep_append a (List.fold_left (fun a t -> sep_append ~sep:" > " a (topic_link (List.hd ts) t)) "" ts) in
 			String_set.fold to_linked x "" in
+		let ref_links x =
+			let link l = HtmlConverter.uid_uri l "" in
+			String_set.fold (fun r a -> sep_append a (link r)) x ""
+		in
+		let references, replies = let open Conversion in
+			let Rel.{ref_set; rep_set; _} =
+				try Rel.Id_map.find text.id conversion.relations
+				with Not_found -> Rel.empty in
+			ref_links ref_set, ref_links rep_set
+		in
 		"<article><header><dl>"
 		^ opt_kv "Title:" text.title
 		^ opt_kv "Authors:" authors
-		^ opt_kv "Date: " (time (Date.listing text.date))
-		^ opt_kv "Series: " (str_set "series" text)
-		^ opt_kv "Topics: " (topic_links (set "topics" text))
-		^ opt_kv "Keywords: " keywords
-		^ opt_kv "Id: " text.id
+		^ opt_kv "Date:" (time (Date.listing text.date))
+		^ opt_kv "Series:" (str_set "series" text)
+		^ opt_kv "Topics:" (topic_links (set "topics" text))
+		^ opt_kv "Id:" text.id
+		^ opt_kv "Refers:" (ref_links (set "references" text))
+		^ opt_kv "In reply to:" (ref_links (set "in-reply-to" text))
+		^ opt_kv "Referred by:" references
+		^ opt_kv "Replies:" replies
 		^ {|</dl></header><pre style="white-space:pre-wrap">|} in
 	wrap conversion htm text.title ((T.of_string text.body header) ^ "</pre></article>")
 
@@ -150,7 +168,7 @@ let topic_main_index conv htm topic_roots metas =
 		(fold_topic_roots topic_roots
 		^ "<nav><h1>Latest</h1><ul>" ^ to_dated_links ~limit:8 metas
 		^ {|</ul><a href="index.date.htm">More by date</a>|}
-		^ let peers = Logarion.Store.KV.find "Peers" conv.kv in
+		^ let peers = try Logarion.Store.KV.find "Peers" conv.kv with Not_found -> "" in
 			(if peers = "" then "" else
 				List.fold_left (fun a s -> Printf.sprintf {|%s<li><a href="%s">%s</a>|} a s s) "<h1>Peers</h1><ul>"
 				(Str.split (Str.regexp ";\n") (Logarion.Store.KV.find "Peers" conv.kv))

cli/index.ml

@@ -63,17 +63,9 @@ let index r print title auth locs peers =
 	else (File_store.file r.index_path (Header_pack.string pack))
 
 let load dir =
+	let kv = File_store.of_kv_file () in
 	let index_path = Filename.concat dir "index.pck" in
-	let pck = match Header_pack.of_string @@ File_store.to_string index_path with
-	| Error s -> failwith s | Ok pck -> pck 
-	| exception (Sys_error _) -> Header_pack.{
-		info = { version = version; id = Id.generate (); title = ""; people = []; locations = [] };
-		fields;
-		texts = of_text_list @@ File_store.fold ~dir
-			(fun a (t,_) -> of_text a t) [];
-		peers = Msgpck.of_list [];
-	} in
-	index { dir; index_path; pck }
+	index { dir; index_path; pck = Header_pack.of_kv kv }
 
 open Cmdliner
 let term =

cli/listing.ml

@@ -2,7 +2,8 @@ open Logarion
 module FS = File_store
 module A = Archive
 
-let listing r order_opt reverse_opt number_opt paths_opt authors_opt topics_opt =
+let listing r order_opt reverse_opt number_opt paths_opt authors_opt topics_opt dir =
+	let dir = if dir = "" then FS.txtdir () else dir in
 	let predicates = A.predicate A.authored authors_opt @ A.predicate A.topics topics_opt in
 	let predicate text = List.fold_left (fun a e -> a && e text) true predicates in
 	let list_text (t, fnames) = Printf.printf "%s %s %s 𐄁 %s%s\n"
@@ -11,12 +12,12 @@ let listing r order_opt reverse_opt number_opt paths_opt authors_opt topics_opt
 		t.Text.title (if paths_opt then (List.fold_left (Printf.sprintf "%s\n@ %s") "" fnames) else "")
 	in
 	match order_opt with
-	| false -> FS.iter ~r ~predicate list_text
+	| false -> FS.iter ~r ~dir ~predicate list_text
 	| true ->
 		let order = match reverse_opt with true -> FS.newest | false -> FS.oldest in
 		match number_opt with
-		| Some number -> FS.iter ~r ~predicate ~order ~number list_text
-		| None -> FS.iter ~r ~predicate ~order list_text
+		| Some number -> FS.iter ~r ~dir ~predicate ~order ~number list_text
+		| None -> FS.iter ~r ~dir ~predicate ~order list_text
 
 open Cmdliner
 let term =
@@ -30,7 +31,10 @@ let term =
 		~docv:"comma-separated names" ~doc:"texts by authors") in
 	let topics = Arg.(value & opt (some string) None & info ["topics"]
 		~docv:"comma-separated topics" ~doc:"texts with topics") in
-	Term.(const listing $ recurse $ time $ reverse $ number $ paths $ authed $ topics),
+	let dir  = Arg.(value & pos 0 string "" & info []
+		~docv:"directory to index") in
+	Term.(const listing $ recurse $ time $ reverse $ number $ paths $ authed $ topics $ dir),
 	Term.info "list" ~doc:"list texts" ~man:[ `S "DESCRIPTION";
-		`P "List header information for current directory. If -R is used, list header
-		information for texts found in subdirectories too, along with their filepaths" ]
+		`P "Diplays text id, date, author, title for a directory.
+		If directory argument is ommitted, $txtdir is used, where empty value defaults to ~/.local/share/texts.
+		If -R is used, list header information for texts found in subdirectories too." ]

cli/new.ml

@@ -2,18 +2,16 @@ open Logarion
 open Cmdliner
 
 let new_txt title topics_opt interactive =
-	let t = match title with "" -> "Draft" | _ -> title in
-	let authors = Person.Set.of_string (Sys.getenv "USER") in
-	let text = { (Text.blank ()) with title = t; authors } in
-	let text = try Text.with_str_set text "Topics" (Option.get topics_opt)
-		with _ -> text in
+	let kv = Logarion.File_store.of_kv_file () in
+	let authors = Person.Set.of_string (try Logarion.Store.KV.find "Authors" kv
+		with Not_found -> Sys.getenv "USER") in
+	let text = { (Text.blank ()) with title; authors } in
+	let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _->text in
 	match File_store.with_text text with
 	| Error s -> prerr_endline s
 	| Ok (filepath, _note) ->
-		if not interactive then print_endline filepath
-		else
-			(print_endline @@ "Created: " ^ filepath;
-			Sys.command ("$EDITOR " ^ filepath) |> ignore)
+		if interactive then (Sys.command ("$EDITOR " ^ filepath) |> ignore);
+		print_endline filepath
 
 let term =
 	let title = Arg.(value & pos 0 string "" & info []

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.pack.info.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/publish.ml

@@ -1,30 +1,54 @@
-let targets () =
-	let home =
-		try Sys.getenv "txtpubdir" with Not_found ->
-		try Sys.getenv "HOME" with Not_found -> ""
-	in
-	List.filter
-		(fun x -> try Sys.is_directory (snd x) with Sys_error _ -> false)
-		[
-			"htm", home ^ "/public_html/txt";
-			"gmi", home ^ "/public_gemini/txt";
-			"", home ^ "/public_gopher/txt";
-		]
+let targets pubdir = List.fold_left
+	(fun a x ->
+		let path = Filename.concat pubdir (snd x) in
+		try if Sys.is_directory path then (fst x, path)::a else a with Sys_error _ -> a)
+	[]
+	["htm,atom", "public_html/"; "gmi,gmi-atom", "public_gemini/"; "", "public_gopher/"]
+
+let wizard () =
+	print_endline "No txt.conf found. It's required for the repository name & id. Create one? (y/N)";
+	match input_line stdin with
+	|"y"->
+		let title =
+			print_endline "Title for repository: ";
+			input_line stdin in
+		let authors =
+			print_endline "Authors (format: name <name@email> <http://website>): ";
+			input_line stdin in
+		Logarion.File_store.file "txt.conf"
+			(Printf.sprintf "Id: %s\nTitle: %s\nAuthors: %s\n" (Logarion.Id.generate ()) title authors);
+		Logarion.File_store.of_kv_file ()
+	| _ -> print_endline "Create a txt.conf and run publish again"; exit 1
 
 open Logarion
-let publish ids =
+let publish pubdir ids =
+	let kv =
+		match Logarion.File_store.of_kv_file ()
+		with x when x = Logarion.Store.KV.empty -> wizard () | x -> x in
 	let predicate t = List.mem t.Text.id ids in
-	let targets = targets () in
-	let pub_dirs = List.map (fun x -> snd x) targets in
-	try File_store.iter ~predicate (fun (_t, p) -> File.file ((List.hd p)::pub_dirs))
-	with Unix.Unix_error (Unix.EEXIST, _, _) -> ();
-	List.iter (fun t ->
-		Index.((load (snd t)) false None None None None);
-		Convert.at_path (fst t) false (snd t))
-		targets
+	let pubdir_source, pubdir = match pubdir with Some d -> "--pubdir ", d | None ->
+		try "txt.conf:Pubdir", Logarion.Store.KV.find "Pubdir" kv with Not_found ->
+		try "$txtpubdir", Sys.getenv "txtpubdir" with Not_found -> "$txtpubdir", ""
+	in
+	let targets = targets pubdir in
+	if targets = [] then
+		Printf.eprintf "No target directories in %s='%s' (for example %s)\n"
+			pubdir_source pubdir (Filename.concat pubdir "public_html")
+	else begin
+		let pub_dirs = List.map (fun x -> snd x) targets in
+		File_store.iter ~predicate (fun (_t, p) ->
+			try File.file ((List.hd p)::pub_dirs)
+			with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
+		List.iter (fun t -> Printf.eprintf "%s %s\n" (fst t) (snd t);
+			Index.((load (snd t)) false None None None None);
+			Convert.at_path (fst t) false (snd t))
+			targets
+	end
 
 open Cmdliner
 let term =
 	let ids = Arg.(value & pos_all string [] & info [] ~docv:"text ids") in
-	let doc = "convert texts into standard public dirs public_{html,gemini,gopher} if they exist" in
-	Term.(const publish $ ids), Term.info "publish" ~doc ~man:[ `S "DESCRIPTION"; `P doc ]
+	let pubdir = Arg.(value & opt (some string) None & info ["p"; "pubdir"] ~docv:"directory path"
+		~doc:"set top directory for publishing files") in
+	let doc = "convert texts into standard public dirs pubdir/public_{html,gemini,gopher} if they exist" in
+	Term.(const publish $ pubdir $ ids), Term.info "publish" ~doc ~man:[ `S "DESCRIPTION"; `P doc ]

cli/pull.ml

@@ -75,7 +75,7 @@ let pull_text url dir id =
 			let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (fname dir text) in
 			output_string file txt; close_out file
 
-let per_text url dir filter print i id time title authors topics = match id with
+let per_text url dir filter print i id time title authors topics _refs _reps = match id with
 	| "" -> Printf.eprintf "\nInvalid id for %s\n" title
 	| id -> let open Logarion in
 		print i;
@@ -86,13 +86,26 @@ 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 ->
 		match Logarion.Header_pack.of_string (Buffer.contents body) with
 		| Error s -> Printf.printf "Error with %s: %s\n" url s; false
+		| Ok pk when pk.info.id = "" ->
+			Printf.printf "Empty ID index.pck, skipping %s\n" url; false
+		| Ok pk when not (validate_id_length pk.info.id) ->
+			Printf.printf "Index pack ID longer than 32 characters, skipping %s\n" url; false
+		| Ok pk when not (validate_id_chars pk.info.id) ->
+			Printf.printf "Index pack contains invalid ID characters, skipping %s\n" url; false
 		| Ok pk ->
 			let dir = Filename.concat Logarion.Peers.text_dir pk.info.id in
 			Logarion.File_store.with_dir dir;
@@ -105,15 +118,21 @@ let pull_index url authors_opt topics_opt =
 				authors = (match authors_opt with Some s -> Person.Set.of_string s | None -> Person.Set.empty);
 				topics =( match topics_opt with Some s -> String_set.of_string s | None -> String_set.empty);
 			} in
-			let print = printers (string_of_int @@ Logarion.Header_pack.numof_texts pk) pk.info.title dir in
+			let name = match pk.info.title with "" -> url | title -> title in
+			let print = printers (string_of_int @@ Logarion.Header_pack.numof_texts pk) name dir in
 			try Logarion.Header_pack.iteri (per_text url dir filter print) pk; print_newline (); true
-			with Invalid_argument msg -> Printf.eprintf "\nFailed to parse %s: %s\n%!" url msg; false
+			with Invalid_argument msg -> Printf.printf "\nFailed to parse %s: %s\n%!" url msg; false
 
 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 open Logarion in
+	let fold_locations init peer =
+		ignore @@ List.fold_left pull init peer.Peers.pack.Header_pack.info.locations;
+		false
+	in
+	ignore @@ Peers.fold fold_locations false;
 	Curl.global_cleanup ()
 
 let pull url auths topics = match url with

cli/read.ml

@@ -1,24 +1,4 @@
 open Logarion
-module FS = File_store
-module A = Archive
-
-let print r order_opt reverse_opt number_opt authors_opt topics_opt id_opt =
-	let predicates = if id_opt <> "" then [ A.ided id_opt ] else []
-		@ A.predicate A.authored authors_opt
-		@ A.predicate A.topics topics_opt in
-	let predicate text = List.fold_left (fun a e -> a && e text) true predicates in
-	let pager = try Sys.getenv "PAGER" with Not_found -> "less" in
-	let print_text acc (_t, fnames) = Printf.sprintf "%s %s" acc (List.hd fnames) in
-	let paths = match order_opt with
-	| false -> FS.fold ~r ~predicate print_text ""
-	| true ->
-		let order = match reverse_opt with true -> FS.newest | false -> FS.oldest in
-		match number_opt with
-		| Some number -> FS.fold ~r ~predicate ~order ~number print_text ""
-		| None -> FS.fold ~r ~predicate ~order print_text ""
-	in if paths = "" then ()
-	else (ignore @@ Sys.command @@ Printf.sprintf "%s %s" pager paths)
-	
 
 open Cmdliner
 let term =
@@ -32,7 +12,7 @@ let term =
 		~docv:"comma-separated names" ~doc:"texts by authors") in
 	let topics = Arg.(value & opt (some string) None & info ["topics"]
 		~docv:"comma-separated topics" ~doc:"texts with topics") in
-	Term.(const print $ recurse $ time $ reverse $ number $ authed $ topics $ id),
+	Term.(const (Archive.apply_sys_util "PAGER" "less") $ recurse $ time $ reverse $ number $ authed $ topics $ id),
 	Term.info "read" ~doc: "read a text" ~man:[ `S "DESCRIPTION";
 		`P "List header information for current directory. If -R is used, list header
 		information for texts found in subdirectories too, along with their filepaths" ]

cli/recent.ml

@@ -13,7 +13,9 @@ let term =
 		~docv:"comma-separated names" ~doc:"texts by authors") in
 	let topics = Arg.(value & opt (some string) None & info ["topics"]
 		~docv:"comma-separated topics" ~doc:"texts with topics") in
-	Term.(const Listing.listing $ recurse $ (const true) $ reverse $ number $ paths $ authed $ topics),
+	let dir  = Arg.(value & pos 0 string "" & info []
+		~docv:"directory to index") in
+	Term.(const Listing.listing $ recurse $ (const true) $ reverse $ number $ paths $ authed $ topics $ dir),
 	Term.info "recent" ~doc:"list recent texts" ~man:[ `S "DESCRIPTION";
 		`P "List header information of most recent texts. If -R is used, list header
 		information for texts found in subdirectories too, along with their filepaths" ]

cli/txt.ml

@@ -3,17 +3,19 @@ let version = "%%VERSION%%"
 open Cmdliner
 let default_cmd =
 	let doc = "Discover, collect & exchange texts" in
-	let man = [ `S "Contact"; `P "<mailto:fox@orbitalfox.eu?subject=Logarion>" ] in
+	let man = [ `S "Contact"; `P "<mailto:logarion@lists.tildeverse.org?subject=Logarion>" ] in
 	Term.(ret (const (`Help (`Pager, None)))), Term.info "txt" ~version ~doc ~man
 
 let () = match Term.eval_choice default_cmd [
 	Authors.term;
 	Convert.term;
+	Edit.term;
 	File.term; File.unfile_term;
 	Index.term;
 	Last.term;
 	Listing.term;
 	New.term;
+	Peers.term;
 	Publish.term;
 	Pull.term;
 	Read.term;

dune-project

@@ -1,7 +1,7 @@
 (lang dune 2.0)
 (name logarion)
 (license EUPL-1.2)
-(maintainers "orbifx <fox@orbitalfox.eu>")
+(maintainers "orbifx <orbifx@disroot.org>")
 (homepage "http://logarion.orbitalfox.eu")
 (source (uri git+https://git.disroot.org/orbifx/logarion.git))
 
@@ -10,4 +10,4 @@
 (package
  (name logarion)
  (synopsis "Texts archival and exchange")
- (depends text_parse (cmdliner (<= 1.0.4)) msgpck ocurl))
+ (depends (cmdliner (<= 1.0.4)) msgpck ocurl))

header

@@ -4,6 +4,7 @@ Topics:  Comma seperated list of topic names & phrases
 Title:   A title for the text, ideally less than 70 characters   
 Authors: List of name with optional set of <address>
 Date-edited: ISO8601, use only when text edited
+References: list of text ID links
 
 A blank line must follow the last header field.
 

install

@@ -2,6 +2,5 @@ Install development version
 
 Requirements are ocaml (the compiler) and opam (the package manager). Then run:
 
-	opam pin add text_parse https://git.disroot.org/orbifx/text-parse-ml.git
 	opam pin add logarion https://git.disroot.org/orbifx/logarion.git
 	opam install logarion

lib/archive.ml

@@ -5,7 +5,10 @@ let authored query_string =
   fun n -> Person.Set.predicate q n.Text.authors
 
 let ided query_string =
-	fun n -> n.Text.id = query_string
+	let len = String.length query_string in
+	fun n ->
+		try String.sub n.Text.id 0 len = query_string
+		with Invalid_argument _ -> false
 
 let keyworded query_string =
   let q = String_set.query query_string in
@@ -14,3 +17,20 @@ let keyworded query_string =
 let topics query_string =
   let q = String_set.query query_string in
   fun n -> String_set.(predicate q (Text.set "Topics" n))
+
+let apply_sys_util env def_env r order_opt reverse_opt number_opt authors_opt topics_opt id_opt =
+	let predicates = if id_opt <> "" then [ ided id_opt ] else []
+		@ predicate authored authors_opt
+		@ predicate topics topics_opt in
+	let predicate text = List.fold_left (fun a e -> a && e text) true predicates in
+	let util = try Sys.getenv env with Not_found -> def_env in
+	let print_text acc (_t, fnames) = Printf.sprintf "%s %s" acc (List.hd fnames) in
+	let paths = match order_opt with
+	| false -> File_store.fold ~r ~predicate print_text ""
+	| true ->
+		let order = match reverse_opt with true -> File_store.newest | false -> File_store.oldest in
+		match number_opt with
+		| Some number -> File_store.fold ~r ~predicate ~order ~number print_text ""
+		| None -> File_store.fold ~r ~predicate ~order print_text ""
+	in if paths = "" then ()
+	else (ignore @@ Sys.command @@ Printf.sprintf "%s %s" util paths)

lib/date.ml

@@ -15,3 +15,8 @@ let now () = Unix.time () |> Unix.gmtime |>
 let to_secs date =
 	Scanf.sscanf date "%4d-%02d-%02dT%02d:%02d:%02d"
 		(fun y mo d h mi s -> (y-1970)*31557600 + mo*2629800 + d*86400 + h*3600 + mi*60 + s)
+let of_secs s =
+	let { Unix.tm_sec=seconds; tm_min=minutes; tm_hour=hours;
+		tm_mday=day; tm_mon=month; tm_year=year; _ } = Unix.localtime (float_of_int s) in
+		Printf.sprintf "%4d-%02d-%02dT%02d:%02d:%02d"
+			(year+1900) (month+1) day hours minutes seconds

lib/file_store.ml

@@ -3,11 +3,18 @@ type item_t = t list
 type record_t = Text.t * item_t
 
 let extension = ".txt"
-let def_dir () = try Sys.getenv "txtdir" with Not_found ->
+
+let txtdir () = try Sys.getenv "txtdir" with Not_found ->
 	let share = Filename.concat (Sys.getenv "HOME") ".local/share/texts/" in
 	match Sys.is_directory share with true -> share
 	| false | exception (Sys_error _) -> "."
 
+let cfgpath () = match "txt.conf" with
+	| filepath when Sys.file_exists filepath -> filepath
+	| _ -> match Filename.concat (Sys.getenv "HOME") ".config/txt/txt.conf" with
+		| filepath when Sys.file_exists filepath -> filepath
+		| _ -> ""
+
 let to_string f =
 	let ic = open_in f in
 	let s = really_input_string ic (in_channel_length ic) in
@@ -62,7 +69,7 @@ let list_fs ?(r=false) dir =
 	let valid_dir f = r && String.get f 0 <> '.' && Sys.is_directory f in
 	let expand_dir d = Array.(to_list @@ map (Filename.concat d) (Sys.readdir d)) in
 	let rec loop result = function
-		| f::fs when valid_dir f -> expand_dir f |> List.append fs |> loop result
+		| f::fs when valid_dir f -> prerr_endline f; expand_dir f |> List.append fs |> loop result
 		| f::fs -> loop (f::result) fs
 		| [] -> result in
 	let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else
@@ -80,13 +87,13 @@ let fold_sort_take ?(predicate=fun _ -> true) ?(number=None) comp flist =
 	@@ List.fast_sort comp @@ TextMap.bindings
 	@@ List.fold_left (fold_valid_text predicate) new_iteration flist
 
-let iter ?(r=false) ?(dir=def_dir ()) ?(predicate=fun _ -> true) ?order ?number fn =
+let iter ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn =
 	let flist = list_fs ~r dir in match order with
 	| Some comp -> List.iter fn @@ fold_sort_take ~predicate ~number comp flist
 	| None -> List.iter fn @@ TextMap.bindings @@
 		List.fold_left (fold_valid_text predicate) new_iteration flist
 
-let fold ?(r=false) ?(dir=def_dir ()) ?(predicate=fun _ -> true) ?order ?number fn acc =
+let fold ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn acc =
 	let flist = list_fs ~r dir in match order with
 	| Some comp -> List.fold_left fn acc @@ fold_sort_take ~predicate ~number comp flist
 	| None -> List.fold_left fn acc @@ TextMap.bindings @@
@@ -117,11 +124,11 @@ let versioned_basename_of_title ?(version=0) repo extension (title : string) =
 	next version
 
 let id_filename repo extension text =
-	let basename = Text.alias text in
-	let candidate = Filename.concat repo (text.id ^ "." ^ basename ^ extension) in
+	let description = match Text.alias text with "" -> "" | x -> "." ^ x in
+	let candidate = Filename.concat repo (text.id ^ description ^ extension) in
 	if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
 
-let with_text ?(dir=def_dir ()) new_text =
+let with_text ?(dir=txtdir ()) new_text =
 	match id_filename dir extension new_text with
 	| Error _ as e -> e
 	| Ok path ->
@@ -133,10 +140,11 @@ module Config = struct
 	let key_value k v a = Store.KV.add k (String.trim v) a
 end
 
-let of_kv_file path =
+let of_kv_file ?(path=cfgpath ()) () =
 	let open Text_parse in
 	let subsyntaxes = Parsers.Key_value.[|
 		(module Make (Config) : Parser.S with type t = Config.t); (module Make (Config)); |] in
 	let of_string text acc =
 		Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
-	of_string (to_string @@ path) Store.KV.empty
+	if path <> "" then of_string (to_string @@ path) Store.KV.empty
+	else Store.KV.empty

lib/header_pack.ml

@@ -10,7 +10,8 @@ let persons ps = Msgpck.of_list @@ List.rev @@ Person.Set.fold (fun p a -> perso
 
 let str = Msgpck.of_string
 let str_list ls = Msgpck.of_list @@ List.map str ls
-let to_str_list x = List.map Msgpck.to_string (Msgpck.to_list x)
+let to_str_list x = List.map Msgpck.to_string
+	(try Msgpck.to_list x with e -> prerr_endline "to_str_list"; raise e)
 
 let of_set field t =
 	List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) []
@@ -19,7 +20,10 @@ let date = function "" -> Int32.zero | date -> Int32.of_int (Date.to_secs date)
 
 let to_sec = function Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x
 
-let fields = Msgpck.(List [String "id"; String "time";  String "title"; String "authors"; String "topics"])
+let fields = Msgpck.(List [
+	String "id"; String "time";  String "title"; String "authors"; String "topics";
+	String "references"; String "replies";
+	])
 let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack)
 
 let to_info = function
@@ -35,8 +39,13 @@ let of_info i = let open Msgpck in
 let of_text a t =
 	let open Text in
 	Msgpck.(List [
-		of_id t.id; of_uint32 (date (Date.listing t.date));
-		String t.title; persons t.authors; List (of_set "topics" t)
+		of_id t.id;
+		of_uint32 (date (Date.listing t.date));
+		String t.title;
+		persons t.authors;
+		List (of_set "topics" t);
+		List (of_set "references" t);
+		List (of_set "in-reply-to" t);
 	]) :: a
 
 let of_text_list l = Msgpck.List l
@@ -53,6 +62,17 @@ let unpack = function
 
 let of_string s = unpack @@ snd @@ Msgpck.StringBuf.read s
 
+let of_kv kv =
+	let find k kv = try Store.KV.find k kv with Not_found -> "" in
+	let find_ls k kv = try String_set.list_of_csv (Store.KV.find k kv) with Not_found -> [] in
+	{
+		info = { version = version; id = find "Id" kv; title = find "Title" kv;
+			people = find_ls "Authors" kv; locations = find_ls "Locations" kv };
+		fields;
+		texts = Msgpck.List [];
+		peers = str_list (find_ls "Peers" kv);
+	}
+
 let list filename = try
 	let texts_list = function
 	| Msgpck.List (_info :: _fields :: [texts]) -> Msgpck.to_list texts
@@ -64,34 +84,50 @@ let list filename = try
 let contains text = function
 	| Msgpck.List (id::_time::title::_authors::_topics::[]) ->
 		(match to_id id with
-		 | "" -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title); false
+		 | "" -> Printf.eprintf "Invalid id for %s" (Msgpck.to_string title); false
 		 | id -> text.Text.id = id)
 	| _ -> prerr_endline ("Invalid record pattern"); false
 
 let numof_texts pack = List.length (Msgpck.to_list pack.texts)
 
-let iteri fn pack =
-	let of_pck i = function Msgpck.List (id::time::title::authors::topics::[]) ->
+let txt_iter_apply fn i = function
+	| Msgpck.List (id::time::title::authors::topics::extra) ->
 		let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i
 			| x -> Msgpck.to_uint32 x in
 		let id = to_id id in
 		let title = Msgpck.to_string title in
 		let topics = to_str_list topics in
 		let authors = to_str_list authors in
-		fn i id t title authors topics
-	| _  -> prerr_endline ("\n\nInvalid record structure\n\n")
-	in List.iteri of_pck (Msgpck.to_list pack.texts);
+		let references, replies =
+			try begin match extra with [] -> [], []
+			| refs::[] -> to_str_list refs, []
+			| refs::replies::_xs -> to_str_list refs, to_str_list replies
+			end with e -> prerr_endline "iter ref reps"; raise e
+		in
+		fn i id t title authors topics references replies
+	| x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x)
 
-(*let pack_filename ?(filename="index.pck") archive =*)
-(*	let dir = Store.KV.find "Export-Dir" archive.File_store.kv in (*raises Not_found*)*)
-(*	dir ^ "/" ^ filename*)
+let txt_fold_apply fn i = function
+	| Msgpck.List (id::time::title::authors::topics::extra) ->
+		let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i
+			| x -> Msgpck.to_uint32 x in
+		let id = to_id id in
+		let title = Msgpck.to_string title in
+		let topics = to_str_list topics in
+		let authors = to_str_list authors in
+		let references, replies = begin match extra with
+			| [] -> [], []
+			| refs::[] -> to_str_list refs, []
+			| refs::replies::_xs -> to_str_list refs, to_str_list replies
+			end
+		in
+		fn i id t title authors topics references replies
+	| x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x); i
 
-(*let add archive records =*)
-(*	let fname = pack_filename archive in*)
-(*	let append published (t, _f) = if List.exists (contains t) published then published else to_pack published t in*)
-(*	match list fname with Error e -> prerr_endline e | Ok published_list ->*)
-(*		let header_pack = List.fold_left append published_list records in*)
-(*		let archive = Msgpck.(List [*)
-(*			Int 0; String archive.File_store.name; persons archive.people]) in*)
-(*		File_store.file fname @@ Bytes.to_string*)
-(*			@@ Msgpck.Bytes.to_string (List [archive; fields; Msgpck.List header_pack])*)
+let iteri fn pack = List.iteri
+	(txt_iter_apply fn)
+	(Msgpck.to_list pack.texts)
+
+let fold fn init pack = List.fold_left
+	(fun acc m -> try txt_fold_apply fn acc m with Invalid_argument x -> prerr_endline x; acc) init
+	(try Msgpck.to_list pack.texts with e -> prerr_string "Invalid pack.texts"; raise e)

lib/id.ml

@@ -12,7 +12,7 @@ let random_state = Random.State.make_self_init
 (*end*)
 
 type t = string
-let compare = String.compare	
+let compare = String.compare
 let nil = ""
 
 let short ?(len) id =

lib/peers.ml

@@ -1,16 +1,22 @@
-let text_dir = Filename.concat (File_store.def_dir ()) "peers"
+let text_dir = Filename.concat (File_store.txtdir ()) "peers"
+
+type t = { path: string; pack: Header_pack.t }
 
 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 pack -> fn init { path; pack }
+			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

lib/reference_set.ml

@@ -0,0 +1 @@
+module Map = Map.Make(String)

lib/string_set.ml

@@ -1,7 +1,12 @@
 include Set.Make(String)
 
 let list_of_csv x = Str.(split (regexp " *, *")) (String.trim x)
-let of_string x = of_list (list_of_csv x)
+let list_of_ssv x = Str.(split (regexp " +")) (String.trim x)
+
+let of_string ?(separator=list_of_csv) x = of_list (separator x)
+let of_csv_string x = of_string ~separator:list_of_csv x
+let of_ssv_string x = of_string ~separator:list_of_ssv x
+
 let to_string ?(pre="") ?(sep=", ") s =
   let j a x = match a, x with "", _ -> x | _, "" -> a | _ -> a ^ sep ^ x in
   fold (fun x acc -> j acc x) s pre