- Removed 'txt init'
Format - New B32 ID Index - New option: txt index --print - Move scheme to peers - Replace peer.*.conf files with index packed locations Instead of adding a URL to peers.*.conf, run `txt pull <url>` Conversion - Rewritten converters - txt-convert looks for a .convert.conf containing `key: value` lines. - Specifiable topic-roots from .convert.conf. - Added `Topics:` key, with comma seperated topics. If set only those topics will appear in the main index and used as topic roots. Other topics will have sub-indices generated, but won't be listed in the main index. - HTML converter header & footer options - HTML-index renamed to HTM-index Internal - Change types: uuid:Uuid -> id:string - File_store merges identical texts - Use peer ID for store path, store peers' texts in .local/share/texts - Simple URN resolution for converter Continue to next feed if parsing one fails - Phasing-out Archive, replaced by improved packs - Eliminate Bos, Cohttp, lwt, uri, tls, Re, Ptime, dependencies - Lock version for Cmdliner, fix dune-project - Optional resursive store - Improve header_pack - Fix recursive mkdir
This commit is contained in:
orbifx
parent
22fe21326f
commit
e878dedbb6
6
Makefile
6
Makefile
|
|
@ -2,7 +2,7 @@ all:
|
||||||
dune build
|
dune build
|
||||||
|
|
||||||
cli:
|
cli:
|
||||||
dune build cli/cli.exe
|
dune build cli/txt.exe
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
dune clean
|
dune clean
|
||||||
|
|
@ -10,9 +10,9 @@ clean:
|
||||||
tgz:
|
tgz:
|
||||||
dune subst
|
dune subst
|
||||||
dune build
|
dune build
|
||||||
cp _build/default/cli/cli.exe txt
|
cp _build/default/cli/txt.exe txt
|
||||||
strip 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
|
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
|
rm txt
|
||||||
|
|
||||||
.PHONY: cli
|
.PHONY: cli
|
||||||
|
|
|
||||||
|
|
@ -9,11 +9,11 @@ let opt_element tag_name content =
|
||||||
|
|
||||||
module P = Parsers.Plain_text.Make (Converter.Html)
|
module P = Parsers.Plain_text.Make (Converter.Html)
|
||||||
|
|
||||||
let id txt = "<id>urn:uuid:" ^ Logarion.(Id.to_string txt.Text.uuid) ^ "</id>"
|
let id txt = "<id>urn:uuid:" ^ Logarion.(txt.Text.id) ^ "</id>"
|
||||||
let title text = "<title>" ^ esc text.Logarion.Text.title ^ "</title>"
|
let title text = "<title>" ^ esc text.Logarion.Text.title ^ "</title>"
|
||||||
|
|
||||||
let authors text =
|
let authors text =
|
||||||
let u acc addr = acc ^ element "uri" (Uri.to_string addr) in
|
let u acc addr = acc ^ element "uri" addr in
|
||||||
let open Logarion in
|
let open Logarion in
|
||||||
let fn txt a =
|
let fn txt a =
|
||||||
a ^ "<author>" ^ (opt_element "name" @@ esc txt.Person.name)
|
a ^ "<author>" ^ (opt_element "name" @@ esc txt.Person.name)
|
||||||
|
|
@ -51,7 +51,7 @@ let feed title archive_id base_url alternate_type texts =
|
||||||
{|<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom" xml:base="|} ^ base_url ^ {|"><title>|}
|
{|<?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="|}
|
^ title ^ {|</title><link rel="alternate" type="|} ^ alternate_type ^ {|" href="|}
|
||||||
^ base_url ^ {|/" /><link rel="self" type="application/atom+xml" href="|}
|
^ base_url ^ {|/" /><link rel="self" type="application/atom+xml" href="|}
|
||||||
^ self ^ {|" /><id>urn:uuid:|} ^ Logarion.Id.to_string archive_id ^ "</id><updated>"
|
^ self ^ {|" /><id>urn:uuid:|} ^ archive_id ^ "</id><updated>"
|
||||||
^ Ptime.to_rfc3339 (Ptime_clock.now ()) ^ "</updated>\n"
|
^ Logarion.Date.now () ^ "</updated>\n"
|
||||||
^ List.fold_left (fun acc t -> acc ^ entry base_url t) "" texts
|
^ List.fold_left (fun acc t -> acc ^ entry base_url t) "" texts
|
||||||
^ "</feed>"
|
^ "</feed>"
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,17 @@
|
||||||
|
open Logarion
|
||||||
|
let authors r topics_opt =
|
||||||
|
let predicates = Archive.(predicate topics topics_opt) in
|
||||||
|
let predicate text = List.fold_left (fun a e -> a && e text) true predicates in
|
||||||
|
let author_union a (e, _) = Person.Set.union a e.Text.authors in
|
||||||
|
let s = File_store.fold ~r ~predicate author_union Person.Set.empty in
|
||||||
|
Person.Set.iter (fun x -> print_endline (Person.to_string x)) s
|
||||||
|
|
||||||
|
open Cmdliner
|
||||||
|
let term =
|
||||||
|
let recurse = Arg.(value & flag & info ["R"]
|
||||||
|
~doc:"include texts in subdirectories too") in
|
||||||
|
let topics = Arg.(value & opt (some string) None & info ["topics"]
|
||||||
|
~docv:"TOPICS" ~doc:"display authors who have written on topics") in
|
||||||
|
Term.(const authors $ recurse $ topics),
|
||||||
|
Term.info "authors" ~doc:"list authors"
|
||||||
|
~man:[ `S "DESCRIPTION"; `P "List author names" ]
|
||||||
142
cli/cli.ml
142
cli/cli.ml
|
|
@ -1,142 +0,0 @@
|
||||||
let version = "%%VERSION%%"
|
|
||||||
|
|
||||||
open Cmdliner
|
|
||||||
open Logarion
|
|
||||||
module A = Logarion.Archive.Make(File_store)
|
|
||||||
|
|
||||||
(* TODO: merge in lib/ so other modules can use (.e.g HTTP pull) *)
|
|
||||||
let text_list order_opt reverse_opt number_opt values_opt authors_opt topics_opt =
|
|
||||||
match A.of_path (Sys.getcwd ()) with
|
|
||||||
| Error msg -> prerr_endline msg
|
|
||||||
| Ok archive ->
|
|
||||||
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 print_fold ~predicate fn =
|
|
||||||
let ts = A.fold ~predicate fn String_set.empty archive in
|
|
||||||
String_set.iter (print_endline) ts
|
|
||||||
in
|
|
||||||
let list_text (t, fname) = print_endline (Text.short_id t ^ " " ^ t.Text.title ^ "\t" ^ fname) in
|
|
||||||
match values_opt with
|
|
||||||
| Some "topics" -> print_fold ~predicate (fun a (e,_) -> (String_set.union a (Text.set "topics" e)))
|
|
||||||
| Some "authors" ->
|
|
||||||
let s = A.fold ~predicate (fun a (e,_) -> Person.Set.union a e.Text.authors) Person.Set.empty archive in
|
|
||||||
print_endline @@ Person.Set.to_string s
|
|
||||||
| Some x -> prerr_endline @@ "Unrecognised field: " ^ x
|
|
||||||
| None -> match order_opt with
|
|
||||||
| false -> A.iter ~predicate list_text archive
|
|
||||||
| true ->
|
|
||||||
let order = match reverse_opt with true -> A.newest | false -> A.oldest in
|
|
||||||
match number_opt with
|
|
||||||
| Some number -> A.iter ~predicate ~order ~number list_text archive
|
|
||||||
| None -> A.iter ~predicate ~order list_text archive
|
|
||||||
|
|
||||||
let list_term =
|
|
||||||
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 values = Arg.(value & opt (some string) None & info ["values"] ~docv:"HEADER-FIELD" ~doc:"unique values for header field") in
|
|
||||||
let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv:"AUTHORS" ~doc:"texts by authors") in
|
|
||||||
let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"TOPICS" ~doc:"texts with topics") in
|
|
||||||
Term.(const text_list $ time $ reverse $ number $ values $ authed $ topics),
|
|
||||||
Term.info "list" ~doc:"list texts" ~man:[ `S "DESCRIPTION"; `P "List texts" ]
|
|
||||||
|
|
||||||
let print_last search_mine =
|
|
||||||
let last a ((t,_) as pair) = match a with None -> Some pair
|
|
||||||
| Some (t', _) as pair' -> if Text.newest t t' > 0 then Some pair else pair' in
|
|
||||||
match A.of_path (Sys.getcwd ()) with
|
|
||||||
| Error msg -> prerr_endline msg
|
|
||||||
| Ok archive ->
|
|
||||||
let last_mine a ((t,_) as pair) =
|
|
||||||
let open Text in
|
|
||||||
match a with None ->
|
|
||||||
if Person.Set.subset archive.A.archivists t.authors then Some pair else None
|
|
||||||
| Some (t', _) as pair' ->
|
|
||||||
if Text.newest t t' > 0 && Person.Set.subset archive.A.archivists t'.authors
|
|
||||||
then Some pair else pair'
|
|
||||||
in
|
|
||||||
match A.fold (if search_mine then last_mine else last) None archive with
|
|
||||||
| Some (_,f) -> print_endline f | None -> ()
|
|
||||||
|
|
||||||
let last_term =
|
|
||||||
let mine = Arg.(value & flag & info ["mine"] ~doc:"last text authored by me") in
|
|
||||||
Term.(const print_last $ mine),
|
|
||||||
Term.info "last" ~doc:"most recent test" ~man:[ `S "DESCRIPTION"; `P "Print the filename of most recent text" ]
|
|
||||||
|
|
||||||
let split_filetypes files =
|
|
||||||
let acc (dirs, files) x = if Sys.is_directory x then (x::dirs, files) else (dirs, x::files) in
|
|
||||||
List.fold_left acc ([],[]) files
|
|
||||||
|
|
||||||
let file files = match A.of_path "." with
|
|
||||||
| Error msg -> prerr_endline msg
|
|
||||||
| Ok _archive ->
|
|
||||||
let dirs, files = split_filetypes files in
|
|
||||||
let _link_as_named dir file = Unix.link file (dir ^"/"^ file) in
|
|
||||||
let link_with_id dir file =
|
|
||||||
match File_store.to_text file with Error s -> prerr_endline s
|
|
||||||
| Ok t -> Unix.link file (dir ^"/"^ String.sub (Id.to_string (t.Text.uuid)) 0 8 ^".txt")
|
|
||||||
in
|
|
||||||
let link = link_with_id in
|
|
||||||
List.iter (fun d -> List.iter (link d) files) dirs
|
|
||||||
|
|
||||||
let file_term =
|
|
||||||
let files = Arg.(value & pos_all string [] & info [] ~doc:"filenames") in
|
|
||||||
let doc = "file texts in directories" in
|
|
||||||
let man = [ `S "DESCRIPTION"; `P doc ] in
|
|
||||||
Term.(const file $ files), Term.info "file" ~doc ~man
|
|
||||||
|
|
||||||
let unfile files = match A.of_path "." with
|
|
||||||
| Error msg -> prerr_endline msg
|
|
||||||
| Ok _archive ->
|
|
||||||
let dirs, files = split_filetypes files in
|
|
||||||
let unlink dir file = try Unix.unlink (dir ^"/"^ file) with Unix.(Unix_error(ENOENT,_,_))-> () in
|
|
||||||
List.iter (fun d -> List.iter (unlink d) files) dirs
|
|
||||||
|
|
||||||
let unfile_term =
|
|
||||||
let files = Arg.(value & pos_all string [] & info [] ~doc:"filenames") in
|
|
||||||
let doc = "unfile texts from directories" in
|
|
||||||
let man = [ `S "DESCRIPTION"; `P doc ] in
|
|
||||||
Term.(const unfile $ files), Term.info "unfile" ~doc ~man
|
|
||||||
|
|
||||||
let init _force = File_store.init ()
|
|
||||||
|
|
||||||
let init_term =
|
|
||||||
let force = Arg.(value & flag & info ["f"; "force"] ~doc:"Initialise even if directory is not empty") in
|
|
||||||
let doc = "initialise a text repository in present directory" in
|
|
||||||
let man = [ `S "DESCRIPTION"; `P "Start an archive in current directory" ] in
|
|
||||||
Term.(const init $ force), Term.info "init" ~doc ~man
|
|
||||||
|
|
||||||
let new_term =
|
|
||||||
let f title topics_opt interactive =
|
|
||||||
match A.of_path "." with
|
|
||||||
| Error m -> prerr_endline m
|
|
||||||
| Ok archive ->
|
|
||||||
let t = match title with "" -> "Draft" | _ -> title in
|
|
||||||
let authors = archive.archivists in
|
|
||||||
let date = Date.({ created = Some (Ptime_clock.now ()); edited = None }) in
|
|
||||||
let text = { (Text.blank ()) with title = t; authors; date } in
|
|
||||||
let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _ -> text in
|
|
||||||
match File_store.with_text archive text with
|
|
||||||
| Error s -> prerr_endline s
|
|
||||||
| Ok (filepath, _note) ->
|
|
||||||
match interactive with false -> print_endline filepath
|
|
||||||
| true ->
|
|
||||||
print_endline @@ "Created: " ^ filepath;
|
|
||||||
let _code = Sys.command ("$EDITOR " ^ filepath) in
|
|
||||||
()
|
|
||||||
in
|
|
||||||
let title = Arg.(value & pos 0 string "" & info [] ~docv:"TITLE" ~doc:"Title for new article") in
|
|
||||||
let topics= Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"TOPICS" ~doc:"Topics for new article") in
|
|
||||||
let inter = Arg.(value & flag & info ["i"; "interactive"] ~doc:"Prompts through the steps of creation and publication") in
|
|
||||||
let man = [ `S "DESCRIPTION"; `P "Create a new article, with title 'Draft' when none provided"] in
|
|
||||||
Term.(const f $ title $ topics $ inter), Term.info "new" ~doc:"create a new article" ~man
|
|
||||||
|
|
||||||
let default_cmd =
|
|
||||||
let doc = "text archival & publishing" in
|
|
||||||
let man = [ `S "BUGS"; `P "Submit bugs <mailto:logarion@lists.orbitalfox.eu?subject=Issue: " ] in
|
|
||||||
Term.(ret (const (`Help (`Pager, None)))), Term.info "txt" ~version ~doc ~man
|
|
||||||
|
|
||||||
let cmds = [ init_term; new_term; file_term; unfile_term; list_term; last_term; Convert.term; Http.pull_term ]
|
|
||||||
|
|
||||||
let () =
|
|
||||||
Random.self_init();
|
|
||||||
match Term.eval_choice default_cmd cmds with `Error _ -> exit 1 | _ -> exit 0
|
|
||||||
|
|
@ -0,0 +1,14 @@
|
||||||
|
open Logarion
|
||||||
|
type t = {
|
||||||
|
id: string; dir: string;
|
||||||
|
kv: string Store.KV.t;
|
||||||
|
topic_roots: string list;
|
||||||
|
topics: (String_set.t * String_set.t) Topic_set.Map.t;
|
||||||
|
texts: Text.t list
|
||||||
|
}
|
||||||
|
|
||||||
|
type fn_t = {
|
||||||
|
ext: string;
|
||||||
|
page: t -> Logarion.Text.t -> string;
|
||||||
|
indices: t -> unit;
|
||||||
|
}
|
||||||
135
cli/convert.ml
135
cli/convert.ml
|
|
@ -1,90 +1,67 @@
|
||||||
open Logarion
|
open Logarion
|
||||||
module A = Archive.Make (Logarion.File_store)
|
|
||||||
|
|
||||||
let convert_modified source dest fn title text =
|
let is_older source dest = try
|
||||||
if (try Unix.((stat dest).st_mtime < (stat source).st_mtime) with _-> true)
|
Unix.((stat dest).st_mtime < (stat source).st_mtime) with _-> true
|
||||||
then (File_store.file dest (fn title text); true) else false
|
|
||||||
|
|
||||||
let word_fname dir text = dir ^ "/" ^ Text.alias text
|
let convert cs r (text, files) = match Text.str "Content-Type" text with
|
||||||
let id_fname dir text = dir ^ "/" ^ Text.short_id text
|
| "" | "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 ->
|
||||||
|
let dest = dest ^ f.Conversion.ext in
|
||||||
|
if is_older source dest then (File_store.file dest (f.Conversion.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
|
||||||
|
|
||||||
let writer types dir name (text,store_item) = (* todo: single_parser -> [files] *)
|
let converters types kv =
|
||||||
(* convert_modified store_item idfilename (fun _title -> Text.to_string) text.title text;*)
|
let t = [] in
|
||||||
let h = if "htm" = types || "all" = types then
|
let t = if ("htm" = types || "all" = types) then
|
||||||
convert_modified store_item (id_fname dir text ^ ".htm") Html.page name text
|
(let htm = Html.init kv in
|
||||||
else false in
|
Conversion.{ ext = Html.ext; page = Html.page htm; indices = Html.indices htm })::t
|
||||||
let g = if "gmi" = types || "all" = types then
|
else t in
|
||||||
convert_modified store_item (id_fname dir text ^ ".gmi") Gemini.page name text
|
let t = if ("gmi" = types || "all" = types) then
|
||||||
else false in
|
Conversion.{ ext = Gemini.ext; page = Gemini.page; indices = Gemini.indices}::t else t in
|
||||||
h || g
|
t
|
||||||
|
|
||||||
let index_writer types noindex dir archive topic_roots topic_map texts =
|
let convert_all converters noindex dir id kv =
|
||||||
let name = archive.A.name in
|
|
||||||
let file path = File_store.file (dir ^ path) in
|
|
||||||
file "/index.pck" (Header_pack.pack archive texts);
|
|
||||||
if not noindex && ("htm" = types || "all" = types) then (
|
|
||||||
let index_name = try Store.KV.find "HTML-index" archive.File_store.kv
|
|
||||||
with Not_found -> "index.html" in
|
|
||||||
if index_name <> "" then
|
|
||||||
file ("/"^index_name) (Html.topic_main_index name topic_roots texts);
|
|
||||||
file "/index.date.htm" (Html.date_index name texts);
|
|
||||||
List.iter
|
|
||||||
(fun topic -> file ("/index." ^ topic ^ ".htm")
|
|
||||||
(Html.topic_sub_index name topic_map topic texts))
|
|
||||||
topic_roots;
|
|
||||||
let base_url = try Store.KV.find "HTTP-URL" archive.File_store.kv
|
|
||||||
with Not_found -> prerr_endline "Missing `HTTP-URL:` in config"; "" in
|
|
||||||
file "/feed.atom" (Atom.feed archive.A.name archive.A.id base_url "text/html" texts)
|
|
||||||
);
|
|
||||||
if not noindex && ("gmi" = types || "all" = types) then (
|
|
||||||
let index_name = try Store.KV.find "Gemini-index" archive.File_store.kv
|
|
||||||
with Not_found -> "index.gmi" in
|
|
||||||
if index_name <> "" then
|
|
||||||
file ("/"^index_name) (Gemini.topic_main_index name topic_roots texts);
|
|
||||||
file "/index.date.gmi" (Gemini.date_index name texts);
|
|
||||||
List.iter
|
|
||||||
(fun topic -> file ("/index." ^ topic ^ ".gmi")
|
|
||||||
(Gemini.topic_sub_index name topic_map topic texts))
|
|
||||||
topic_roots;
|
|
||||||
let base_url = try Store.KV.find "GEMINI-URL" archive.File_store.kv
|
|
||||||
with Not_found -> prerr_endline "Missing `GEMINI-URL:` in config"; "" in
|
|
||||||
file "/gmi.atom" (Atom.feed archive.A.name archive.A.id base_url "text/gemini" texts)
|
|
||||||
)
|
|
||||||
|
|
||||||
let txt_writer types dir name ((text, _store_item) as r) =
|
|
||||||
match Text.str "Content-Type" text with
|
|
||||||
| "" | "text/plain" -> writer types dir name r
|
|
||||||
| x -> prerr_endline ("Can't convert Content-Type: "^x^" file: " ^text.Text.title); false
|
|
||||||
|
|
||||||
let convert_all types noindex dir archive =
|
|
||||||
let name = archive.A.name in
|
|
||||||
let fn (ts,ls,acc) ((elt,_) as r) =
|
|
||||||
(Topic_set.to_map ts (Text.set "topics" elt)),
|
|
||||||
elt::ls, if txt_writer types dir name r then acc+1 else acc in
|
|
||||||
let empty = Topic_set.Map.empty in
|
let empty = Topic_set.Map.empty in
|
||||||
let topic_map, texts, count = A.(fold ~order:newest fn (empty,[],0) archive) in
|
let repo = Conversion.{ id; dir; kv; topic_roots = []; topics = empty; texts = [] } in
|
||||||
let topic_roots = Topic_set.roots topic_map in
|
let fn (ts,ls,acc) ((elt,_) as r) =
|
||||||
index_writer types noindex dir archive topic_roots topic_map texts;
|
(Topic_set.to_map ts (Text.set "topics" elt)), elt::ls,
|
||||||
print_endline @@ "Converted: " ^ string_of_int (count)
|
if convert converters repo r then acc+1 else acc in
|
||||||
^ "\nIndexed: " ^ string_of_int (List.length texts);
|
let topics, texts, count = File_store.(fold ~dir ~order:newest fn (empty,[],0)) in
|
||||||
Ok ()
|
let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" 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 -> c.Conversion.indices repo) converters;
|
||||||
|
Printf.printf "Converted: %d Indexed: %d\n" count (List.length texts)
|
||||||
|
|
||||||
let convert_dir types noindex cmd_dir =
|
let convert_dir types noindex dir =
|
||||||
let (>>=) = Result.bind in
|
match dir with "" -> prerr_endline "unspecified dir"
|
||||||
let with_dir dir =
|
| dir ->
|
||||||
Result.map_error (function `Msg m -> m)
|
let fname = Filename.concat dir "index.pck" in
|
||||||
Logarion.File_store.Directory.(directory dir |> print ~descr:"export" dir) in
|
match Header_pack.of_string @@ File_store.to_string fname with
|
||||||
(A.of_path "."
|
| Error s -> prerr_endline s
|
||||||
>>= fun archive -> (match cmd_dir with "" -> Error "unspecified export dir" | x -> Ok x)
|
| Ok { info; _ } ->
|
||||||
>>= fun dir -> with_dir dir
|
let kv = let f = Filename.concat dir ".convert.conf" in (* TODO: better place to store convert conf? *)
|
||||||
>>= fun _ -> convert_all types noindex dir { archive with store = dir })
|
if Sys.file_exists f then File_store.of_kv_file f else Store.KV.empty in
|
||||||
|> function Ok () -> () | Error x -> prerr_endline x
|
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 cs = converters types kv in
|
||||||
|
convert_all cs noindex dir info.Header_pack.id kv
|
||||||
|
|
||||||
open Cmdliner
|
open Cmdliner
|
||||||
|
|
||||||
let term =
|
let term =
|
||||||
let directory = Arg.(value & pos 0 string "" & info [] ~docv:"target directory" ~doc:"Directory to convert into") in
|
let directory = Arg.(value & pos 0 string "" & info [] ~docv:"target directory"
|
||||||
let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"TYPES" ~doc:"Convert to type") in
|
~doc:"Directory to convert") in
|
||||||
let noindex = Arg.(value & flag & info ["noindex"] ~doc:"don't write an index when converting") in
|
let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"TYPES"
|
||||||
|
~doc:"Convert to type") in
|
||||||
|
let noindex = Arg.(value & flag & info ["noindex"]
|
||||||
|
~doc:"don't create indices in target format") in
|
||||||
Term.(const convert_dir $ types $ noindex $ directory),
|
Term.(const convert_dir $ types $ noindex $ directory),
|
||||||
Term.info "convert" ~doc:"convert archive" ~man:[ `S "DESCRIPTION"; `P "Convert Logarion archive" ]
|
Term.info "convert" ~doc:"convert txts"
|
||||||
|
~man:[ `S "DESCRIPTION"; `P "Convert texts within a directory to another format.
|
||||||
|
Directory must contain an index.pck. Run `txt index` first." ]
|
||||||
|
|
|
||||||
6
cli/dune
6
cli/dune
|
|
@ -1,5 +1,5 @@
|
||||||
(executable
|
(executable
|
||||||
(name cli)
|
(name txt)
|
||||||
(public_name txt)
|
(public_name txt)
|
||||||
(modules cli convert html atom gemini)
|
(modules txt authors convert conversion file index last listing new topics html atom gemini pull)
|
||||||
(libraries logarion logarion.http re.str cmdliner bos ptime ptime.clock.os text_parse.converter text_parse.parsers msgpck))
|
(libraries text_parse.converter text_parse.parsers logarion msgpck curl str cmdliner))
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,39 @@
|
||||||
|
let split_filetypes files =
|
||||||
|
let acc (dirs, files) x = if Sys.is_directory x
|
||||||
|
then (x::dirs, files) else (dirs, x::files) in
|
||||||
|
List.fold_left acc ([],[]) files
|
||||||
|
|
||||||
|
open Logarion
|
||||||
|
let file files =
|
||||||
|
let dirs, files = split_filetypes files in
|
||||||
|
let _link_as_named dir file = Unix.link file (Filename.concat dir file) in
|
||||||
|
let link_with_id dir file =
|
||||||
|
match File_store.to_text file with Error s -> prerr_endline s
|
||||||
|
| Ok t -> Unix.link file (Filename.concat dir (Text.short_id t^".txt")) in
|
||||||
|
let link = link_with_id in
|
||||||
|
List.iter (fun d -> List.iter (link d) files) dirs
|
||||||
|
|
||||||
|
let unfile files =
|
||||||
|
let dirs, files = split_filetypes files in
|
||||||
|
let unlink dir file = try Unix.unlink (Filename.concat dir file)
|
||||||
|
with Unix.(Unix_error(ENOENT,_,_))-> () in
|
||||||
|
List.iter (fun d -> List.iter (unlink d) files) dirs
|
||||||
|
|
||||||
|
open Cmdliner
|
||||||
|
let term =
|
||||||
|
let files = Arg.(value & pos_all string [] & info []
|
||||||
|
~docv:"text filenames and subdirectories") in
|
||||||
|
Term.(const file $ files), Term.info "file"
|
||||||
|
~doc:"file texts in subdirectories"
|
||||||
|
~man:[ `S "DESCRIPTION"; `P "Files all texts in parameter in every
|
||||||
|
directory in parameter, using hardlinks.
|
||||||
|
|
||||||
|
Use it to create sub-repositories for sharing or converting" ]
|
||||||
|
|
||||||
|
let unfile_term =
|
||||||
|
let files = Arg.(value & pos_all string [] & info []
|
||||||
|
~docv:"text filenames and subdirectories") in
|
||||||
|
Term.(const unfile $ files), Term.info "unfile"
|
||||||
|
~doc:"unfile texts from subdirectories"
|
||||||
|
~man:[ `S "DESCRIPTION"; `P "unfile texts in parameter from
|
||||||
|
directories in parameter, by removing hardlinks" ]
|
||||||
|
|
@ -1,9 +1,17 @@
|
||||||
let page _archive_title text =
|
let ext = ".gmi"
|
||||||
|
|
||||||
|
module GeminiConverter = struct
|
||||||
|
include Converter.Gemini
|
||||||
|
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
|
||||||
|
end
|
||||||
|
|
||||||
|
let page _conversion text =
|
||||||
let open Logarion.Text in
|
let open Logarion.Text in
|
||||||
"# " ^ text.title
|
"# " ^ text.title
|
||||||
^ "\nAuthors: " ^ Logarion.Person.Set.to_string text.authors
|
^ "\nAuthors: " ^ Logarion.Person.Set.to_string text.authors
|
||||||
^ "\nDate: " ^ Logarion.Date.(pretty_date @@ listing text.date)
|
^ "\nDate: " ^ Logarion.Date.(pretty_date @@ listing text.date)
|
||||||
^ let module T = Parsers.Plain_text.Make (Converter.Gemini) in
|
^ let module T = Parsers.Plain_text.Make (GeminiConverter) in
|
||||||
"\n" ^ T.of_string text.body ""
|
"\n" ^ T.of_string text.body ""
|
||||||
|
|
||||||
let date_index title meta_list =
|
let date_index title meta_list =
|
||||||
|
|
@ -30,8 +38,9 @@ let to_dated_links ?(limit) meta_list =
|
||||||
^ m.Logarion.Text.title ^ "\n")
|
^ m.Logarion.Text.title ^ "\n")
|
||||||
"" meta_list
|
"" meta_list
|
||||||
|
|
||||||
let topic_link root topic =
|
let topic_link root topic =
|
||||||
"=> index." ^ root ^ ".gmi " ^ String.capitalize_ascii topic ^ "\n"
|
let replaced_space = String.map (function ' '->'+' | x->x) in
|
||||||
|
"=> index." ^ replaced_space root ^ ".gmi " ^ String.capitalize_ascii topic ^ "\n"
|
||||||
|
|
||||||
let text_item path meta =
|
let text_item path meta =
|
||||||
let open Logarion in
|
let open Logarion in
|
||||||
|
|
@ -71,3 +80,25 @@ let topic_main_index title topic_roots metas =
|
||||||
let topic_sub_index title topic_map topic_root metas =
|
let topic_sub_index title topic_map topic_root metas =
|
||||||
"# " ^ title ^ "\n\n"
|
"# " ^ title ^ "\n\n"
|
||||||
^ listing_index topic_map [topic_root] "" metas
|
^ listing_index topic_map [topic_root] "" metas
|
||||||
|
|
||||||
|
let indices r =
|
||||||
|
let open Logarion in
|
||||||
|
let file name = File_store.file (Filename.concat r.Conversion.dir name) in
|
||||||
|
let index_name = try Store.KV.find "Gemini-index" r.kv with Not_found -> "index.gmi" in
|
||||||
|
let title = try Store.KV.find "Title" r.Conversion.kv with Not_found -> "" in
|
||||||
|
|
||||||
|
if index_name <> "" then
|
||||||
|
file index_name (topic_main_index title r.topic_roots r.texts);
|
||||||
|
|
||||||
|
file "index.date.gmi" (date_index title r.texts);
|
||||||
|
|
||||||
|
List.iter
|
||||||
|
(fun topic -> file ("index." ^ topic ^ ".gmi")
|
||||||
|
(topic_sub_index title r.topics topic r.texts))
|
||||||
|
r.topic_roots;
|
||||||
|
|
||||||
|
let base_url = try
|
||||||
|
let _i = Str.(search_forward (regexp "gemini?://[^;]*") (Store.KV.find "Locations" r.kv) 0) in
|
||||||
|
Str.(matched_string (Store.KV.find "Locations" r.kv))
|
||||||
|
with Not_found -> prerr_endline "Missing location for Gemini"; "" in
|
||||||
|
file "gmi.atom" (Atom.feed title r.id base_url "text/gemini" r.texts)
|
||||||
|
|
|
||||||
100
cli/html.ml
100
cli/html.ml
|
|
@ -1,26 +1,57 @@
|
||||||
let wrap (title:string) (subtitle:string) body =
|
type templates_t = { header: string option; footer: string option }
|
||||||
{|<!DOCTYPE HTML>|}
|
type t = { templates : templates_t }
|
||||||
^ {|<html><head><title>|}
|
|
||||||
^ subtitle ^ " | " ^ title
|
let ext = ".htm"
|
||||||
^ {|</title><link rel="stylesheet" href="main.css">|}
|
let empty_templates = { header = None; footer = None }
|
||||||
^ {|<link rel="alternate" href="feed.atom" type="application/atom+xml">|}
|
let default_opts = { templates = empty_templates }
|
||||||
^ {|<meta charset="utf-8"/>|}
|
|
||||||
^ {|<meta name="viewport" content="width=device-width, initial-scale=1.0">|}
|
let init kv =
|
||||||
^ {|</head><body><header><a href=".">|} ^ title
|
let open Logarion in
|
||||||
^ {|</a> <nav><a href="feed.atom" id="feed">feed</a></nav></header>|} ^ body
|
let header = match Store.KV.find "HTM-header" kv with
|
||||||
^ "</body></html>"
|
| fname -> Some (File_store.to_string fname)
|
||||||
|
| exception Not_found -> None in
|
||||||
|
let footer = match Store.KV.find "HTM-footer" kv with
|
||||||
|
| fname -> Some (File_store.to_string fname)
|
||||||
|
| exception Not_found -> None in
|
||||||
|
{ templates = { header; footer} }
|
||||||
|
|
||||||
|
let wrap c htm text_title body =
|
||||||
|
let site_title = try Logarion.Store.KV.find "Title" c.Conversion.kv
|
||||||
|
with Not_found -> "" in
|
||||||
|
let replace x = let open Str in
|
||||||
|
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>"
|
||||||
|
in
|
||||||
|
let footer = match htm.templates.footer with None -> "" | Some x -> replace x in
|
||||||
|
"<!DOCTYPE HTML><html><head><title>" ^ text_title ^ " • " ^ site_title ^ "</title>\n\
|
||||||
|
<link rel='stylesheet' href='main.css'>\
|
||||||
|
<link rel='alternate' href='feed.atom' type='application/atom+xml'>\
|
||||||
|
<meta charset='utf-8'/><meta name='viewport' content='width=device-width, initial-scale=1.0'>\
|
||||||
|
</head><body>\n" ^ header ^ body ^ footer ^ "</body></html>"
|
||||||
|
|
||||||
let topic_link root topic =
|
let topic_link root topic =
|
||||||
let replaced_space = String.map (function ' '->'+' | x->x) in
|
let replaced_space = String.map (function ' '->'+' | x->x) in
|
||||||
{|<a href="index.|} ^ root ^ {|.htm#|} ^ replaced_space topic ^ {|">|}
|
"<a href='index." ^ replaced_space root ^ ".htm#" ^ replaced_space topic ^ "'>"
|
||||||
^ String.capitalize_ascii topic ^ "</a>"
|
^ String.capitalize_ascii topic ^ "</a>"
|
||||||
|
|
||||||
let page archive_title text =
|
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
|
||||||
|
end
|
||||||
|
|
||||||
|
let page htm conversion text =
|
||||||
let open Logarion in
|
let open Logarion in
|
||||||
let open Text in
|
let open Text in
|
||||||
let module T = Parsers.Plain_text.Make (Converter.Html) in
|
let module T = Parsers.Plain_text.Make (HtmlConverter) in
|
||||||
let sep_append ?(sep=", ") a x = match a,x with "",_ -> x | _, "" -> a | _ -> a ^ sep ^ x in
|
let sep_append ?(sep=", ") a x = match a,x with "",_ -> x | _, "" -> a | _ -> a ^ sep ^ x in
|
||||||
let opt_kv key value = if String.length value > 0 then "<dt>" ^ key ^ "<dd>" ^ value else "" in
|
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 author acc auth = sep_append acc Person.(auth.name ^ " ") in*)
|
||||||
let authors = (Person.Set.to_string text.authors ^ " ") in
|
let authors = (Person.Set.to_string text.authors ^ " ") in
|
||||||
let keywords = str_set "keywords" text in
|
let keywords = str_set "keywords" text in
|
||||||
|
|
@ -38,9 +69,9 @@ let page archive_title text =
|
||||||
^ opt_kv "Series: " (str_set "series" text)
|
^ opt_kv "Series: " (str_set "series" text)
|
||||||
^ opt_kv "Topics: " (topic_links (set "topics" text))
|
^ opt_kv "Topics: " (topic_links (set "topics" text))
|
||||||
^ opt_kv "Keywords: " keywords
|
^ opt_kv "Keywords: " keywords
|
||||||
^ opt_kv "Id: " (Id.to_string text.uuid)
|
^ opt_kv "Id: " text.id
|
||||||
^ {|</dl></header><pre style="white-space:pre-wrap">|} in
|
^ {|</dl></header><pre style="white-space:pre-wrap">|} in
|
||||||
wrap archive_title text.title ((T.of_string text.body header) ^ "</pre></article>")
|
wrap conversion htm text.title ((T.of_string text.body header) ^ "</pre></article>")
|
||||||
|
|
||||||
let to_dated_links ?(limit) meta_list =
|
let to_dated_links ?(limit) meta_list =
|
||||||
let meta_list = match limit with
|
let meta_list = match limit with
|
||||||
|
|
@ -57,10 +88,10 @@ let to_dated_links ?(limit) meta_list =
|
||||||
^ {|<a href="|} ^ Logarion.Text.short_id m ^ {|.htm">|} ^ m.Logarion.Text.title ^ "</a><br>")
|
^ {|<a href="|} ^ Logarion.Text.short_id m ^ {|.htm">|} ^ m.Logarion.Text.title ^ "</a><br>")
|
||||||
"" meta_list
|
"" meta_list
|
||||||
|
|
||||||
let date_index ?(limit) title meta_list =
|
let date_index ?(limit) conv htm meta_list =
|
||||||
match limit with
|
match limit with
|
||||||
| Some limit -> wrap title "Index" (to_dated_links ~limit meta_list)
|
| Some limit -> wrap conv htm "Index" (to_dated_links ~limit meta_list)
|
||||||
| None -> wrap title "Index" (to_dated_links meta_list)
|
| None -> wrap conv htm "Index" (to_dated_links meta_list)
|
||||||
|
|
||||||
let fold_topic_roots topic_roots =
|
let fold_topic_roots topic_roots =
|
||||||
let list_item root t = "<li>" ^ topic_link root t in
|
let list_item root t = "<li>" ^ topic_link root t in
|
||||||
|
|
@ -112,14 +143,35 @@ let listing_index topic_map topic_roots path metas =
|
||||||
in
|
in
|
||||||
"<nav><h1>Texts</h1>" ^ item_group topic_roots ^ "</nav>"
|
"<nav><h1>Texts</h1>" ^ item_group topic_roots ^ "</nav>"
|
||||||
|
|
||||||
let topic_main_index title topic_roots metas =
|
let topic_main_index conv htm topic_roots metas =
|
||||||
wrap title "Topics"
|
wrap conv htm "Topics"
|
||||||
(fold_topic_roots topic_roots
|
(fold_topic_roots topic_roots
|
||||||
^ "<nav><h1>Latest</h1>" ^ to_dated_links ~limit:10 metas
|
^ "<nav><h1>Latest</h1>" ^ to_dated_links ~limit:10 metas
|
||||||
^ {|<a href="index.date.htm">More by date</a></nav>|} )
|
^ {|<a href="index.date.htm">More by date</a></nav>|} )
|
||||||
|
|
||||||
let topic_sub_index title topic_map topic_root metas =
|
let topic_sub_index conv htm topic_map topic_root metas =
|
||||||
wrap title topic_root
|
wrap conv htm topic_root
|
||||||
(fold_topics topic_map [topic_root] metas
|
(fold_topics topic_map [topic_root] metas
|
||||||
(* ^ {|<a href=".atom" id="feed">|}^ String.capitalize_ascii topic_root ^{| feed </a>|}*)
|
(* ^ {|<a href=".atom" id="feed">|}^ String.capitalize_ascii topic_root ^{| feed </a>|}*)
|
||||||
^ listing_index topic_map [topic_root] "" metas)
|
^ listing_index topic_map [topic_root] "" metas)
|
||||||
|
|
||||||
|
open Logarion
|
||||||
|
let indices htm c =
|
||||||
|
let file name = Logarion.File_store.file (Filename.concat c.Conversion.dir name) in
|
||||||
|
let index_name = try Store.KV.find "HTM-index" c.Conversion.kv with Not_found -> "index.html" in
|
||||||
|
let title = try Store.KV.find "Title" c.Conversion.kv with Not_found -> "" in
|
||||||
|
|
||||||
|
if index_name <> "" then
|
||||||
|
file index_name (topic_main_index c htm c.topic_roots c.texts);
|
||||||
|
|
||||||
|
file "index.date.htm" (date_index c htm c.texts);
|
||||||
|
|
||||||
|
List.iter
|
||||||
|
(fun root -> file ("index." ^ root ^ ".htm") (topic_sub_index c htm c.topics root c.texts))
|
||||||
|
c.topic_roots;
|
||||||
|
|
||||||
|
let base_url = try
|
||||||
|
let _i = Str.(search_forward (regexp "https?://[^;]*") (Store.KV.find "Locations" c.kv) 0) in
|
||||||
|
Str.(matched_string (Store.KV.find "Locations" c.kv))
|
||||||
|
with Not_found -> prerr_endline "Missing location for HTTP(S)"; "" in
|
||||||
|
file "feed.atom" (Atom.feed title c.id base_url "text/html" c.texts)
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,59 @@
|
||||||
|
open Logarion
|
||||||
|
|
||||||
|
let index print title authors locations peers dir =
|
||||||
|
let fname = Filename.concat dir "index.pck" in
|
||||||
|
let pck = match Header_pack.of_string @@ File_store.to_string fname with
|
||||||
|
| Error s -> failwith s
|
||||||
|
| Ok pck -> let info = Header_pack.{ pck.info with
|
||||||
|
title = if title <> "" then title else pck.info.title;
|
||||||
|
people = if authors <> ""
|
||||||
|
then (String_set.list_of_csv authors) else pck.info.people;
|
||||||
|
locations = if locations <> ""
|
||||||
|
then (String_set.list_of_csv locations) else pck.info.locations;
|
||||||
|
} in
|
||||||
|
Header_pack.{ info; fields;
|
||||||
|
texts = of_text_list @@ File_store.fold ~dir
|
||||||
|
(fun a (t,_) -> of_text a t) [];
|
||||||
|
peers = if peers <> ""
|
||||||
|
then (str_list @@ String_set.list_of_csv peers) else pck.peers;
|
||||||
|
}
|
||||||
|
| exception (Sys_error _) -> Header_pack.{
|
||||||
|
info = {
|
||||||
|
version = version; id = Id.generate (); title;
|
||||||
|
people = String_set.list_of_csv authors;
|
||||||
|
locations = String_set.list_of_csv locations };
|
||||||
|
fields;
|
||||||
|
texts = of_text_list @@ File_store.fold ~dir
|
||||||
|
(fun a (t,_) -> of_text a t) [];
|
||||||
|
peers = str_list @@ String_set.list_of_csv peers;
|
||||||
|
} in
|
||||||
|
File_store.file fname (Header_pack.string pck);
|
||||||
|
let open Header_pack in
|
||||||
|
let s ss = String.concat "\n\t" ss in
|
||||||
|
if print then
|
||||||
|
Printf.printf "Title: %s\nAuthors: %s\nLocations:\n\t%s\nPeers:\n\t%s\n"
|
||||||
|
pck.info.title (String.concat "," pck.info.people)
|
||||||
|
(s pck.info.locations) (s (to_str_list pck.peers))
|
||||||
|
|
||||||
|
open Cmdliner
|
||||||
|
let term =
|
||||||
|
let print = Arg.(value & flag & info ["print"] ~doc:"print info") in
|
||||||
|
let title= Arg.(value & opt string "" & info ["t"; "title"]
|
||||||
|
~docv:"string" ~doc:"Title for index") in
|
||||||
|
let auth = Arg.(value & opt string "" & info ["a"; "authors"]
|
||||||
|
~docv:"comma-separated names" ~doc:"Index authors") in
|
||||||
|
let locs = Arg.(value & opt string "" & info ["l"; "locations"]
|
||||||
|
~docv:"comma-separated URLs" ~doc:"repository URLs") in
|
||||||
|
let peers= Arg.(value & opt string "" & info ["p"; "peers"]
|
||||||
|
~docv:"comma-separated URLs" ~doc:"URLs to other known text repositories") in
|
||||||
|
let dir = Arg.(value & pos 0 string "." & info []
|
||||||
|
~docv:"directory to index") in
|
||||||
|
let doc = "Generate an index.pck for texts in a directory" in
|
||||||
|
Term.(const index $ print $ title $ auth $ locs $ peers $ dir),
|
||||||
|
Term.info "index" ~doc
|
||||||
|
~man:[ `S "DESCRIPTION"; `Pre "An index contains:\n
|
||||||
|
* an info section with: title for the index, the authors, locations (URLs) the texts can be access\n
|
||||||
|
* listing of texts with: ID, date, title, authors, topics\n
|
||||||
|
* list of other text repositories (peers)\n\n
|
||||||
|
MessagePack format. <msgpack.org>" ]
|
||||||
|
|
||||||
|
|
@ -0,0 +1,24 @@
|
||||||
|
open Logarion
|
||||||
|
let last search_mine =
|
||||||
|
let last a ((t,_) as pair) = match a with None -> Some pair
|
||||||
|
| Some (t', _) as pair' -> if Text.newest t t' > 0
|
||||||
|
then Some pair else pair' in
|
||||||
|
let last_mine a ((t,_) as pair) =
|
||||||
|
let name = Person.Set.of_string (Sys.getenv "USER") in
|
||||||
|
let open Text in
|
||||||
|
match a with
|
||||||
|
| None -> if Person.Set.subset name t.authors then Some pair else None
|
||||||
|
| Some (t', _) as pair' ->
|
||||||
|
if Text.newest t t' > 0 && Person.Set.subset name t'.authors
|
||||||
|
then Some pair else pair'
|
||||||
|
in
|
||||||
|
match File_store.fold (if search_mine then last_mine else last) None with
|
||||||
|
| Some (_,f) -> List.iter print_endline f | None -> ()
|
||||||
|
|
||||||
|
open Cmdliner
|
||||||
|
let term =
|
||||||
|
let mine = Arg.(value & flag & info ["mine"]
|
||||||
|
~doc:"last text authored by me") in
|
||||||
|
Term.(const last $ mine),
|
||||||
|
Term.info "last" ~doc:"most recent text"
|
||||||
|
~man:[ `S "DESCRIPTION"; `P "Print the filename of most recent text" ]
|
||||||
|
|
@ -0,0 +1,38 @@
|
||||||
|
open Logarion
|
||||||
|
module FS = File_store
|
||||||
|
module A = Archive
|
||||||
|
let listing r order_opt reverse_opt number_opt authors_opt topics_opt =
|
||||||
|
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 a (t, fnames) = a ^ Printf.sprintf "%s %s %s 𐄁 %s [%s]\n"
|
||||||
|
(Text.short_id t) Date.(pretty_date @@ listing t.Text.date)
|
||||||
|
(Person.Set.to_string ~names_only:true t.Text.authors)
|
||||||
|
t.Text.title (List.hd fnames)
|
||||||
|
in
|
||||||
|
print_string @@ match order_opt with
|
||||||
|
| false -> FS.fold ~r ~predicate list_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 list_text ""
|
||||||
|
| None -> FS.fold ~r ~predicate ~order list_text ""
|
||||||
|
|
||||||
|
open Cmdliner
|
||||||
|
let term =
|
||||||
|
let recurse = Arg.(value & flag & info ["R"]
|
||||||
|
~doc:"recursive, include texts in subdirectories too") 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 listing $ recurse $ time $ reverse $ number $ authed $ topics),
|
||||||
|
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" ]
|
||||||
|
|
@ -0,0 +1,27 @@
|
||||||
|
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
|
||||||
|
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)
|
||||||
|
|
||||||
|
let term =
|
||||||
|
let title = Arg.(value & pos 0 string "" & info []
|
||||||
|
~docv:"title" ~doc:"Title for new article") in
|
||||||
|
let topics= Arg.(value & opt (some string) None & info ["t"; "topics"]
|
||||||
|
~docv:"comma-separated topics" ~doc:"Topics for new article") in
|
||||||
|
let inter = Arg.(value & flag & info ["i"; "interactive"]
|
||||||
|
~doc:"Prompts through the steps of creation") in
|
||||||
|
Term.(const new_txt $ title $ topics $ inter), Term.info "new"
|
||||||
|
~doc:"create a new article" ~man:[ `S "DESCRIPTION";
|
||||||
|
`P "Create a new article, with title 'Draft' when none provided"]
|
||||||
|
|
@ -0,0 +1,160 @@
|
||||||
|
let writer accum data =
|
||||||
|
Buffer.add_string accum data;
|
||||||
|
String.length data
|
||||||
|
|
||||||
|
let showContent content =
|
||||||
|
Printf.printf "%s" (Buffer.contents content);
|
||||||
|
flush stdout
|
||||||
|
|
||||||
|
let showInfo connection =
|
||||||
|
Printf.printf "Time: %f for: %s\n"
|
||||||
|
(Curl.get_totaltime connection)
|
||||||
|
(Curl.get_effectiveurl connection)
|
||||||
|
|
||||||
|
let getContent connection url =
|
||||||
|
Curl.set_url connection url;
|
||||||
|
Curl.perform connection
|
||||||
|
|
||||||
|
let curl_pull url =
|
||||||
|
let result = Buffer.create 4069
|
||||||
|
and errorBuffer = ref "" in
|
||||||
|
let connection = Curl.init () in
|
||||||
|
try
|
||||||
|
Curl.set_errorbuffer connection errorBuffer;
|
||||||
|
Curl.set_writefunction connection (writer result);
|
||||||
|
Curl.set_followlocation connection true;
|
||||||
|
Curl.set_url connection url;
|
||||||
|
Curl.perform connection;
|
||||||
|
(* showContent result;*)
|
||||||
|
(* showInfo connection;*)
|
||||||
|
Curl.cleanup connection;
|
||||||
|
Ok result
|
||||||
|
with
|
||||||
|
| Curl.CurlException (_reason, _code, _str) ->
|
||||||
|
Curl.cleanup connection;
|
||||||
|
Error (Printf.sprintf "Error: %s %s" url !errorBuffer)
|
||||||
|
| Failure s ->
|
||||||
|
Curl.cleanup connection;
|
||||||
|
Error (Printf.sprintf "Caught exception: %s" s)
|
||||||
|
|
||||||
|
let newer time id dir =
|
||||||
|
match Logarion.File_store.to_text @@ Filename.(concat dir (Logarion.Id.short id) ^ ".txt") with
|
||||||
|
| Error x -> prerr_endline x; true
|
||||||
|
| Ok txt -> time > (Logarion.(Header_pack.date (Date.listing txt.date)))
|
||||||
|
| exception (Sys_error _) -> true
|
||||||
|
|
||||||
|
let print_peers 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
|
||||||
|
|
||||||
|
let parse_index _is_selected fn url dir p =
|
||||||
|
let open Logarion.Header_pack in
|
||||||
|
match Msgpck.to_list p.texts with
|
||||||
|
| [] -> Printf.printf "%s => %s, has empty index\n" p.info.title dir; false
|
||||||
|
| texts ->
|
||||||
|
let numof_texts = string_of_int @@ List.length texts in
|
||||||
|
let text_num_len = String.length numof_texts in
|
||||||
|
Printf.printf "%*d/%s %s => %s\r" text_num_len 0 numof_texts p.info.title dir;
|
||||||
|
let of_pck i x =
|
||||||
|
Printf.printf "\r%*d/%s %!" text_num_len (i+1) numof_texts;
|
||||||
|
match x with
|
||||||
|
| Msgpck.List (id::time::title::_authors::_topics) ->
|
||||||
|
(match Logarion.Header_pack.to_id id with
|
||||||
|
| "" -> Printf.eprintf "Invalid id for%s " (Msgpck.to_string title)
|
||||||
|
| id ->
|
||||||
|
let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x in
|
||||||
|
if newer t id dir then fn url dir id)
|
||||||
|
| _ -> prerr_endline ("Invalid record structure") in
|
||||||
|
List.iteri of_pck texts;
|
||||||
|
print_newline ();
|
||||||
|
true
|
||||||
|
|
||||||
|
let fname dir text = Filename.concat dir (Logarion.Text.short_id text ^ ".txt")
|
||||||
|
let pull_text url dir id =
|
||||||
|
let u = Filename.concat url ((Logarion.Id.short id) ^ ".txt") in
|
||||||
|
match curl_pull u with
|
||||||
|
| Error msg -> Printf.eprintf "Failed getting %s: %s" u msg
|
||||||
|
| Ok txt ->
|
||||||
|
let txt = Buffer.contents txt in
|
||||||
|
match Logarion.Text.of_string txt with
|
||||||
|
| Error s -> prerr_endline s
|
||||||
|
| Ok text ->
|
||||||
|
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (fname dir text) in
|
||||||
|
output_string file txt; close_out file
|
||||||
|
|
||||||
|
let pull_index url _authors _topics =
|
||||||
|
let index_url = 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 ->
|
||||||
|
let dir = Filename.concat Logarion.Peers.text_dir pk.info.id in
|
||||||
|
Logarion.File_store.with_dir dir;
|
||||||
|
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (Filename.concat dir "index.pck") in
|
||||||
|
output_string file ( Logarion.Header_pack.string {
|
||||||
|
pk with info = { pk.info with locations = url::pk.info.locations }});
|
||||||
|
close_out file;
|
||||||
|
(* let predicates = A.predicate A.authored authors_opt*)
|
||||||
|
(* @ A.predicate A.topics topics_opt in*)
|
||||||
|
let is_selected text = List.fold_left (fun a e -> a && e text) true [](*predicates*) in
|
||||||
|
try parse_index is_selected pull_text url dir pk with
|
||||||
|
Invalid_argument msg -> Printf.eprintf "Failed to parse: %s\n%!" 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;
|
||||||
|
Curl.global_cleanup ()
|
||||||
|
|
||||||
|
let pull url auths topics = match url with
|
||||||
|
| "" -> pull_list auths topics | x -> ignore (pull_index x auths topics)
|
||||||
|
|
||||||
|
open Cmdliner
|
||||||
|
let term =
|
||||||
|
let authors = Arg.(value & opt (some string) None & info ["a"; "authors"]
|
||||||
|
~docv:"comma-separated names" ~doc:"filter by authors") in
|
||||||
|
let topics = Arg.(value & opt (some string) None & info ["t"; "topics"]
|
||||||
|
~docv:"comma-separated topics" ~doc:"filter by topics") in
|
||||||
|
let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL"
|
||||||
|
~doc:"Repository location") in
|
||||||
|
Term.(const pull $ url $ authors $ topics),
|
||||||
|
Term.info "pull" ~doc:"pull listed texts" ~man:[ `S "DESCRIPTION";
|
||||||
|
`P "Pull texts from known repositories. To add a new repository use:";
|
||||||
|
`P "txt pull [url]";
|
||||||
|
`P ("This creates a directory in " ^ Logarion.Peers.text_dir
|
||||||
|
^ " and downloads the text index.pck file in it")]
|
||||||
|
|
||||||
|
(*module Msg = struct*)
|
||||||
|
(* type t = string * string*)
|
||||||
|
(* let compare (x0,y0) (x1,y1) =*)
|
||||||
|
(* match compare x1 x0 with 0 -> String.compare y0 y1 | c -> c*)
|
||||||
|
(*end*)
|
||||||
|
(*module MsgSet = Set.Make(Msg)*)
|
||||||
|
(*let pull_msgs url _authors _topics =*)
|
||||||
|
(* match http_apply response url with*)
|
||||||
|
(* | Error msg ->*)
|
||||||
|
(* Printf.eprintf "Failed index request for %s %s" url msg*)
|
||||||
|
(* | Ok body ->*)
|
||||||
|
(* let rec fold_msgs s a fn =*)
|
||||||
|
(* let t, msg = Scanf.bscanf s "%s %s@\n" (fun t m -> t, m) in*)
|
||||||
|
(* if t <> "" then fold_msgs s (fn a t msg) fn else a*)
|
||||||
|
(* in*)
|
||||||
|
(* let s = Scanf.Scanning.from_string body in*)
|
||||||
|
(* let msgs = MsgSet.empty in*)
|
||||||
|
(* let date_string t = Ptime.to_date t |>*)
|
||||||
|
(* fun (y, m, d) -> Printf.sprintf "%04d-%02d-%02d" y m d in*)
|
||||||
|
(* let msgs = fold_msgs s msgs*)
|
||||||
|
(* (fun msgs t m -> match Ptime.of_rfc3339 t with*)
|
||||||
|
(* | Ok (v,_,_) -> let open MsgSet in*)
|
||||||
|
(* let msgs = if cardinal msgs > 1 then remove (max_elt msgs) msgs else msgs in*)
|
||||||
|
(* add (v,m) msgs*)
|
||||||
|
(* | _ -> msgs) in*)
|
||||||
|
(* let msg_string = MsgSet.fold*)
|
||||||
|
(* (fun (t,m) a -> a ^ Printf.sprintf " %s 𐄁 %s\n" (date_string t) m)*)
|
||||||
|
(* msgs "" in*)
|
||||||
|
(* Printf.printf "┌───{ %s }───┐\n%s" url msg_string*)
|
||||||
|
|
@ -0,0 +1,17 @@
|
||||||
|
open Logarion
|
||||||
|
let topics r authors_opt =
|
||||||
|
let predicates = Archive.(predicate authored authors_opt) in
|
||||||
|
let predicate text = List.fold_left (fun a e -> a && e text) true predicates in
|
||||||
|
let topic_union a (e, _) = String_set.union a (Text.set "topics" e) in
|
||||||
|
let s = File_store.fold ~r ~predicate topic_union String_set.empty in
|
||||||
|
print_endline @@ String_set.to_string s
|
||||||
|
|
||||||
|
open Cmdliner
|
||||||
|
let term =
|
||||||
|
let recurse = Arg.(value & flag & info ["R"]
|
||||||
|
~doc:"include texts in subdirectories") in
|
||||||
|
let authed = Arg.(value & opt (some string) None & info ["authored"]
|
||||||
|
~docv:"comma-separated authors" ~doc:"topics by authors") in
|
||||||
|
Term.(const topics $ recurse $ authed),
|
||||||
|
Term.info "topics" ~doc:"list topics" ~man:[ `S "DESCRIPTION";
|
||||||
|
`P "List of topics" ]
|
||||||
|
|
@ -0,0 +1,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
|
||||||
|
Term.(ret (const (`Help (`Pager, None)))), Term.info "txt" ~version ~doc ~man
|
||||||
|
|
||||||
|
let () = match Term.eval_choice default_cmd [
|
||||||
|
Authors.term;
|
||||||
|
Convert.term;
|
||||||
|
File.term; File.unfile_term;
|
||||||
|
Index.term;
|
||||||
|
Last.term;
|
||||||
|
Listing.term;
|
||||||
|
New.term;
|
||||||
|
Pull.term;
|
||||||
|
Topics.term;
|
||||||
|
] with `Error _ -> exit 1 | _ -> exit 0
|
||||||
11
dune-project
11
dune-project
|
|
@ -1,16 +1,13 @@
|
||||||
(lang dune 2.0)
|
(lang dune 2.0)
|
||||||
(name logarion)
|
(name logarion)
|
||||||
(homepage "https://logarion.orbitalfox.eu")
|
|
||||||
|
|
||||||
(source (uri git://orbitalfox.eu/logarion))
|
|
||||||
(license EUPL-1.2)
|
(license EUPL-1.2)
|
||||||
(authors "orbifx")
|
(maintainers "orbifx <fox@orbitalfox.eu>")
|
||||||
(maintainers "fox@orbitalfox.eu")
|
(homepage "http://logarion.orbitalfox.eu")
|
||||||
(bug_reports "mailto:logarion@lists.orbitalfox.eu?subject=Issue:")
|
(source (uri git+https://git.disroot.org/orbifx/logarion.git))
|
||||||
|
|
||||||
(generate_opam_files true)
|
(generate_opam_files true)
|
||||||
|
|
||||||
(package
|
(package
|
||||||
(name logarion)
|
(name logarion)
|
||||||
(synopsis "Texts archival and exchange")
|
(synopsis "Texts archival and exchange")
|
||||||
(depends re cmdliner bos ptime uuidm uri text_parse msgpck cohttp-lwt-unix tls))
|
(depends text_parse (cmdliner (<= 1.0.4)) msgpck ocurl))
|
||||||
|
|
|
||||||
|
|
@ -1,4 +0,0 @@
|
||||||
(library
|
|
||||||
(name http)
|
|
||||||
(public_name logarion.http)
|
|
||||||
(libraries logarion uri cmdliner lwt cohttp cohttp-lwt cohttp-lwt-unix tls msgpck))
|
|
||||||
143
http/http.ml
143
http/http.ml
|
|
@ -1,143 +0,0 @@
|
||||||
let http_body fn uri =
|
|
||||||
let open Lwt in
|
|
||||||
let open Cohttp_lwt_unix in
|
|
||||||
Client.get uri >>= fun (headers, body) ->
|
|
||||||
body |> Cohttp_lwt.Body.to_string >|= fun body -> fn (headers, body)
|
|
||||||
|
|
||||||
let response (headers, body) =
|
|
||||||
let open Cohttp in
|
|
||||||
match Header.get (headers |> Response.headers) "content-type" with
|
|
||||||
| Some "application/msgpack" | Some "application/octet-stream"
|
|
||||||
| Some "text/plain" | Some "text/plain; charset=utf-8" -> Ok body
|
|
||||||
| Some x -> Error ("Invalid content-type: " ^ x)
|
|
||||||
| None -> Ok body
|
|
||||||
|
|
||||||
let http_apply fn uri = Lwt_main.run (http_body fn uri)
|
|
||||||
|
|
||||||
module S = Set.Make(String)
|
|
||||||
|
|
||||||
(*let is_selected sl =*)
|
|
||||||
(* let check str a b c = Option.(fold ~none:(is_none b && is_none c) ~some:(fun x -> x = str) a) in*)
|
|
||||||
(* function*)
|
|
||||||
(* | `Author s -> check s sl.authors sl.topics*)
|
|
||||||
(* | `Topic s -> check s sl.topics sl.authors*)
|
|
||||||
|
|
||||||
(* TODO: parse using Header_pack *)
|
|
||||||
|
|
||||||
let sub_id text = Logarion.(String.sub (text.Text.uuid |> Id.to_string) 0 8)
|
|
||||||
let fname dir text = dir ^ sub_id text ^ ".txt"
|
|
||||||
|
|
||||||
let newer time id dir =
|
|
||||||
match Logarion.File_store.to_text @@ Filename.concat dir (String.sub (Logarion.Id.to_string id) 0 8 ^ ".txt") with
|
|
||||||
| Error x -> prerr_endline x; true
|
|
||||||
| Ok txt -> time > (Logarion.(Header_pack.date (Date.listing txt.date)))
|
|
||||||
| exception (Sys_error _) -> true
|
|
||||||
|
|
||||||
let pull_text url dir id =
|
|
||||||
let path = Uri.path url in
|
|
||||||
let u = Uri.with_path url (path ^ "/" ^ String.sub (Logarion.Id.to_string id) 0 8 ^ ".txt") in
|
|
||||||
match http_apply response u with
|
|
||||||
| Error msg -> prerr_endline @@ " Failed " ^ Uri.to_string u ^ " " ^ msg
|
|
||||||
| Ok txt ->
|
|
||||||
match Logarion.Text.of_string txt with
|
|
||||||
| Error s -> prerr_endline s
|
|
||||||
| Ok text ->
|
|
||||||
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (fname dir text) in
|
|
||||||
output_string file txt; close_out file
|
|
||||||
|
|
||||||
(*TODO: adapt Archive predication function to work with free sets*)
|
|
||||||
let parse_index _is_selected fn url p =
|
|
||||||
let open Logarion.Header_pack in
|
|
||||||
let dir = "peers/" ^ match Uri.host url with
|
|
||||||
None -> "local/" ^ Uri.path url | Some s -> s ^ Uri.path url ^ "/" in
|
|
||||||
Printf.printf "%s => %s\n" p.info.name dir;
|
|
||||||
(match Msgpck.to_list p.peers with [] -> () | ps ->
|
|
||||||
print_string " peers: ";
|
|
||||||
List.iter (fun x -> print_string (" " ^ Msgpck.to_string x)) ps;
|
|
||||||
print_newline ());
|
|
||||||
match Msgpck.to_list p.texts with
|
|
||||||
| [] -> print_endline ", has empty index"
|
|
||||||
| texts ->
|
|
||||||
match Bos.OS.Dir.create ~mode:0o740 (Fpath.v dir) with
|
|
||||||
| Error (`msg s) -> prerr_endline ("Error making domain dir:" ^ s);
|
|
||||||
| _ ->
|
|
||||||
let numof_texts = string_of_int @@ List.length texts in
|
|
||||||
let text_num_len = String.length numof_texts in
|
|
||||||
let of_pck i x =
|
|
||||||
Printf.printf "\r%*d/%s %!" text_num_len (i+1) numof_texts;
|
|
||||||
match x with
|
|
||||||
| Msgpck.List (id::time::title::_authors::_topics) ->
|
|
||||||
(match Logarion.Id.of_bytes Msgpck.(to_bytes id) with
|
|
||||||
| None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title)
|
|
||||||
| Some id ->
|
|
||||||
let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x in
|
|
||||||
if newer t id dir then fn url dir id)
|
|
||||||
| _ -> prerr_endline ("Invalid record structure") in
|
|
||||||
List.iteri of_pck texts;
|
|
||||||
print_newline ()
|
|
||||||
|
|
||||||
let pull_index url _authors _topics =
|
|
||||||
let index_url = Uri.(with_path url (path url ^ "/index.pck")) in
|
|
||||||
match http_apply response index_url with
|
|
||||||
| Error msg -> prerr_endline @@ "Failed index request for " ^ Uri.to_string index_url ^ " " ^ msg
|
|
||||||
| Ok body ->
|
|
||||||
let _i, pack = Msgpck.StringBuf.read body in
|
|
||||||
(* let predicates =*)
|
|
||||||
(* A.predicate A.authored authors_opt*)
|
|
||||||
(* @ A.predicate A.topics topics_opt*)
|
|
||||||
(* in*)
|
|
||||||
let is_selected text = List.fold_left (fun a e -> a && e text) true [](*predicates*) in
|
|
||||||
match Logarion.Header_pack.unpack pack with None -> ()
|
|
||||||
| Some headers -> parse_index is_selected pull_text url headers
|
|
||||||
|
|
||||||
module Msg = struct
|
|
||||||
type t = Ptime.t * string
|
|
||||||
let compare (x0,y0) (x1,y1) = match Ptime.compare x1 x0 with 0 -> String.compare y0 y1 | c -> c
|
|
||||||
end
|
|
||||||
|
|
||||||
module MsgSet = Set.Make(Msg)
|
|
||||||
|
|
||||||
let pull_msgs url _authors _topics = match http_apply response url with
|
|
||||||
| Error msg -> prerr_endline @@ "Failed index request for " ^ Uri.(to_string url) ^ " " ^ msg
|
|
||||||
| Ok body ->
|
|
||||||
let rec fold_msgs s a fn =
|
|
||||||
let t, msg = Scanf.bscanf s "%s %s@\n" (fun t m -> t, m) in
|
|
||||||
if t <> "" then fold_msgs s (fn a t msg) fn else a
|
|
||||||
in
|
|
||||||
let s = Scanf.Scanning.from_string body in
|
|
||||||
let msgs = MsgSet.empty in
|
|
||||||
let date_string t = Ptime.to_date t |>
|
|
||||||
fun (y, m, d) -> Printf.sprintf "%04d-%02d-%02d" y m d in
|
|
||||||
let msgs = fold_msgs s msgs
|
|
||||||
(fun msgs t m -> match Ptime.of_rfc3339 t with
|
|
||||||
| Ok (v,_,_) -> let open MsgSet in
|
|
||||||
let msgs = if cardinal msgs > 1 then remove (max_elt msgs) msgs else msgs in
|
|
||||||
add (v,m) msgs
|
|
||||||
| _ -> msgs) in
|
|
||||||
print_endline ("\n┌────=[ " ^ Uri.to_string url);
|
|
||||||
MsgSet.iter
|
|
||||||
(fun (t,m) -> print_endline
|
|
||||||
("│ " ^ date_string t ^ "\n│ " ^ m ^ "\n└─────────")) msgs
|
|
||||||
|
|
||||||
let pull_url url = match Uri.of_string url with
|
|
||||||
| x when x = Uri.empty -> (fun _ _ -> ())
|
|
||||||
| x when Uri.scheme x = Some "msg+http" -> pull_msgs Uri.(with_scheme x (Some "http"))
|
|
||||||
| x when Uri.scheme x = Some "msg+https"-> pull_msgs Uri.(with_scheme x (Some "https"))
|
|
||||||
| x -> pull_index x
|
|
||||||
|
|
||||||
let pull_list auths topics =
|
|
||||||
let pull peer_url () = pull_url peer_url auths topics in
|
|
||||||
let open Logarion.Peers in
|
|
||||||
fold_file pull () public_fname;
|
|
||||||
fold_file pull () private_fname
|
|
||||||
|
|
||||||
let pull = function "" -> pull_list | x -> pull_url x
|
|
||||||
|
|
||||||
open Cmdliner
|
|
||||||
|
|
||||||
let pull_term =
|
|
||||||
let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"AUTHORS" ~doc:"select authors") in
|
|
||||||
let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"TOPICS" ~doc:"select topics") in
|
|
||||||
let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL" ~doc:"HTTP URL of Logarion") in
|
|
||||||
Term.(const pull $ url $ authors $ topics),
|
|
||||||
Term.info "pull" ~doc:"pull listed texts" ~man:[ `S "DESCRIPTION"; `P "Pull texts from archive at address"]
|
|
||||||
|
|
@ -1,33 +1,13 @@
|
||||||
(*let module S = Set.Make (Text) in*)
|
let predicate fn opt = Option.(to_list @@ map fn opt)
|
||||||
(*let module M = Map.Make (String) in*)
|
|
||||||
(*let module I = Map.Make (Id) in*)
|
|
||||||
(*let aggr = I.empty, M.empty, M.empty, M.empty in*)
|
|
||||||
(*let fn (id, a, t, k) (n,_) =*)
|
|
||||||
(* let id = I.add n.Text.uuid n id in*)
|
|
||||||
(* let a =*)
|
|
||||||
(* let f e a = M.update (e.Person.name) (function Some v -> Some (S.add n v) | None -> Some (S.singleton n)) a in*)
|
|
||||||
(* Person.Set.fold f n.Text.authors a in*)
|
|
||||||
(* let t =*)
|
|
||||||
(* let f e a = M.update e (function Some v -> Some (S.add n v) | None -> Some (S.singleton n)) a in*)
|
|
||||||
(* String_set.fold f (Text.set "Topics" n) t in*)
|
|
||||||
(* let k =*)
|
|
||||||
(* let f e a = M.update e (function Some v -> Some (S.add n v) | None -> Some (S.singleton n)) a in*)
|
|
||||||
(* String_set.fold f (Text.set "Keywords" n) k in*)
|
|
||||||
(* (id, a, t, k)*)
|
|
||||||
|
|
||||||
module Make (Store : Store.T) = struct
|
let authored query_string =
|
||||||
include Store
|
let q = Person.Set.of_query @@ String_set.query query_string in
|
||||||
let predicate fn opt = Option.(to_list @@ map fn opt)
|
fun n -> Person.Set.predicate q n.Text.authors
|
||||||
|
|
||||||
let authored query_string =
|
let keyworded query_string =
|
||||||
let q = Person.Set.of_query @@ String_set.query query_string in
|
let q = String_set.query query_string in
|
||||||
fun n -> Person.Set.predicate q n.Text.authors
|
fun n -> String_set.(predicate q (Text.set "Keywords" n))
|
||||||
|
|
||||||
let keyworded query_string =
|
let topics query_string =
|
||||||
let q = String_set.query query_string in
|
let q = String_set.query query_string in
|
||||||
fun n -> String_set.(predicate q (Text.set "Keywords" n))
|
fun n -> String_set.(predicate q (Text.set "Topics" n))
|
||||||
|
|
||||||
let topics query_string =
|
|
||||||
let q = String_set.query query_string in
|
|
||||||
fun n -> String_set.(predicate q (Text.set "Topics" n))
|
|
||||||
end
|
|
||||||
|
|
|
||||||
20
lib/date.ml
20
lib/date.ml
|
|
@ -1,8 +1,14 @@
|
||||||
type t = { created: Ptime.t option; edited: Ptime.t option }
|
type t = { created: string; edited: string }
|
||||||
let compare = compare
|
let compare = compare
|
||||||
let rfc_string date = match date with Some t -> Ptime.to_rfc3339 t | None -> ""
|
let rfc_string date = date
|
||||||
let of_string (rfc : string) = match Ptime.of_rfc3339 rfc with Ok (t,_,_) -> Some t | Error _ -> None
|
let of_string (rfc : string) = rfc
|
||||||
let listing date = if Option.is_some date.edited then date.edited else date.created
|
let listing date = if date.edited <> "" then date.edited else date.created
|
||||||
let pretty_date = function
|
let pretty_date date =
|
||||||
| Some t -> Ptime.to_date t |> fun (y, m, d) -> Printf.sprintf "%04d-%02d-%02d" y m d
|
try Scanf.sscanf date "%4s-%2s-%2s" (fun y m d -> Printf.sprintf "%s %s %s" y m d)
|
||||||
| None -> ""
|
with Scanf.Scan_failure s as e -> Printf.fprintf stderr "%s for %s\n" s date; raise e
|
||||||
|
let now () = Unix.time () |> Unix.gmtime |>
|
||||||
|
(fun t -> Printf.sprintf "%4d-%02d-%02dT%02d:%02d:%02dZ"
|
||||||
|
(t.tm_year+1900) (t.tm_mon+1) t.tm_mday t.tm_hour t.tm_min t.tm_sec)
|
||||||
|
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)
|
||||||
|
|
|
||||||
2
lib/dune
2
lib/dune
|
|
@ -1,4 +1,4 @@
|
||||||
(library
|
(library
|
||||||
(name logarion)
|
(name logarion)
|
||||||
(public_name logarion)
|
(public_name logarion)
|
||||||
(libraries ptime uuidm uri re.str bos text_parse text_parse.parsers msgpck))
|
(libraries text_parse text_parse.parsers unix str msgpck))
|
||||||
|
|
|
||||||
|
|
@ -1,52 +1,65 @@
|
||||||
type t = string
|
type t = string
|
||||||
type item_t = string
|
type item_t = t list
|
||||||
type archive_t = {
|
|
||||||
name: string; archivists: Person.Set.t; id: Id.t;
|
|
||||||
kv: string Store.KV.t; store: t }
|
|
||||||
type record_t = Text.t * item_t
|
type record_t = Text.t * item_t
|
||||||
|
|
||||||
let extension = ".txt"
|
let extension = ".txt"
|
||||||
|
let def_dir = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
|
||||||
|
|
||||||
let to_string f =
|
let to_string f =
|
||||||
let ic = open_in f in
|
let ic = open_in f in
|
||||||
let n = in_channel_length ic in
|
let s = really_input_string ic (in_channel_length ic) in
|
||||||
let s = Bytes.create n in
|
|
||||||
really_input ic s 0 n;
|
|
||||||
close_in ic;
|
close_in ic;
|
||||||
Bytes.to_string s
|
s
|
||||||
|
|
||||||
let file path content = let out = open_out path in
|
let fold_file_line fn init file = match open_in file with
|
||||||
output_string out content; close_out out
|
| exception (Sys_error msg) -> prerr_endline msg; init
|
||||||
|
| file ->
|
||||||
|
let rec read acc = match input_line file with
|
||||||
|
| "" as s | s when String.get s 0 = '#' -> read acc
|
||||||
|
| s -> read (fn s acc)
|
||||||
|
| exception End_of_file -> close_in file; acc
|
||||||
|
in read init
|
||||||
|
|
||||||
let (//) a b = a ^ "/" ^ b
|
let file path str = let o = open_out path in output_string o str; close_out o
|
||||||
|
|
||||||
let to_text path =
|
let to_text path =
|
||||||
if Filename.extension path = extension then
|
if Filename.extension path = extension then
|
||||||
(to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m))
|
(to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m))
|
||||||
else Error "Not txt"
|
else Error (Printf.sprintf "Not txt: %s" path)
|
||||||
|
|
||||||
let newest (a,_pa) (b,_pb) = Text.newest a b
|
let newest (a,_pa) (b,_pb) = Text.newest a b
|
||||||
let oldest (a,_pa) (b,_pb) = Text.oldest a b
|
let oldest (a,_pa) (b,_pb) = Text.oldest a b
|
||||||
|
|
||||||
let list_iter fn {store;_} paths =
|
let list_iter fn dir paths =
|
||||||
let link f = match to_text (Filename.concat store f)
|
let link f = match to_text (Filename.concat dir f) with
|
||||||
with Ok t -> fn store t f | Error s -> prerr_endline s in
|
| Ok t -> fn dir t f | Error s -> prerr_endline s in
|
||||||
List.iter link paths
|
List.iter link paths
|
||||||
|
|
||||||
let iter_valid_text pred fn p =
|
module TextMap = Map.Make(Text)
|
||||||
match to_text p with Error _ -> () | Ok t -> if pred t then fn (t, p)
|
|
||||||
|
|
||||||
let fold_valid_text pred fn acc p =
|
type iteration_t = item_t TextMap.t
|
||||||
match to_text p with Error _ -> acc | Ok t -> if pred t then fn acc (t, p) else acc
|
let new_iteration = TextMap.empty
|
||||||
|
|
||||||
let list_fs dir =
|
(*let iter_valid_text pred fn path =*)
|
||||||
|
(* match to_text path with Error _ -> () | Ok t -> if pred t then fn (t, p)*)
|
||||||
|
|
||||||
|
let fold_valid_text pred it path =
|
||||||
|
match to_text path with Error _ -> it
|
||||||
|
| Ok t -> if pred t then (TextMap.update t
|
||||||
|
(function None -> Some [path] | Some ps -> Some (path::ps)) it
|
||||||
|
) else it
|
||||||
|
|
||||||
|
(* Compare file system nodes to skip reparsing? *)
|
||||||
|
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
|
let rec loop result = function
|
||||||
| [] -> result
|
| f::fs when valid_dir f -> expand_dir f |> List.append fs |> loop result
|
||||||
| f::fs when Sys.is_directory f ->
|
|
||||||
Array.map (Filename.concat f) (Sys.readdir f)
|
|
||||||
|> Array.to_list |> List.append fs |> loop result
|
|
||||||
| f::fs -> loop (f::result) fs
|
| f::fs -> loop (f::result) fs
|
||||||
in loop [] [dir]
|
| [] -> result in
|
||||||
|
let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else
|
||||||
|
if not r then expand_dir dir else [dir] in
|
||||||
|
loop [] dirs
|
||||||
|
|
||||||
let list_take n =
|
let list_take n =
|
||||||
let rec take acc n = function [] -> []
|
let rec take acc n = function [] -> []
|
||||||
|
|
@ -54,113 +67,80 @@ let list_take n =
|
||||||
| x::xs -> take (x::acc) (n-1) xs
|
| x::xs -> take (x::acc) (n-1) xs
|
||||||
in take [] n
|
in take [] n
|
||||||
|
|
||||||
let iter ?(predicate=fun _ -> true) ?order ?number fn {store;_} =
|
let fold_sort_take ?(predicate=fun _ -> true) ?(number=None) comp flist =
|
||||||
match order with
|
(match number with None -> (fun x -> x) | Some n -> list_take n)
|
||||||
| None -> List.iter (iter_valid_text predicate fn) @@ list_fs store
|
@@ List.fast_sort comp @@ TextMap.bindings
|
||||||
| Some comp ->
|
@@ List.fold_left (fold_valid_text predicate) new_iteration flist
|
||||||
List.iter fn
|
|
||||||
@@ (match number with None -> (fun x -> x) | Some n -> list_take n)
|
|
||||||
@@ List.fast_sort comp
|
|
||||||
@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
|
|
||||||
@@ list_fs store
|
|
||||||
|
|
||||||
let fold ?(predicate=fun _ -> true) ?order ?number fn acc {store;_} =
|
let iter ?(r=false) ?(dir=def_dir) ?(predicate=fun _ -> true) ?order ?number fn =
|
||||||
match order with
|
let flist = list_fs ~r dir in match order with
|
||||||
| None -> List.fold_left (fold_valid_text predicate fn) acc @@ list_fs store
|
| Some comp -> List.iter fn @@ fold_sort_take ~predicate ~number comp flist
|
||||||
| Some comp ->
|
| None -> List.iter fn @@ TextMap.bindings @@
|
||||||
List.fold_left fn acc
|
List.fold_left (fold_valid_text predicate) new_iteration flist
|
||||||
@@ (match number with None -> (fun x -> x) | Some n -> list_take n)
|
|
||||||
@@ List.fast_sort comp
|
|
||||||
@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
|
|
||||||
@@ list_fs store
|
|
||||||
|
|
||||||
let with_id { store; _ } id =
|
let fold ?(r=false) ?(dir=def_dir) ?(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 @@
|
||||||
|
List.fold_left (fold_valid_text predicate) new_iteration flist
|
||||||
|
|
||||||
|
let with_id ?(r=false) ?(dir=def_dir) id =
|
||||||
let matched acc path =
|
let matched acc path =
|
||||||
match to_text path with
|
match to_text path with
|
||||||
| Error x -> prerr_endline x; acc
|
| Error x -> prerr_endline x; acc
|
||||||
| Ok text when text.Text.uuid <> id -> acc
|
| Ok text when text.Text.id <> id -> acc
|
||||||
| Ok text ->
|
| Ok text ->
|
||||||
match acc with
|
match acc with
|
||||||
| Ok None -> Ok (Some text)
|
| Ok None -> Ok (Some text)
|
||||||
| Ok (Some prev) -> if prev = text then acc else Error [text; prev]
|
| Ok (Some prev) -> if prev = text then acc else Error [text; prev]
|
||||||
| Error x -> Error (text :: x)
|
| Error x -> Error (text :: x)
|
||||||
in List.fold_left matched (Ok None) (list_fs store)
|
in List.fold_left matched (Ok None) (list_fs ~r dir)
|
||||||
|
|
||||||
module Directory = struct
|
let with_dir ?(descr="") ?(perm=0o740) dir =
|
||||||
let print ?(descr="") dir result =
|
let mkdir dir = match Unix.mkdir dir perm with
|
||||||
let () = match result with
|
| exception Unix.Unix_error (EEXIST, _, _) -> ()
|
||||||
| Ok true -> print_endline ("Created " ^ descr ^ " directory " ^ dir)
|
| exception Unix.Unix_error (code, _fn, arg) ->
|
||||||
| Ok false -> print_endline ("Using existing " ^ descr ^ " directory " ^ dir)
|
failwith @@ Printf.sprintf "Error %s making %s dir: %s"
|
||||||
| Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg
|
(Unix.error_message code) descr arg
|
||||||
in
|
| _ -> () in
|
||||||
result
|
let rec mkeach path = function [] | [""] -> () | ""::t -> mkeach path t
|
||||||
|
| hd::t -> let d = Filename.concat path hd in mkdir d; mkeach d t in
|
||||||
|
mkeach
|
||||||
|
(if Filename.is_relative dir then "" else "/")
|
||||||
|
(String.split_on_char '/' dir)
|
||||||
|
|
||||||
let directory dir = Result.bind (Fpath.of_string dir) Bos.OS.Dir.create
|
let rec with_dirs = function [] -> () | (d, descr)::tl -> with_dir ~descr d; with_dirs tl
|
||||||
|
|
||||||
let rec directories = function
|
|
||||||
| [] -> Ok ()
|
|
||||||
| (d, descr)::tl ->
|
|
||||||
match directory d |> print ~descr d with
|
|
||||||
| Ok _ -> directories tl
|
|
||||||
| Error _ -> Error (d, descr)
|
|
||||||
end
|
|
||||||
|
|
||||||
let copy ?(recursive = false) src dst =
|
|
||||||
Bos.OS.Cmd.run (Bos.Cmd.(v "cp" %% (on recursive @@ v "-r") % src % dst))
|
|
||||||
|
|
||||||
let versioned_basename_of_title ?(version=0) repo extension (title : string) =
|
let versioned_basename_of_title ?(version=0) repo extension (title : string) =
|
||||||
let basename = Text.string_alias title in
|
let basename = Text.string_alias title in
|
||||||
let rec next version =
|
let rec next version =
|
||||||
let candidate = repo // basename ^ "." ^ string_of_int version ^ extension in
|
let candidate = Filename.concat repo
|
||||||
|
(basename ^ "." ^ string_of_int version ^ extension) in
|
||||||
if Sys.file_exists candidate then next (succ version) else candidate
|
if Sys.file_exists candidate then next (succ version) else candidate
|
||||||
in
|
in
|
||||||
next version
|
next version
|
||||||
|
|
||||||
let uuid_filename repo extension text =
|
let id_filename repo extension text =
|
||||||
let basename = Text.alias text in
|
let basename = Text.alias text in
|
||||||
let candidate = repo // String.sub (Id.to_string text.uuid) 0 6 ^ "." ^ basename ^ extension in
|
let candidate = Filename.concat repo (text.id ^ "." ^ basename ^ extension) in
|
||||||
if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
|
if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
|
||||||
|
|
||||||
let with_text {store;_} new_text =
|
let with_text ?(dir=def_dir) new_text =
|
||||||
Result.bind (uuid_filename store extension new_text) @@
|
match id_filename dir extension new_text with
|
||||||
fun path ->
|
| Error _ as e -> e
|
||||||
try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
|
| Ok path ->
|
||||||
|
try file path (Text.to_string new_text); Ok (path, new_text)
|
||||||
let basic_config () =
|
with Sys_error s -> Error s
|
||||||
"Archive-Name: "
|
|
||||||
^ "\nArchive-ID: " ^ Id.(generate () |> to_string)
|
|
||||||
^ "\nArchivists: " ^ Bos.OS.Env.opt_var "USER" ~absent:""
|
|
||||||
|> Bytes.of_string
|
|
||||||
|
|
||||||
let init ?(dotdir=".logarion/") () =
|
|
||||||
match Directory.directories [dotdir, "dotdir"] with
|
|
||||||
| Error (_dir, _desc) -> ()
|
|
||||||
| Ok () ->
|
|
||||||
let config_file =
|
|
||||||
open_out_gen [Open_creat; Open_excl; Open_wronly]
|
|
||||||
0o700 (dotdir // "config") in
|
|
||||||
output_bytes config_file (basic_config ());
|
|
||||||
close_out config_file
|
|
||||||
|
|
||||||
module Config = struct
|
module Config = struct
|
||||||
type t = archive_t
|
type t = string Store.KV.t
|
||||||
let key_value k v a = match k with
|
let key_value k v a = Store.KV.add k (String.trim v) a
|
||||||
| "Archive-Name" -> { a with name = String.trim v }
|
|
||||||
| "Archive-ID" -> { a with id = Option.get (Id.of_string (String.trim v)) }
|
|
||||||
| "Archivists" -> { a with archivists = Person.Set.of_string v }
|
|
||||||
| _ -> { a with kv = Store.KV.add k (String.trim v) a.kv }
|
|
||||||
end
|
end
|
||||||
|
|
||||||
let of_path store =
|
let of_kv_file path =
|
||||||
let open Text_parse in
|
let open Text_parse in
|
||||||
let subsyntaxes = [| (module Parsers.Key_value.Make (Config) : Parser.S with type t = Config.t); (module Parsers.Key_value.Make (Config)); |] in
|
let subsyntaxes = Parsers.Key_value.[|
|
||||||
let of_string text acc = Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
|
(module Make (Config) : Parser.S with type t = Config.t); (module Make (Config)); |] in
|
||||||
Ok (
|
let of_string text acc =
|
||||||
of_string (to_string @@ store ^ "/.logarion/config") {
|
Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
|
||||||
name = "";
|
of_string (to_string @@ path) Store.KV.empty
|
||||||
archivists = Person.Set.empty;
|
|
||||||
id = Id.nil;
|
|
||||||
kv = Store.KV.empty;
|
|
||||||
store = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
|
|
||||||
}
|
|
||||||
)
|
|
||||||
|
|
|
||||||
|
|
@ -1,54 +1,57 @@
|
||||||
type info_t = { version: int; name: string; archivists: string list }
|
let version = 0
|
||||||
type text_t = { id: Msgpck.t; time: Msgpck.t; title: Msgpck.t; authors: Msgpck.t }
|
type info_t = { version: int; id: string; title: string; people: string list; locations: string list }
|
||||||
type t = { info: info_t; fields: string list; texts: Msgpck.t; peers: Msgpck.t }
|
type t = { info: info_t; fields: Msgpck.t; texts: Msgpck.t; peers: Msgpck.t }
|
||||||
|
|
||||||
let of_id id = Msgpck.Bytes (Id.to_bytes id)
|
let of_id id = Msgpck.of_string id
|
||||||
let to_id pck_id = Id.of_bytes Msgpck.(to_bytes pck_id)
|
let to_id = Msgpck.to_string
|
||||||
|
|
||||||
let person p = Msgpck.String (Person.to_string p)
|
let person p = Msgpck.String (Person.to_string p)
|
||||||
let persons ps = List.rev @@ Person.Set.fold (fun p a -> person p :: a) ps []
|
let persons ps = Msgpck.of_list @@ List.rev @@ Person.Set.fold (fun p a -> person p :: a) ps []
|
||||||
|
|
||||||
|
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 of_set field t =
|
let of_set field t =
|
||||||
List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) []
|
List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) []
|
||||||
|
|
||||||
let date = function
|
let date = function "" -> Int32.zero | date -> Int32.of_int (Date.to_secs date)
|
||||||
| None -> Int32.zero
|
|
||||||
| Some date ->
|
|
||||||
let days, ps = Ptime.Span.to_d_ps (Ptime.to_span date) in
|
|
||||||
Int32.add Int32.(mul (of_int days) 86400l) Int64.(to_int32 (div ps 1000000000000L))
|
|
||||||
|
|
||||||
let to_sec = function
|
let to_sec = function Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x
|
||||||
Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x
|
|
||||||
|
|
||||||
let public_peers () =
|
|
||||||
Peers.fold_file (fun x a -> Msgpck.String x :: a) [] Peers.public_fname
|
|
||||||
|
|
||||||
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"])
|
||||||
let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack)
|
let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack)
|
||||||
|
|
||||||
let to_pack a t =
|
|
||||||
let open Text in
|
|
||||||
Msgpck.(List [
|
|
||||||
Bytes (Id.to_bytes t.uuid); of_uint32 (date (Date.listing t.date));
|
|
||||||
String t.title; List (persons t.authors); List (of_set "topics" t)
|
|
||||||
]) :: a
|
|
||||||
|
|
||||||
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 to_info = function
|
let to_info = function
|
||||||
| Msgpck.List (v::n::a::[]) ->
|
| Msgpck.List (v::id::n::a::ls::[]) ->
|
||||||
let archivists = List.map Msgpck.to_string (Msgpck.to_list a) in
|
let people = to_str_list a in
|
||||||
Msgpck.({version = to_int v; name = to_string n; archivists})
|
let locations = to_str_list ls in
|
||||||
|
Msgpck.({version = to_int v; id = to_string id; title = to_string n; people; locations})
|
||||||
| _ -> invalid_arg "Pack header"
|
| _ -> invalid_arg "Pack header"
|
||||||
|
|
||||||
|
let of_info i = let open Msgpck in
|
||||||
|
List [Int i.version; String i.id; String i.title; str_list i.people; str_list i.locations]
|
||||||
|
|
||||||
|
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)
|
||||||
|
]) :: a
|
||||||
|
|
||||||
|
let of_text_list l = Msgpck.List l
|
||||||
|
|
||||||
|
let pack p = Msgpck.List [of_info p.info; p.fields; p.texts; p.peers]
|
||||||
|
let string p = Bytes.to_string @@ Msgpck.Bytes.to_string @@ pack p
|
||||||
|
|
||||||
let unpack = function
|
let unpack = function
|
||||||
| Msgpck.List (i::f::texts::[]) ->
|
| Msgpck.List (i::fields::texts::[]) ->
|
||||||
Some { info = to_info i; fields = to_fields f; texts; peers = Msgpck.List [] }
|
Ok { info = to_info i; fields; texts; peers = Msgpck.List [] }
|
||||||
| Msgpck.List (i::f::texts::peers::[]) ->
|
| Msgpck.List (i::fields::texts::peers::[]) ->
|
||||||
Some { info = to_info i; fields = to_fields f; texts; peers }
|
Ok { info = to_info i; fields; texts; peers }
|
||||||
| _ -> None
|
| _ -> Error "format mismatch"
|
||||||
|
|
||||||
|
let of_string s = unpack @@ snd @@ Msgpck.StringBuf.read s
|
||||||
|
|
||||||
let list filename = try
|
let list filename = try
|
||||||
let texts_list = function
|
let texts_list = function
|
||||||
|
|
@ -60,25 +63,22 @@ let list filename = try
|
||||||
|
|
||||||
let contains text = function
|
let contains text = function
|
||||||
| Msgpck.List (id::_time::title::_authors::_topics::[]) ->
|
| Msgpck.List (id::_time::title::_authors::_topics::[]) ->
|
||||||
(match Id.of_bytes (Msgpck.to_bytes id) with
|
(match to_id id with
|
||||||
| None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title); false
|
| "" -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title); false
|
||||||
| Some id -> text.Text.uuid = id)
|
| id -> text.Text.id = id)
|
||||||
| _ -> prerr_endline ("Invalid record pattern"); false
|
| _ -> prerr_endline ("Invalid record pattern"); false
|
||||||
|
|
||||||
let pack archive records =
|
|
||||||
let header_pack = List.fold_left to_pack [] records in
|
|
||||||
let info = Msgpck.(List [Int 0; String archive.File_store.name; List (persons archive.archivists)]) in
|
|
||||||
Bytes.to_string @@ Msgpck.Bytes.to_string
|
|
||||||
(List [info; fields; Msgpck.List header_pack; Msgpck.List (public_peers ())])
|
|
||||||
|
|
||||||
let add archive records =
|
(*let pack_filename ?(filename="index.pck") archive =*)
|
||||||
let fname = pack_filename archive in
|
(* let dir = Store.KV.find "Export-Dir" archive.File_store.kv in (*raises Not_found*)*)
|
||||||
let append published (t, _f) = if List.exists (contains t) published then published else to_pack published t in
|
(* dir ^ "/" ^ filename*)
|
||||||
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;
|
|
||||||
List (persons archive.archivists)]) in
|
|
||||||
File_store.file fname @@ Bytes.to_string
|
|
||||||
@@ Msgpck.Bytes.to_string (List [archive; fields; Msgpck.List header_pack])
|
|
||||||
|
|
||||||
let unpublish _archive _records = ()
|
(*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])*)
|
||||||
|
|
|
||||||
42
lib/id.ml
42
lib/id.ml
|
|
@ -1,9 +1,33 @@
|
||||||
let random_state = Random.State.make_self_init ()
|
let random_state = Random.State.make_self_init
|
||||||
type t = Uuidm.t
|
|
||||||
let compare = Uuidm.compare
|
(*module UUID = struct*)
|
||||||
let to_string = Uuidm.to_string
|
(*type t = Uuidm.t*)
|
||||||
let of_string = Uuidm.of_string
|
(*let compare = Uuidm.compare*)
|
||||||
let to_bytes = Uuidm.to_bytes
|
(*let to_string = Uuidm.to_string*)
|
||||||
let of_bytes = Uuidm.of_bytes
|
(*let of_string = Uuidm.of_string*)
|
||||||
let generate ?(random_state=random_state) = Uuidm.v4_gen random_state
|
(*let to_bytes = Uuidm.to_bytes*)
|
||||||
let nil = Uuidm.nil
|
(*let of_bytes = Uuidm.of_bytes*)
|
||||||
|
(*let generate ?(random_state=random_state ()) = Uuidm.v4_gen random_state*)
|
||||||
|
(*let nil = Uuidm.nil*)
|
||||||
|
(*end*)
|
||||||
|
|
||||||
|
type t = string
|
||||||
|
let compare = String.compare
|
||||||
|
let nil = ""
|
||||||
|
|
||||||
|
let short ?(len) id =
|
||||||
|
let id_len = String.length id in
|
||||||
|
let l = match len with Some l -> l | None -> if id_len = 36 then 8 else 6 in
|
||||||
|
String.sub id 0 (min l id_len)
|
||||||
|
|
||||||
|
let generate ?(len=6) ?(seed=random_state ()) () =
|
||||||
|
let b32 i = char_of_int @@
|
||||||
|
if i < 10 then i+48 else
|
||||||
|
if i < 18 then i+87 else
|
||||||
|
if i < 20 then i+88 else
|
||||||
|
if i < 22 then i+89 else
|
||||||
|
if i < 27 then i+90 else
|
||||||
|
if i < 32 then i+91 else
|
||||||
|
(invalid_arg ("id.char" ^ string_of_int i)) in
|
||||||
|
let c _ = b32 (Random.State.int seed 31) in
|
||||||
|
String.init len c
|
||||||
|
|
|
||||||
26
lib/peers.ml
26
lib/peers.ml
|
|
@ -1,9 +1,19 @@
|
||||||
let public_fname = "peers.pub.conf"
|
let text_dir = Filename.concat (Sys.getenv "HOME") ".local/share/texts"
|
||||||
let private_fname = "peers.priv.conf"
|
|
||||||
|
|
||||||
let fold_file fn init file = match open_in file with
|
let fold fn init = match Sys.readdir text_dir with
|
||||||
| exception (Sys_error msg) -> prerr_endline msg; init
|
| exception (Sys_error msg) -> prerr_endline msg
|
||||||
| file ->
|
| dirs ->
|
||||||
let rec read acc = try read (fn (input_line file) acc)
|
let read_pack path =
|
||||||
with End_of_file -> close_in file; acc in
|
let pack_path = Filename.(concat text_dir @@ concat path "index.pck") in
|
||||||
read init
|
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)
|
||||||
|
in
|
||||||
|
Array.iter read_pack dirs
|
||||||
|
|
||||||
|
let scheme url =
|
||||||
|
let colon_idx = String.index_from url 0 ':' in
|
||||||
|
let scheme = String.sub url 0 colon_idx in
|
||||||
|
(* let remain = String.(sub url (colon_idx+1) (length url - length scheme - 1)) in*)
|
||||||
|
scheme
|
||||||
|
|
|
||||||
|
|
@ -1,17 +1,18 @@
|
||||||
module Person = struct
|
module Person = struct
|
||||||
type name_t = string
|
type name_t = string
|
||||||
type address_t = Uri.t
|
type address_t = string
|
||||||
type t = { name: name_t; addresses: address_t list }
|
type t = { name: name_t; addresses: address_t list }
|
||||||
let empty = { name = ""; addresses = [] }
|
let empty = { name = ""; addresses = [] }
|
||||||
let compare = Stdlib.compare
|
let compare = Stdlib.compare
|
||||||
let to_string p = List.fold_left (fun a e -> a^" <"^Uri.to_string e^">") p.name p.addresses
|
let name_to_string p = p.name
|
||||||
|
let to_string p = List.fold_left (fun a e -> Printf.sprintf "%s <%s>" a e) p.name p.addresses
|
||||||
let of_string s = match String.trim s with "" -> empty | s ->
|
let of_string s = match String.trim s with "" -> empty | s ->
|
||||||
match Re.Str.(split (regexp " *< *") s) with
|
match Str.(split (regexp " *< *") s) with
|
||||||
| [] -> empty
|
| [] -> empty
|
||||||
| [n] -> let name = String.trim n in { empty with name }
|
| [n] -> let name = String.trim n in { empty with name }
|
||||||
| n::adds ->
|
| n::adds ->
|
||||||
let name = String.trim n in
|
let name = String.trim n in
|
||||||
let addresses = List.map (fun f -> Uri.of_string @@ String.(sub f 0 (length f -1))) adds in
|
let addresses = List.map (fun f -> String.(sub f 0 (length f -1))) adds in
|
||||||
{ name; addresses }
|
{ name; addresses }
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
@ -19,8 +20,8 @@ include Person
|
||||||
|
|
||||||
module Set = struct
|
module Set = struct
|
||||||
include Set.Make(Person)
|
include Set.Make(Person)
|
||||||
let to_string ?(pre="") ?(sep=", ") s =
|
let to_string ?(names_only=false) ?(pre="") ?(sep=", ") s =
|
||||||
let str = Person.to_string in
|
let str = if names_only then Person.name_to_string else Person.to_string in
|
||||||
let j x a = match a, x with "",_ -> str x | _,x when x = Person.empty -> a | _ -> a^sep^str x in
|
let j x a = match a, x with "",_ -> str x | _,x when x = Person.empty -> a | _ -> a^sep^str x in
|
||||||
fold j s pre
|
fold j s pre
|
||||||
let of_string s = of_list (List.map Person.of_string (String_set.list_of_csv s))
|
let of_string s = of_list (List.map Person.of_string (String_set.list_of_csv s))
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,7 @@ module KV = Map.Make (String)
|
||||||
module type T = sig
|
module type T = sig
|
||||||
type t
|
type t
|
||||||
type item_t
|
type item_t
|
||||||
type archive_t = { name: string; archivists: Person.Set.t; id: Id.t; kv: string KV.t; store: t }
|
type archive_t = { id: Id.t; name: string; archivists: Person.Set.t; kv: string KV.t; store: t }
|
||||||
type record_t = Text.t * item_t
|
type record_t = Text.t * item_t
|
||||||
val of_path: string -> (archive_t, string) result
|
val of_path: string -> (archive_t, string) result
|
||||||
val newest: record_t -> record_t -> int
|
val newest: record_t -> record_t -> int
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
include Set.Make(String)
|
include Set.Make(String)
|
||||||
|
|
||||||
let list_of_csv x = Re.Str.(split (regexp " *, *")) (String.trim x)
|
let list_of_csv x = Str.(split (regexp " *, *")) (String.trim x)
|
||||||
let of_string x = of_list (list_of_csv x)
|
let of_string x = of_list (list_of_csv x)
|
||||||
let to_string ?(pre="") ?(sep=", ") s =
|
let to_string ?(pre="") ?(sep=", ") s =
|
||||||
let j a x = match a, x with "", _ -> x | _, "" -> a | _ -> a ^ sep ^ x in
|
let j a x = match a, x with "", _ -> x | _, "" -> a | _ -> a ^ sep ^ x in
|
||||||
|
|
|
||||||
152
lib/text.ml
152
lib/text.ml
|
|
@ -1,23 +1,23 @@
|
||||||
module String_map = Map.Make (String)
|
module String_map = Map.Make (String)
|
||||||
type t = {
|
type t = {
|
||||||
title: string;
|
id: Id.t;
|
||||||
uuid: Id.t;
|
title: string;
|
||||||
authors: Person.Set.t;
|
authors: Person.Set.t;
|
||||||
date: Date.t;
|
date: Date.t;
|
||||||
string_map: string String_map.t;
|
string_map: string String_map.t;
|
||||||
stringset_map: String_set.t String_map.t;
|
stringset_map: String_set.t String_map.t;
|
||||||
body: string;
|
body: string;
|
||||||
}
|
}
|
||||||
|
|
||||||
let blank ?(uuid=(Id.generate ())) () = {
|
let blank ?(id=(Id.generate ())) () = {
|
||||||
title = "";
|
id;
|
||||||
uuid;
|
title = "";
|
||||||
authors = Person.Set.empty;
|
authors = Person.Set.empty;
|
||||||
date = Date.({ created = None; edited = None});
|
date = Date.({ created = now (); edited = ""});
|
||||||
string_map = String_map.empty;
|
string_map = String_map.empty;
|
||||||
stringset_map = String_map.empty;
|
stringset_map = String_map.empty;
|
||||||
body = "";
|
body = "";
|
||||||
}
|
}
|
||||||
|
|
||||||
let compare = Stdlib.compare
|
let compare = Stdlib.compare
|
||||||
let newest a b = Date.(compare a.date b.date)
|
let newest a b = Date.(compare a.date b.date)
|
||||||
|
|
@ -28,75 +28,75 @@ let str_set key m = String_set.to_string @@ set key m
|
||||||
let with_str_set m key str = { m with stringset_map = String_map.add (String.lowercase_ascii key) (String_set.of_string str) m.stringset_map }
|
let with_str_set m key str = { m with stringset_map = String_map.add (String.lowercase_ascii key) (String_set.of_string str) m.stringset_map }
|
||||||
|
|
||||||
let with_kv x (k,v) =
|
let with_kv x (k,v) =
|
||||||
let trim = String.trim in
|
let trim = String.trim in
|
||||||
match String.lowercase_ascii k with
|
match String.lowercase_ascii k with
|
||||||
| "body" -> { x with body = String.trim v }
|
| "body" -> { x with body = String.trim v }
|
||||||
| "title"-> { x with title = trim v }
|
| "title"-> { x with title = trim v }
|
||||||
| "id" -> (match Id.of_string v with Some id -> { x with uuid = id } | None -> x)
|
| "id" -> (match v with "" -> x | s -> { x with id = s })
|
||||||
| "author"
|
| "author"
|
||||||
| "authors" -> { x with authors = Person.Set.of_string (trim v)}
|
| "authors" -> { x with authors = Person.Set.of_string (trim v)}
|
||||||
| "date" -> { x with date = Date.{ x.date with created = Date.of_string v }}
|
| "date" -> { x with date = Date.{ x.date with created = Date.of_string v }}
|
||||||
| "date-edited"-> { x with date = Date.{ x.date with edited = Date.of_string v }}
|
| "date-edited"-> { x with date = Date.{ x.date with edited = Date.of_string v }}
|
||||||
| "licences" | "topics" | "keywords" | "series" as k -> with_str_set x k v
|
| "licences" | "topics" | "keywords" | "series" as k -> with_str_set x k v
|
||||||
| k -> { x with string_map = String_map.add k (trim v) x.string_map }
|
| k -> { x with string_map = String_map.add k (trim v) x.string_map }
|
||||||
|
|
||||||
let kv_of_string line = match Re.Str.(bounded_split (regexp ": *")) line 2 with
|
let kv_of_string line = match Str.(bounded_split (regexp ": *")) line 2 with
|
||||||
| [ key; value ] -> Re.Str.(replace_first (regexp "^#\\+") "" key), value
|
| [ key; value ] -> Str.(replace_first (regexp "^#\\+") "" key), value
|
||||||
| [ key ] -> Re.Str.(replace_first (regexp "^#\\+") "" key), ""
|
| [ key ] -> Str.(replace_first (regexp "^#\\+") "" key), ""
|
||||||
| _ -> "",""
|
| _ -> "",""
|
||||||
|
|
||||||
let of_header front_matter =
|
let of_header front_matter =
|
||||||
let fields = List.map kv_of_string (Re.Str.(split (regexp "\n")) front_matter) in
|
let fields = List.map kv_of_string (Str.(split (regexp "\n")) front_matter) in
|
||||||
List.fold_left with_kv (blank ~uuid:Id.nil ()) fields
|
List.fold_left with_kv (blank ~id:Id.nil ()) fields
|
||||||
|
|
||||||
let front_matter_body_split s =
|
let front_matter_body_split s =
|
||||||
if Re.Str.(string_match (regexp ".*:.*")) s 0
|
if Str.(string_match (regexp ".*:.*")) s 0
|
||||||
then match Re.Str.(bounded_split (regexp "^$")) s 2 with
|
then match Str.(bounded_split (regexp "^$")) s 2 with
|
||||||
| front::body::[] -> (front, body)
|
| front::body::[] -> (front, body)
|
||||||
| _ -> ("", s)
|
| _ -> ("", s)
|
||||||
else ("", s)
|
else ("", s)
|
||||||
|
|
||||||
let of_string s =
|
let of_string s =
|
||||||
let front_matter, body = front_matter_body_split s in
|
let front_matter, body = front_matter_body_split s in
|
||||||
try
|
try
|
||||||
let note = { (of_header front_matter) with body } in
|
let note = { (of_header front_matter) with body } in
|
||||||
if note.uuid <> Id.nil then Ok note else Error "Missing ID header"
|
if note.id <> Id.nil then Ok note else Error "Missing ID header"
|
||||||
with _ -> Error ("Failed parsing" ^ s)
|
with _ -> Error ("Failed parsing" ^ s)
|
||||||
|
|
||||||
let to_string x =
|
let to_string x =
|
||||||
let has_len v = String.length v > 0 in
|
let has_len v = String.length v > 0 in
|
||||||
let s field value = if has_len value then field ^ ": " ^ value ^ "\n" else "" in
|
let s field value = if has_len value then field ^ ": " ^ value ^ "\n" else "" in
|
||||||
let a value = if Person.Set.is_empty value then "" else "Authors: " ^ Person.Set.to_string value ^ "\n" in
|
let a value = if Person.Set.is_empty value then "" else "Authors: " ^ Person.Set.to_string value ^ "\n" in
|
||||||
let d field value = match value with Some _ -> field ^ ": " ^ Date.rfc_string value ^ "\n" | None -> "" in
|
let d field value = match value with "" -> "" | s -> field ^ ": " ^ Date.rfc_string s ^ "\n" in
|
||||||
let rows =
|
let rows = [
|
||||||
[ s "Title" x.title;
|
s "ID" x.id;
|
||||||
a x.authors;
|
d "Date" x.date.Date.created;
|
||||||
d "Date" x.date.Date.created;
|
d "Edited" x.date.Date.edited;
|
||||||
d "Edited" x.date.Date.edited;
|
s "Title" x.title;
|
||||||
s "Licences" (str_set "licences" x);
|
a x.authors;
|
||||||
s "Topics" (str_set "topics" x);
|
s "Licences" (str_set "licences" x);
|
||||||
s "Keywords" (str_set "keywords" x);
|
s "Topics" (str_set "topics" x);
|
||||||
s "Series" (str_set "series" x);
|
s "Keywords" (str_set "keywords" x);
|
||||||
s "Abstract" (str "abstract" x);
|
s "Series" (str_set "series" x);
|
||||||
s "ID" (Uuidm.to_string x.uuid);
|
s "Abstract" (str "abstract" x);
|
||||||
s "Alias" (str "Alias" x) ]
|
s "Alias" (str "Alias" x)
|
||||||
in
|
] in
|
||||||
String.concat "" rows ^ "\n" ^ x.body
|
String.concat "" rows ^ "\n" ^ x.body
|
||||||
|
|
||||||
let string_alias t =
|
let string_alias t =
|
||||||
let is_reserved = function
|
let is_reserved = function
|
||||||
| '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$'
|
| '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$'
|
||||||
| ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true
|
| ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
in
|
in
|
||||||
let b = Buffer.create (String.length t) in
|
let b = Buffer.create (String.length t) in
|
||||||
let filter char =
|
let filter char =
|
||||||
let open Buffer in
|
let open Buffer in
|
||||||
if is_reserved char then (try (if nth b (pred (length b)) <> '-' then add_char b '-') with Invalid_argument _ -> prerr_endline "reserved")
|
if is_reserved char then (try (if nth b (pred (length b)) <> '-' then add_char b '-') with Invalid_argument _ -> prerr_endline "reserved")
|
||||||
else add_char b char
|
else add_char b char
|
||||||
in
|
in
|
||||||
String.(iter filter (lowercase_ascii t));
|
String.(iter filter (lowercase_ascii t));
|
||||||
Buffer.contents b
|
Buffer.contents b
|
||||||
|
|
||||||
let alias t = match str "alias" t with "" -> string_alias t.title | x -> x
|
let alias t = match str "alias" t with "" -> string_alias t.title | x -> x
|
||||||
let short_id ?(len=8) t = String.sub (Id.to_string t.uuid) 0 len
|
let short_id t = Id.short t.id
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
let of_string x = Re.Str.(split (regexp " *> *")) (String.trim x)
|
let of_string x = Str.(split (regexp " *> *")) (String.trim x)
|
||||||
|
|
||||||
let topic x =
|
let topic x =
|
||||||
let path = of_string x in
|
let path = of_string x in
|
||||||
|
|
|
||||||
|
|
@ -1,23 +1,15 @@
|
||||||
# This file is generated by dune, edit dune-project instead
|
# This file is generated by dune, edit dune-project instead
|
||||||
opam-version: "2.0"
|
opam-version: "2.0"
|
||||||
synopsis: "Texts archival and exchange"
|
synopsis: "Texts archival and exchange"
|
||||||
maintainer: ["fox@orbitalfox.eu"]
|
maintainer: ["orbifx <fox@orbitalfox.eu>"]
|
||||||
authors: ["orbifx"]
|
|
||||||
license: "EUPL-1.2"
|
license: "EUPL-1.2"
|
||||||
homepage: "https://logarion.orbitalfox.eu"
|
homepage: "http://logarion.orbitalfox.eu"
|
||||||
bug-reports: "mailto:logarion@lists.orbitalfox.eu?subject=Issue:"
|
|
||||||
depends: [
|
depends: [
|
||||||
"dune" {>= "2.0"}
|
"dune" {>= "2.0"}
|
||||||
"re"
|
|
||||||
"cmdliner"
|
|
||||||
"bos"
|
|
||||||
"ptime"
|
|
||||||
"uuidm"
|
|
||||||
"uri"
|
|
||||||
"text_parse"
|
"text_parse"
|
||||||
|
"cmdliner" {<= "1.0.4"}
|
||||||
"msgpck"
|
"msgpck"
|
||||||
"cohttp-lwt-unix"
|
"ocurl"
|
||||||
"tls"
|
|
||||||
]
|
]
|
||||||
build: [
|
build: [
|
||||||
["dune" "subst"] {pinned}
|
["dune" "subst"] {pinned}
|
||||||
|
|
@ -33,4 +25,4 @@ build: [
|
||||||
"@doc" {with-doc}
|
"@doc" {with-doc}
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
dev-repo: "git://orbitalfox.eu/logarion"
|
dev-repo: "git+https://git.disroot.org/orbifx/logarion.git"
|
||||||
|
|
|
||||||
37
readme
37
readme
|
|
@ -1,25 +1,28 @@
|
||||||
Logarion is a free and open-source text archive system. A blog-wiki hybrid.
|
Logarion is a text header-format and suite of tools, for discovering, collecting & exchanging texts.
|
||||||
|
|
||||||
Download: <https://logarion.orbitalfox.eu/downloads/>
|
Guide: <http://texts.orbitalfox.eu/11bcd8e9.htm>
|
||||||
EUPL licence: <https://joinup.ec.europa.eu/software/page/eupl>
|
Source: <http://git.disroot.org/orbifx/logarion>
|
||||||
|
IRC: <irc://tilde.chat/#logarion>
|
||||||
|
EUPL licence: <http://joinup.ec.europa.eu/software/page/eupl>
|
||||||
|
|
||||||
|
|
||||||
Start
|
Header fields
|
||||||
|
|
||||||
Create a folder and run `logarion init` from within it to produce `.logarion/config` configuration file.
|
ID: unique identifier
|
||||||
Run `logarion --help` for more options.
|
Date: of creation, ISO8601 formatted
|
||||||
|
Topics: comma seperated list of topic names & phrases
|
||||||
|
Title:
|
||||||
|
Authors:list of name with optional set of <address>
|
||||||
|
|
||||||
|
A blank line must seperarate the header from the body.
|
||||||
|
|
||||||
|
|
||||||
Community & support
|
Build development version
|
||||||
|
|
||||||
* Website: <https://logarion.orbitalfox.eu>
|
Install `ocaml` and `opam`. Then build and install Logarion using opam's pin function:
|
||||||
* Report an issue: <mailto:logarion@lists.orbitalfox.eu?subject=Issue:>
|
|
||||||
* Discussion: <https://lists.orbitalfox.eu/listinfo/logarion>
|
|
||||||
or join via <mailto:logarion-join@lists.orbitalfox.eu>
|
|
||||||
|
|
||||||
|
```
|
||||||
Install development version
|
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 pin add text_parse git://orbitalfox.eu/text-parse-ml
|
opam install logarion
|
||||||
opam pin add logarion git://orbitalfox.eu/logarion
|
```
|
||||||
opam install logarion
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue